diff --git a/.gitignore b/.gitignore index 8d12c58..2529a50 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ gdl-0.9rc4.tar.gz /gdl-0.9.1.tar.gz /gdl-0.9.2.tar.gz /gdl-0.9.3.tar.gz +/gdl-0.9.4.tar.gz diff --git a/gdl-build.patch b/gdl-build.patch index 750d4d7..6997995 100644 --- a/gdl-build.patch +++ b/gdl-build.patch @@ -1,15 +1,3 @@ -diff -up gdl-0.9.2/testsuite/Makefile.am.build gdl-0.9.2/testsuite/Makefile.am ---- gdl-0.9.2/testsuite/Makefile.am.build 2012-05-10 15:11:37.730137963 -0600 -+++ gdl-0.9.2/testsuite/Makefile.am 2012-05-10 16:15:25.312948418 -0600 -@@ -2,7 +2,7 @@ check_LTLIBRARIES = libtest_ce.la - libtest_ce_la_SOURCES = libtest_ce.cpp - libtest_ce_la_LDFLAGS = -rpath $(abs_srcdir)/testsuite/.libs - --TESTS_ENVIRONMENT = $(top_srcdir)/testsuite/try $(top_srcdir) -+TESTS_ENVIRONMENT = $(top_srcdir)/testsuite/try $(top_srcdir) $(top_builddir) - TESTS = \ - test_angles.pro \ - test_base64.pro \ diff -up gdl-0.9.2/testsuite/try.build gdl-0.9.2/testsuite/try --- gdl-0.9.2/testsuite/try.build 2011-05-02 05:00:47.000000000 -0600 +++ gdl-0.9.2/testsuite/try 2012-05-10 16:16:14.218180027 -0600 diff --git a/gdl-cvs.patch b/gdl-cvs.patch deleted file mode 100644 index ca41ceb..0000000 --- a/gdl-cvs.patch +++ /dev/null @@ -1,76781 +0,0 @@ -Only in gdl-0.9.3: aclocal.m4 -Only in gdl-0.9.3: CMakeFiles -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeLists.txt gdl/CMakeLists.txt ---- gdl-0.9.3/CMakeLists.txt 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/CMakeLists.txt 2013-07-08 12:39:20.367411222 -0600 -@@ -14,13 +14,14 @@ - project(GDL) - - # X.X.X CVS becomes release X.X.X+1 --set(VERSION "0.9.3") -+set(VERSION "0.9.3 CVS") - enable_testing() - - include(CheckIncludeFile) - include(CheckIncludeFileCXX) - include(CheckLibraryExists) - include(CheckFunctionExists) -+include(CheckSymbolExists) - include(CheckCSourceRuns) - include(FindPkgConfig) - include(FindPackageHandleStandardArgs) -@@ -49,15 +50,23 @@ - set(UDUNITS OFF CACHE BOOL "Enable UDUNITS-2 ?") - set(UDUNITSDIR "" CACHE PATH "Specify the UDUNITS-2 directory tree") - -+set(EIGEN3 ON CACHE BOOL "Enable Eigen3 ?") -+set(EIGEN3DIR "" CACHE PATH "Specify the Eigen3 directory tree") -+ - set(PSLIB ON CACHE BOOL "Enable pslib ?") - set(PSLIBDIR "" CACHE PATH "Specify the pslib directory tree") - - set(GRIB OFF CACHE BOOL "Enable Grib ?") - set(GRIBDIR "" CACHE PATH "Specifiy the GRIB directory tree") - --set(MAGICK ON CACHE BOOL "Enable Magick ?") -+ -+set(MAGICK ON CACHE BOOL "Enable ImageMagick ?") - set(MAGICKDIR "" CACHE PATH "Specifiy the ImageMagick directory tree") - -+# GraphicsMagick is a good alternative to ImageMagick -+set(GRAPHICSMAGICK ON CACHE BOOL "Enable GraphicsMagick ?") -+set(GRAPHICSMAGICKDIR "" CACHE PATH "Specify the GraphicsMagick directory tree") -+ - set(NETCDF ON CACHE BOOL "Enable NetCDF ?") - set(NETCDFDIR "" CACHE PATH "Specifiy the netCDF directory tree") - -@@ -285,12 +294,58 @@ - "(suitable Fedora package: plplot-devel)") - endif(PLPLOT_FOUND) - --check_library_exists("${PLPLOT_LIBRARIES}" plP_mmpcx "" HAVE_PLPLOT_BEFORE_5994) --if(HAVE_PLPLOT_BEFORE_5994) -- message(STATUS "OK for XYOUTS in plplot") --else(HAVE_PLPLOT_BEFORE_5994) -- message(STATUS "warning for XYOUTS in plplot") --endif(HAVE_PLPLOT_BEFORE_5994) -+if(PLPLOT_FOUND) -+ check_library_exists("${PLPLOT_LIBRARIES}" c_plslabelfunc "" HAVE_PLPLOT_SLABELFUNC) -+ if(HAVE_PLPLOT_SLABELFUNC) -+ set(HAVE_PLPLOT_SLABELFUNC 1) -+ else(HAVE_PLPLOT_SLABELFUNC) -+ message(STATUS "warning, due to old plplot library, [XYZ]TICKFORMAT option for plot axis will not be supported.\n" -+ "you should upgrade to plplot version > 5.9.6") -+ endif(HAVE_PLPLOT_SLABELFUNC) -+ check_library_exists("${PLPLOT_LIBRARIES}" plstrl "" PLPLOT_PRIVATE_NOT_HIDDEN) -+ if(PLPLOT_PRIVATE_NOT_HIDDEN) -+ set(PLPLOT_PRIVATE_NOT_HIDDEN 1) -+ else(PLPLOT_PRIVATE_NOT_HIDDEN) -+ message(STATUS "Using a plplot library without private functions - workarounds will be used.") -+ endif(PLPLOT_PRIVATE_NOT_HIDDEN) -+ check_library_exists("${PLPLOT_LIBRARIES}" c_pllegend "" PLPLOT_HAS_LEGEND) -+ if(PLPLOT_HAS_LEGEND) -+ set(PLPLOT_HAS_LEGEND 1) -+ else(PLPLOT_HAS_LEGEND) -+ message(STATUS "Your plplot lib is too old for some gdl functions, please upgrade.") -+ endif(PLPLOT_HAS_LEGEND) -+endif(PLPLOT_FOUND) -+ -+# GRAPHICSMAGICK is an alternative to the classical ImageMagick Lib. -+# -+# -DGRAPHICSMAGICK=ON|OFF -+# -DGRAPHICSMAGICKDIR=DIR -+if(GRAPHICSMAGICK) -+ if (MAGICK_FOUND) -+ message("We prefer to use GraphicsMagick than ImageMagick") -+ set(MAGICK off) -+ endif(MAGICK_FOUND) -+ set(CMAKE_PREFIX_PATH ${GRAPHICSMAGICKDIR}) -+ find_package(GraphicsMagick QUIET) -+ set(USE_MAGICK ${GRAPHICSMAGICK_FOUND}) -+ if(GRAPHICSMAGICK_FOUND) -+ include_directories(${GRAPHICSMAGICK_INCLUDE_DIR}) -+ set(LIBRARIES ${LIBRARIES} ${GRAPHICSMAGICK_LIBRARIES}) -+ else(GRAPHICSMAGICK_FOUND) -+ message( STATUS -+ "GRAPHICSMAGICK is strongly suggested but was not found. -+ Use -DGRAPHICSMAGICKDIR=DIR to specify the GraphicsMagick directory tree. -+ Use -DGRAPHICSMAGICK=OFF to not use it. -+ (suitable Fedora package: GraphicsMagick-c++-devel -+ Debian/Ubuntu package: libgraphicsmagick++1-devel)\n") -+ message( STATUS -+ "Looking for ImageMagick") -+ endif(GRAPHICSMAGICK_FOUND) -+endif(GRAPHICSMAGICK) -+ -+if(GRAPHICSMAGICK_FOUND) -+ set(MAGICK OFF) -+endif(GRAPHICSMAGICK_FOUND) - - if(MAGICK) # support Magick - check_library_exists("${PLPLOT_LIBRARIES}" plGetDrvDir "" HAVE_PLGETDRVDIR) -@@ -366,18 +421,18 @@ - find_package(NetCDF QUIET) - if(NETCDF_FOUND) - set(CMAKE_REQUIRED_INCLUDES ${NETCDF_INCLUDE_DIRS}) -- check_include_file_cxx(netcdfcpp.h HAVE_NETCDFCPP_H) -- if(HAVE_NETCDFCPP_H) -+ check_include_file_cxx(netcdf.h HAVE_NETCDF_H) -+ if(HAVE_NETCDF_H) - set(LIBRARIES ${LIBRARIES} ${NETCDF_LIBRARIES}) - set(LINK_DIRECTORIES ${LINK_DIRECTORIES} ${NETCDF_LIBRARY_DIRS}) - include_directories(${NETCDF_INCLUDE_DIRS}) - set(USE_NETCDF 1) -- else(HAVE_NETCDFCPP_H) -+ else(HAVE_NETCDF_H) - message(FATAL_ERROR "NetCDF installation seems not to be usable.\n" - "This suggests a conflicting netCDF-HDF4 installation e.g.\n" - "- Uninstalling HDF4 after installation of NetCDF.\n" - "- Installing NetCDF before HDF4.") -- endif(HAVE_NETCDFCPP_H) -+ endif(HAVE_NETCDF_H) - set(CMAKE_REQUIRED_INCLUDES) - else(NETCDF_FOUND) - message(FATAL_ERROR "NetCDF version 3.5.1 or later is required but was not found.\n" -@@ -555,8 +610,13 @@ - message("-- Found Python executable: ${PYTHON_EXECUTABLE}") - endif() - else() -+ if(PYTHONVERSION) -+ set(PythonLibs_FIND_VERSION ${PYTHONVERSION}) -+ else() -+ set(PythonLibs_FIND_VERSION 2) -+ endif() - find_package(PythonLibs) -- include(FindPythonInterp) -+ include(FindPythonInterp) - endif() - set(USE_PYTHON ${PYTHONLIBS_FOUND}) - if(PYTHONLIBS_FOUND) -@@ -596,6 +656,23 @@ - endif(UDUNITS_FOUND) - endif(UDUNITS) - -+# eigen3 -+# -DEIGEN3=ON|OFF -+# -DEIGEN3DIR=DIR -+if(EIGEN3) -+ set(CMAKE_PREFIX_PATH ${EIGEN3DIR}) -+ find_package(Eigen3 QUIET) -+ set(USE_EIGEN ${EIGEN3_FOUND}) -+ if(EIGEN3_FOUND) -+ include_directories(${EIGEN3_INCLUDE_DIR}) -+ else(EIGEN3_FOUND) -+ message(FATAL_ERROR "EIGEN3 is required but was not found.\n" -+ "Use -DEIGEN3DIR=DIR to specify the Eigen3 directory tree.\n" -+ "Use -DEIGEN3=OFF to not use it.\n" -+ "(suitable Fedora package: eigen3-devel)") -+ endif(EIGEN3_FOUND) -+endif(EIGEN3) -+ - # pslib - # -DPSLIB=ON|OFF - # -DPSLIBDIR=DIR -@@ -716,9 +793,9 @@ - ENDIF(NOT CMAKE_BUILD_TYPE) - - if(WIN32 AND NOT CYGWIN) --SET(MACHINE_ARCH ${MSVC_C_ARCHITECTURE_ID}) --IF(NOT MACHINE_ARCH) -- SET(MACHINE_ARCH ${MSVC_CXX_ARCHITECTURE_ID}) -+SET(MACHINE_ARCH ${MSVC_C_ARCHITECTURE_ID}) -+IF(NOT MACHINE_ARCH) -+ SET(MACHINE_ARCH ${MSVC_CXX_ARCHITECTURE_ID}) - ENDIF(NOT MACHINE_ARCH) - set_target_properties(gdl PROPERTIES LINK_FLAGS "/machine:${MACHINE_ARCH}") - endif(WIN32 AND NOT CYGWIN) -@@ -726,7 +803,6 @@ - # AC, 12-oct-2011, solved by Marc - # set_target_properties(gdl PROPERTIES LINK_FLAGS "-Wl,-z,muldefs") - # set_target_properties(gdl PROPERTIES LINK_FLAGS "-z muldefs") -- - # - if(CMAKE_BUILD_TYPE STREQUAL None OR NOT CMAKE_BUILD_TYPE) - set(FLAGS ${CMAKE_CXX_FLAGS}) -@@ -739,6 +815,8 @@ - elseif(CMAKE_BUILD_TYPE STREQUAL MinSizeRel) - set(FLAGS ${CMAKE_CXX_FLAGS_MINSIZEREL}) - endif(CMAKE_BUILD_TYPE STREQUAL None OR NOT CMAKE_BUILD_TYPE) -+ -+ - message(STATUS - "Summary - -@@ -767,6 +845,8 @@ - module(MPICH "MPICH ") - module(PYTHON "Python ") - module(UDUNITS "UDUNITS-2 ") -+module(EIGEN3 "EIGEN3 ") -+module(GRAPHICSMAGICK "GRAPHICSMAGICK") - module(GRIB "GRIB ") - set(GSHHS_LIBRARIES ${GSHHS_INCLUDE_DIR}) - module(GSHHS "GSHHS ") -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeModules/FindEigen3.cmake gdl/CMakeModules/FindEigen3.cmake ---- gdl-0.9.3/CMakeModules/FindEigen3.cmake 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/CMakeModules/FindEigen3.cmake 2013-02-18 02:05:41.000000000 -0700 -@@ -0,0 +1,81 @@ -+# - Try to find Eigen3 lib -+# -+# This module supports requiring a minimum version, e.g. you can do -+# find_package(Eigen3 3.1.2) -+# to require version 3.1.2 or newer of Eigen3. -+# -+# Once done this will define -+# -+# EIGEN3_FOUND - system has eigen lib with correct version -+# EIGEN3_INCLUDE_DIR - the eigen include directory -+# EIGEN3_VERSION - eigen version -+ -+# Copyright (c) 2006, 2007 Montel Laurent, -+# Copyright (c) 2008, 2009 Gael Guennebaud, -+# Copyright (c) 2009 Benoit Jacob -+# Redistribution and use is allowed according to the terms of the 2-clause BSD license. -+ -+if(NOT Eigen3_FIND_VERSION) -+ if(NOT Eigen3_FIND_VERSION_MAJOR) -+ set(Eigen3_FIND_VERSION_MAJOR 2) -+ endif(NOT Eigen3_FIND_VERSION_MAJOR) -+ if(NOT Eigen3_FIND_VERSION_MINOR) -+ set(Eigen3_FIND_VERSION_MINOR 91) -+ endif(NOT Eigen3_FIND_VERSION_MINOR) -+ if(NOT Eigen3_FIND_VERSION_PATCH) -+ set(Eigen3_FIND_VERSION_PATCH 0) -+ endif(NOT Eigen3_FIND_VERSION_PATCH) -+ -+ set(Eigen3_FIND_VERSION "${Eigen3_FIND_VERSION_MAJOR}.${Eigen3_FIND_VERSION_MINOR}.${Eigen3_FIND_VERSION_PATCH}") -+endif(NOT Eigen3_FIND_VERSION) -+ -+macro(_eigen3_check_version) -+ file(READ "${EIGEN3_INCLUDE_DIR}/Eigen/src/Core/util/Macros.h" _eigen3_version_header) -+ -+ string(REGEX MATCH "define[ \t]+EIGEN_WORLD_VERSION[ \t]+([0-9]+)" _eigen3_world_version_match "${_eigen3_version_header}") -+ set(EIGEN3_WORLD_VERSION "${CMAKE_MATCH_1}") -+ string(REGEX MATCH "define[ \t]+EIGEN_MAJOR_VERSION[ \t]+([0-9]+)" _eigen3_major_version_match "${_eigen3_version_header}") -+ set(EIGEN3_MAJOR_VERSION "${CMAKE_MATCH_1}") -+ string(REGEX MATCH "define[ \t]+EIGEN_MINOR_VERSION[ \t]+([0-9]+)" _eigen3_minor_version_match "${_eigen3_version_header}") -+ set(EIGEN3_MINOR_VERSION "${CMAKE_MATCH_1}") -+ -+ set(EIGEN3_VERSION ${EIGEN3_WORLD_VERSION}.${EIGEN3_MAJOR_VERSION}.${EIGEN3_MINOR_VERSION}) -+ if(${EIGEN3_VERSION} VERSION_LESS ${Eigen3_FIND_VERSION}) -+ set(EIGEN3_VERSION_OK FALSE) -+ else(${EIGEN3_VERSION} VERSION_LESS ${Eigen3_FIND_VERSION}) -+ set(EIGEN3_VERSION_OK TRUE) -+ endif(${EIGEN3_VERSION} VERSION_LESS ${Eigen3_FIND_VERSION}) -+ -+ if(NOT EIGEN3_VERSION_OK) -+ -+ message(STATUS "Eigen3 version ${EIGEN3_VERSION} found in ${EIGEN3_INCLUDE_DIR}, " -+ "but at least version ${Eigen3_FIND_VERSION} is required") -+ endif(NOT EIGEN3_VERSION_OK) -+endmacro(_eigen3_check_version) -+ -+if (EIGEN3_INCLUDE_DIR) -+ -+ # in cache already -+ _eigen3_check_version() -+ set(EIGEN3_FOUND ${EIGEN3_VERSION_OK}) -+ -+else (EIGEN3_INCLUDE_DIR) -+ -+ find_path(EIGEN3_INCLUDE_DIR NAMES signature_of_eigen3_matrix_library -+ PATHS -+ ${CMAKE_INSTALL_PREFIX}/include -+ ${KDE4_INCLUDE_DIR} -+ PATH_SUFFIXES eigen3 eigen -+ ) -+ -+ if(EIGEN3_INCLUDE_DIR) -+ _eigen3_check_version() -+ endif(EIGEN3_INCLUDE_DIR) -+ -+ include(FindPackageHandleStandardArgs) -+ find_package_handle_standard_args(Eigen3 DEFAULT_MSG EIGEN3_INCLUDE_DIR EIGEN3_VERSION_OK) -+ -+ mark_as_advanced(EIGEN3_INCLUDE_DIR) -+ -+endif(EIGEN3_INCLUDE_DIR) -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeModules/FindGraphicsMagick.cmake gdl/CMakeModules/FindGraphicsMagick.cmake ---- gdl-0.9.3/CMakeModules/FindGraphicsMagick.cmake 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/CMakeModules/FindGraphicsMagick.cmake 2013-04-23 08:09:40.000000000 -0600 -@@ -0,0 +1,24 @@ -+# -+# copyright : (c) 2013 Sacha Hony -+# -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 2 of the License, or -+# (at your option) any later version. -+# -+# http://sourceforge.net/tracker/?func=detail&aid=3611651&group_id=97659&atid=618685 -+# -+# Find the GraphicsMagick includes and library -+# -+ -+find_library(GRAPHICSMAGICK_LIBRARY NAMES GraphicsMagick) -+find_library(GRAPHICSMAGICKXX_LIBRARY NAMES GraphicsMagick++) -+set(GRAPHICSMAGICK_LIBRARIES ${GRAPHICSMAGICK_LIBRARY} ${GRAPHICSMAGICKXX_LIBRARY}) -+find_path(GRAPHICSMAGICK_INCLUDE_DIR NAMES magick/api.h PATH_SUFFIXES GraphicsMagick) -+include(FindPackageHandleStandardArgs) -+find_package_handle_standard_args(GRAPHICSMAGICK DEFAULT_MSG GRAPHICSMAGICK_LIBRARIES GRAPHICSMAGICK_INCLUDE_DIR) -+ -+mark_as_advanced( -+GRAPHICSMAGICK_LIBRARIES -+GRAPHICSMAGICK_INCLUDE_DIR -+) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeModules/FindImageMagick.cmake gdl/CMakeModules/FindImageMagick.cmake ---- gdl-0.9.3/CMakeModules/FindImageMagick.cmake 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/CMakeModules/FindImageMagick.cmake 2013-06-07 07:21:14.000000000 -0600 -@@ -0,0 +1,255 @@ -+# - Find the ImageMagick binary suite. -+# This module will search for a set of ImageMagick tools specified -+# as components in the FIND_PACKAGE call. Typical components include, -+# but are not limited to (future versions of ImageMagick might have -+# additional components not listed here): -+# -+# animate -+# compare -+# composite -+# conjure -+# convert -+# display -+# identify -+# import -+# mogrify -+# montage -+# stream -+# -+# If no component is specified in the FIND_PACKAGE call, then it only -+# searches for the ImageMagick executable directory. This code defines -+# the following variables: -+# -+# ImageMagick_FOUND - TRUE if all components are found. -+# ImageMagick_EXECUTABLE_DIR - Full path to executables directory. -+# ImageMagick__FOUND - TRUE if is found. -+# ImageMagick__EXECUTABLE - Full path to executable. -+# ImageMagick_VERSION_STRING - the version of ImageMagick found -+# (since CMake 2.8.8) -+# -+# ImageMagick_VERSION_STRING will not work for old versions like 5.2.3. -+# -+# There are also components for the following ImageMagick APIs: -+# -+# Magick++ -+# MagickWand -+# MagickCore -+# -+# For these components the following variables are set: -+# -+# ImageMagick_FOUND - TRUE if all components are found. -+# ImageMagick_INCLUDE_DIRS - Full paths to all include dirs. -+# ImageMagick_LIBRARIES - Full paths to all libraries. -+# ImageMagick__FOUND - TRUE if is found. -+# ImageMagick__INCLUDE_DIRS - Full path to include dirs. -+# ImageMagick__LIBRARIES - Full path to libraries. -+# -+# Example Usages: -+# find_package(ImageMagick) -+# find_package(ImageMagick COMPONENTS convert) -+# find_package(ImageMagick COMPONENTS convert mogrify display) -+# find_package(ImageMagick COMPONENTS Magick++) -+# find_package(ImageMagick COMPONENTS Magick++ convert) -+# -+# Note that the standard FIND_PACKAGE features are supported -+# (i.e., QUIET, REQUIRED, etc.). -+ -+#============================================================================= -+# Copyright 2007-2009 Kitware, Inc. -+# Copyright 2007-2008 Miguel A. Figueroa-Villanueva -+# Copyright 2012 Rolf Eike Beer -+# Copyright 2013 Nodar Kasradze : full (better ;) support of local install of IM -+# -+# Distributed under the OSI-approved BSD License (the "License"); -+# see accompanying file Copyright.txt for details. -+# -+# This software is distributed WITHOUT ANY WARRANTY; without even the -+# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -+# See the License for more information. -+#============================================================================= -+# (To distribute this file outside of CMake, substitute the full -+# License text for the above reference.) -+ -+# Define variables -+set(ENV{PATH} "${MAGICKDIR}/bin:$ENV{PATH}") -+set(ENV{PKG_CONFIG_PATH} "${MAGICKDIR}/lib/pkgconfig/:$ENV{PKG_CONFIG_PATH}") -+ -+#--------------------------------------------------------------------- -+# Helper functions -+#--------------------------------------------------------------------- -+ -+ -+function(FIND_IMAGEMAGICK_API component header) -+ set(ImageMagick_${component}_FOUND FALSE PARENT_SCOPE) -+ -+ find_path(ImageMagick_${component}_INCLUDE_DIR -+ NAMES ${header} -+ PATHS -+ ${ImageMagick_INCLUDE_DIRS} -+ "[HKEY_LOCAL_MACHINE\\SOFTWARE\\ImageMagick\\Current;BinPath]/include" -+ PATH_SUFFIXES -+ ImageMagick ImageMagick-6 -+ DOC "Path to the ImageMagick include dir." -+ ) -+ -+ find_library(ImageMagick_${component}_LIBRARY -+ NAMES ${ARGN} -+ PATHS -+ ${CMAKE_PREFIX_PATH}/lib -+ NO_DEFAULT_PATH -+ DOC "Path to the ImageMagick Magick++ library." -+ ) -+ -+ find_library(ImageMagick_${component}_LIBRARY -+ NAMES ${ARGN} -+ PATHS -+ "[HKEY_LOCAL_MACHINE\\SOFTWARE\\ImageMagick\\Current;BinPath]/lib" -+ DOC "Path to the ImageMagick Magick++ library." -+ ) -+ -+ -+ if(ImageMagick_${component}_INCLUDE_DIR AND ImageMagick_${component}_LIBRARY) -+ set(ImageMagick_${component}_FOUND TRUE PARENT_SCOPE) -+ -+ list(APPEND ImageMagick_INCLUDE_DIRS -+ ${ImageMagick_${component}_INCLUDE_DIR} -+ ) -+ list(REMOVE_DUPLICATES ImageMagick_INCLUDE_DIRS) -+ set(ImageMagick_INCLUDE_DIRS ${ImageMagick_INCLUDE_DIRS} PARENT_SCOPE) -+ -+ list(APPEND ImageMagick_LIBRARIES -+ ${ImageMagick_${component}_LIBRARY} -+ ) -+ set(ImageMagick_LIBRARIES ${ImageMagick_LIBRARIES} PARENT_SCOPE) -+ endif() -+endfunction() -+ -+function(FIND_IMAGEMAGICK_EXE component) -+ -+ set(_IMAGEMAGICK_EXECUTABLE -+ ${ImageMagick_EXECUTABLE_DIR}/${component}${CMAKE_EXECUTABLE_SUFFIX}) -+ if(EXISTS ${_IMAGEMAGICK_EXECUTABLE}) -+ set(ImageMagick_${component}_EXECUTABLE -+ ${_IMAGEMAGICK_EXECUTABLE} -+ PARENT_SCOPE -+ ) -+ set(ImageMagick_${component}_FOUND TRUE PARENT_SCOPE) -+ else() -+ set(ImageMagick_${component}_FOUND FALSE PARENT_SCOPE) -+ endif() -+endfunction() -+ -+#--------------------------------------------------------------------- -+# Start Actual Work -+#--------------------------------------------------------------------- -+# Try to find a ImageMagick installation binary path. -+find_path(ImageMagick_EXECUTABLE_DIR -+ NAMES mogrify${CMAKE_EXECUTABLE_SUFFIX} -+ PATHS -+ "[HKEY_LOCAL_MACHINE\\SOFTWARE\\ImageMagick\\Current;BinPath]" -+ DOC "Path to the ImageMagick binary directory." -+ NO_DEFAULT_PATH -+ ) -+find_path(ImageMagick_EXECUTABLE_DIR -+ NAMES mogrify${CMAKE_EXECUTABLE_SUFFIX} -+ ) -+ -+# Find each component. Search for all tools in same dir -+# ; otherwise they should be found -+# independently and not in a cohesive module such as this one. -+unset(ImageMagick_REQUIRED_VARS) -+unset(ImageMagick_DEFAULT_EXECUTABLES) -+foreach(component ${ImageMagick_FIND_COMPONENTS} -+ # DEPRECATED: forced components for backward compatibility -+ convert mogrify import montage composite -+ ) -+ if(component STREQUAL "Magick++") -+ FIND_IMAGEMAGICK_API(Magick++ Magick++.h -+ Magick++ CORE_RL_Magick++_ Magick++-6.Q16 Magick++-Q16 Magick++-6.Q8 Magick++-Q8 -+ ) -+ list(APPEND ImageMagick_REQUIRED_VARS ImageMagick_Magick++_LIBRARY) -+ elseif(component STREQUAL "MagickWand") -+ FIND_IMAGEMAGICK_API(MagickWand wand/MagickWand.h -+ Wand MagickWand CORE_RL_wand_ MagickWand-6.Q16 MagickWand-Q16 MagickWand-6.Q8 MagickWand-Q8 -+ ) -+ list(APPEND ImageMagick_REQUIRED_VARS ImageMagick_MagickWand_LIBRARY) -+ elseif(component STREQUAL "MagickCore") -+ FIND_IMAGEMAGICK_API(MagickCore magick/MagickCore.h -+ Magick MagickCore CORE_RL_magick_ MagickCore-6.Q16 MagickCore-Q16 MagickCore-6.Q8 MagickCore-Q8 -+ ) -+ list(APPEND ImageMagick_REQUIRED_VARS ImageMagick_MagickCore_LIBRARY) -+ else() -+ if(ImageMagick_EXECUTABLE_DIR) -+ FIND_IMAGEMAGICK_EXE(${component}) -+ endif() -+ -+ if(ImageMagick_FIND_COMPONENTS) -+ list(FIND ImageMagick_FIND_COMPONENTS ${component} is_requested) -+ if(is_requested GREATER -1) -+ list(APPEND ImageMagick_REQUIRED_VARS ImageMagick_${component}_EXECUTABLE) -+ endif() -+ elseif(ImageMagick_${component}_EXECUTABLE) -+ # if no components were requested explicitly put all (default) executables -+ # in the list -+ list(APPEND ImageMagick_DEFAULT_EXECUTABLES ImageMagick_${component}_EXECUTABLE) -+ endif() -+ endif() -+endforeach() -+ -+if(NOT ImageMagick_FIND_COMPONENTS AND NOT ImageMagick_DEFAULT_EXECUTABLES) -+ # No components were requested, and none of the default components were -+ # found. Just insert mogrify into the list of the default components to -+ # find so FPHSA below has something to check -+ list(APPEND ImageMagick_REQUIRED_VARS ImageMagick_mogrify_EXECUTABLE) -+elseif(ImageMagick_DEFAULT_EXECUTABLES) -+ list(APPEND ImageMagick_REQUIRED_VARS ${ImageMagick_DEFAULT_EXECUTABLES}) -+endif() -+ -+set(ImageMagick_INCLUDE_DIRS ${ImageMagick_INCLUDE_DIRS}) -+set(ImageMagick_LIBRARIES ${ImageMagick_LIBRARIES}) -+ -+if(ImageMagick_mogrify_EXECUTABLE) -+ execute_process(COMMAND ${ImageMagick_mogrify_EXECUTABLE} -version -+ OUTPUT_VARIABLE imagemagick_version -+ ERROR_QUIET -+ OUTPUT_STRIP_TRAILING_WHITESPACE) -+ if(imagemagick_version MATCHES "^Version: ImageMagick [0-9]") -+ string(REGEX REPLACE "^Version: ImageMagick ([-0-9\\.]+).*" "\\1" ImageMagick_VERSION_STRING "${imagemagick_version}") -+ endif() -+ unset(imagemagick_version) -+endif() -+ -+#--------------------------------------------------------------------- -+# Standard Package Output -+#--------------------------------------------------------------------- -+include(FindPackageHandleStandardArgs) -+FIND_PACKAGE_HANDLE_STANDARD_ARGS(ImageMagick -+ REQUIRED_VARS ${ImageMagick_REQUIRED_VARS} -+ VERSION_VAR ImageMagick_VERSION_STRING -+ ) -+# Maintain consistency with all other variables. -+set(ImageMagick_FOUND ${IMAGEMAGICK_FOUND}) -+ -+#--------------------------------------------------------------------- -+# DEPRECATED: Setting variables for backward compatibility. -+#--------------------------------------------------------------------- -+set(IMAGEMAGICK_BINARY_PATH ${ImageMagick_EXECUTABLE_DIR} -+ CACHE PATH "Path to the ImageMagick binary directory.") -+set(IMAGEMAGICK_CONVERT_EXECUTABLE ${ImageMagick_convert_EXECUTABLE} -+ CACHE FILEPATH "Path to ImageMagick's convert executable.") -+set(IMAGEMAGICK_MOGRIFY_EXECUTABLE ${ImageMagick_mogrify_EXECUTABLE} -+ CACHE FILEPATH "Path to ImageMagick's mogrify executable.") -+set(IMAGEMAGICK_IMPORT_EXECUTABLE ${ImageMagick_import_EXECUTABLE} -+ CACHE FILEPATH "Path to ImageMagick's import executable.") -+set(IMAGEMAGICK_MONTAGE_EXECUTABLE ${ImageMagick_montage_EXECUTABLE} -+ CACHE FILEPATH "Path to ImageMagick's montage executable.") -+set(IMAGEMAGICK_COMPOSITE_EXECUTABLE ${ImageMagick_composite_EXECUTABLE} -+ CACHE FILEPATH "Path to ImageMagick's composite executable.") -+mark_as_advanced( -+ IMAGEMAGICK_BINARY_PATH -+ IMAGEMAGICK_CONVERT_EXECUTABLE -+ IMAGEMAGICK_MOGRIFY_EXECUTABLE -+ IMAGEMAGICK_IMPORT_EXECUTABLE -+ IMAGEMAGICK_MONTAGE_EXECUTABLE -+ IMAGEMAGICK_COMPOSITE_EXECUTABLE -+ ) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeModules/Findlibps.cmake gdl/CMakeModules/Findlibps.cmake ---- gdl-0.9.3/CMakeModules/Findlibps.cmake 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/CMakeModules/Findlibps.cmake 2013-02-25 17:04:20.000000000 -0700 -@@ -1,4 +1,4 @@ --find_path(LIBPSPKG libps.pc PATH_SUFFIXES lib lib/pkgconfig) -+find_path(LIBPSPKG libps.pc PATH_SUFFIXES lib lib/pkgconfig lib64/pkgconfig) - include(FindPackageHandleStandardArgs) - if(LIBPSPKG) - set(ENV{PKG_CONFIG_PATH} ${LIBPSPKG}) # pkg search path -Only in gdl-0.9.3/CMakeModules: Findlibps.cmake.~1.2.~ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeModules/FindNetCDF.cmake gdl/CMakeModules/FindNetCDF.cmake ---- gdl-0.9.3/CMakeModules/FindNetCDF.cmake 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/CMakeModules/FindNetCDF.cmake 2013-05-16 12:36:32.000000000 -0600 -@@ -9,24 +9,17 @@ - # - - --find_path(NETCDFPKG netcdf.pc PATH_SUFFIXES lib lib/pkgconfig) --include(FindPackageHandleStandardArgs) --if(NETCDFPKG) -- set(ENV{PKG_CONFIG_PATH} ${NETCDFPKG}) # pkg search path -- include(FindPkgConfig) -- pkg_check_modules(NETCDF netcdf) -- if(NETCDF_FOUND) -- find_package_handle_standard_args(NETCDF DEFAULT_MSG NETCDF_LIBRARIES NETCDF_INCLUDE_DIRS) -- endif(NETCDF_FOUND) --else(NETCDFPKG) # no netcdf.pc file -+find_package(PkgConfig QUIET) -+pkg_check_modules(NETCDF netcdf) -+if(NETCDF_FOUND) # no netcdf.pc file -+ find_package_handle_standard_args(NETCDF DEFAULT_MSG NETCDF_LIBRARIES) -+else(NETCDF_FOUND) # no netcdf.pc file - find_library(NETCDF_LIBRARIES NAMES netcdf) -- find_path(NETCDF_INCLUDE_DIRS NAMES netcdfcpp.h PATH_SUFFIXES netcdf-3) -+ find_path(NETCDF_INCLUDE_DIRS NAMES netcdf.h PATH_SUFFIXES netcdf-3) - find_package_handle_standard_args(NETCDF DEFAULT_MSG NETCDF_LIBRARIES NETCDF_INCLUDE_DIRS) --endif(NETCDFPKG) -+endif(NETCDF_FOUND) - - mark_as_advanced( --NETCDFPKG --NETCDF - NETCDF_INCLUDE_DIRS - NETCDF_LIBRARIES - ) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeModules/FindPCRE.cmake gdl/CMakeModules/FindPCRE.cmake ---- gdl-0.9.3/CMakeModules/FindPCRE.cmake 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/CMakeModules/FindPCRE.cmake 2012-09-28 04:20:00.000000000 -0600 -@@ -1,8 +1,7 @@ - # --# copyright : (c) 2010 Maxime Lenoir, Alain Coulais, --# Sylwester Arabas, and Orion Poplawski --# --# 2012/Sep/18 Jeongbin Park added this file; to support Windows platform. -+# copyright : (c) 2012 Jeongbin Park -+# -+# 2012/Sep/18 Jeongbin Park added this file; to support Windows platform. - # - # This program is free software; you can redistribute it and/or modify - # it under the terms of the GNU General Public License as published by -@@ -10,7 +9,6 @@ - # (at your option) any later version. - # - -- - find_library(PCRE_LIBRARY NAMES pcre) - set(PCRE_LIBRARIES ${PCRE_LIBRARY}) - find_path(PCRE_INCLUDE_DIR NAMES regex.h) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/CMakeModules/FindXdr.cmake gdl/CMakeModules/FindXdr.cmake ---- gdl-0.9.3/CMakeModules/FindXdr.cmake 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/CMakeModules/FindXdr.cmake 2012-09-28 04:20:00.000000000 -0600 -@@ -1,24 +1,22 @@ --# --# copyright : (c) 2010 Maxime Lenoir, Alain Coulais, --# Sylwester Arabas, and Orion Poplawski --# --# 2012/Sep/18 Jeongbin Park added this file; to support Windows platform. --# --# This program is free software; you can redistribute it and/or modify --# it under the terms of the GNU General Public License as published by --# the Free Software Foundation; either version 2 of the License, or --# (at your option) any later version. --# -- -- --find_library(XDR_LIBRARY NAMES xdr) --set(XDR_LIBRARIES ${XDR_LIBRARY}) --find_path(XDR_INCLUDE_DIR NAMES rpc/xdr.h) --include(FindPackageHandleStandardArgs) --find_package_handle_standard_args(XDR DEFAULT_MSG XDR_LIBRARIES XDR_INCLUDE_DIR) -- --mark_as_advanced( --XDR_LIBRARY --XDR_LIBRARIES --XDR_INCLUDE_DIR --) -+# -+# copyright : (c) 2012 Jeongbin Park -+# -+# 2012/Sep/18 Jeongbin Park added this file; to support Windows platform. -+# -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 2 of the License, or -+# (at your option) any later version. -+# -+ -+find_library(XDR_LIBRARY NAMES xdr) -+set(XDR_LIBRARIES ${XDR_LIBRARY}) -+find_path(XDR_INCLUDE_DIR NAMES rpc/xdr.h) -+include(FindPackageHandleStandardArgs) -+find_package_handle_standard_args(XDR DEFAULT_MSG XDR_LIBRARIES XDR_INCLUDE_DIR) -+ -+mark_as_advanced( -+XDR_LIBRARY -+XDR_LIBRARIES -+XDR_INCLUDE_DIR -+) -Only in gdl-0.9.3: config.guess -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/config.h.cmake gdl/config.h.cmake ---- gdl-0.9.3/config.h.cmake 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/config.h.cmake 2013-05-21 09:16:08.000000000 -0600 -@@ -27,7 +27,9 @@ - #cmakedefine HAVE_MEMORY_H 1 - #cmakedefine HAVE_NEXTTOWARD 1 - #cmakedefine HAVE_OLDPLPLOT 1 --#cmakedefine HAVE_PLPLOT_BEFORE_5994 1 -+#cmakedefine HAVE_PLPLOT_SLABELFUNC 1 -+#cmakedefine PLPLOT_PRIVATE_NOT_HIDDEN 1 -+#cmakedefine PLPLOT_HAS_LEGEND - #ifndef HAVE_STDINT_H - #cmakedefine HAVE_STDINT_H 1 - #endif -@@ -66,5 +68,6 @@ - #cmakedefine USE_PYTHON 1 - #cmakedefine USE_UDUNITS 1 - #cmakedefine USE_PSLIB 1 -+#cmakedefine USE_EIGEN 1 - - #endif -Only in gdl-0.9.3: config.sub -Only in gdl-0.9.3: configure -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/configure.in gdl/configure.in ---- gdl-0.9.3/configure.in 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/configure.in 2013-07-08 12:39:20.397410867 -0600 -@@ -1,4 +1,4 @@ --AC_INIT(gdl, 0.9.3) -+AC_INIT(gdl, 0.9.3 CVS) - AC_CONFIG_MACRO_DIR([m4]) - - dnl == Configuration (of the configure script) ============ -@@ -16,6 +16,7 @@ - if test "x$with_grib" = "x"; then with_grib=no; fi - if test "x$with_Magick" = "x"; then with_Magick=yes; fi - if test "x$with_GraphicsMagick" = "x"; then with_GraphicsMagick=no; fi -+if test "x$with_eigen3" = "x"; then with_eigen3=auto; fi - if test "x$with_netcdf" = "x"; then with_netcdf=yes; fi - if test "x$with_hdf" = "x"; then with_hdf=yes; fi - if test "x$with_hdf5" = "x"; then with_hdf5=yes; fi -@@ -314,12 +315,29 @@ - - dnl recent plplot (5.9.9-4) in Debian unstable version have hidden symbols - --AC_CHECK_LIB(plplotcxxd, plP_mmpcx, -- [AC_DEFINE([HAVE_PLPLOT_BEFORE_5994], [1], [plplot 5994 library])], -+AC_CHECK_LIB(plplotcxxd, c_plslabelfunc, -+ [AC_DEFINE([HAVE_PLPLOT_SLABELFUNC], [1], [plplot slabel library])], - [ - echo "" -- echo "Warning ! limited features in XYOUTS in GDL due to private symbols in plplot lib ..." -- echo "" -+ echo "Warning, due to old plplot library, [XYZ]TICKFORMAT option for plot axis will not be supported." -+ echo "you should upgrade to plplot version > 5.9.6" -+ echo "" -+ ]) -+ -+AC_CHECK_LIB(plplotcxxd, plstrl, -+ [AC_DEFINE([PLPLOT_PRIVATE_NOT_HIDDEN], [1], [plplot private pb. library])], -+ [ -+ echo "" -+ echo "Using a plplot library without private functions - workarounds will be used." -+ echo "" -+ ]) -+ -+AC_CHECK_LIB(plplotcxxd, c_pllegend, -+ [AC_DEFINE([PLPLOT_HAS_LEGEND], [1], [plplot private pb. library])], -+ [ -+ echo "" -+ echo "Your plplot lib is too old for some gdl functions, please upgrade." -+ echo "" - ]) - - if test "x$with_Magick" != "xno"; then -@@ -497,6 +515,26 @@ - ) - fi - -+dnl == Eigen3 ================================================= -+dnl ======================================================== -+ -+if test "x$with_eigen3" = "xauto"; then -+ AC_CHECK_FILE("/usr/include/eigen3/signature_of_eigen3_matrix_library", -+ [with_eigen3=yes], [with_eigen3=no]) -+ if test "x$with_eigen3" = "xyes"; then -+ AC_DEFINE([USE_EIGEN], [1], [Define if you want to use Eigen lib.]) -+ INCLUDES="$INCLUDES -I/usr/include/eigen3/" -+ fi -+else -+ AC_ARG_WITH(eigen3, -+ [ --with-eigen3=DIR specify the Eigen3 package ((with optional path DIR) ], -+ [with_eigen3="$withval" ]) -+ -+ if test "x$with_eigen3" != "xno"; then -+ AC_DEFINE([USE_EIGEN], [1], [Define if you want to use Eigen lib.]) -+ INCLUDES="$INCLUDES -I$with_eigen3" -+ fi -+fi - dnl == netCDF ============================================== - dnl ======================================================== - -@@ -541,8 +579,8 @@ - exit -1 - ]) - -- AC_CHECK_HEADERS("netcdfcpp.h", [], [ -- AC_CHECK_HEADERS("$ncdfincdir/netcdfcpp.h", [], [ -+ AC_CHECK_HEADERS("netcdf.h", [], [ -+ AC_CHECK_HEADERS("$ncdfincdir/netcdf.h", [], [ - echo "" - echo "Error! netCDF installation seems not to be usable" - echo " This suggests a conflicting netCDF-HDF4 installation, e.g." -@@ -1203,6 +1241,8 @@ - then echo 'no'; else echo yes; fi` - GraphicsMagick: `if test no = $with_GraphicsMagick; - then echo 'no'; else echo yes; fi` -+ Eigen: `if test no = $with_eigen; -+ then echo 'no'; else echo yes; fi` - NetCDF: `if test no = $with_netcdf; - then echo 'no'; else echo yes; fi` - HDF4: `if test no = $with_hdf; -Only in gdl-0.9.3: depcomp -Only in gdl-0.9.3/doc: Makefile.in -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/udg/README.txt gdl/doc/udg/README.txt ---- gdl-0.9.3/doc/udg/README.txt 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/doc/udg/README.txt 2013-05-16 12:36:32.000000000 -0600 -@@ -7,6 +7,11 @@ - 0/ You must have compiled GDL before - - 1/ You must collect some external files before: -+-- forloop.sty -+http://www.ctan.org/tex-archive/macros/latex/contrib/forloop -+ -+-- stringstrings.sty -+http://www.ctan.org/tex-archive/macros/latex/contrib/stringstrings - - -- pdfdraftcopy.sty - see http://sarovar.org/projects/pdfdraftcopy/ -@@ -19,6 +24,7 @@ - -- copernicus.bst - see http://publications.copernicus.org/ - (wget http://publications.copernicus.org/Copernicus.bst) -+note: you need to rename it "copernicus.bst" - - -- Perl Script authorindex - see http://mirrors.ctan.org/indexing/authorindex/ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/contribute.html gdl/doc/www/contribute.html ---- gdl-0.9.3/doc/www/contribute.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/contribute.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL Contribute -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/credits.html gdl/doc/www/credits.html ---- gdl-0.9.3/doc/www/credits.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/credits.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL credits -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/credits.php gdl/doc/www/credits.php ---- gdl-0.9.3/doc/www/credits.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/credits.php 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,128 @@ -+ -+ -+

Credits

-+ -+

-+The project was founded and is maintained by: -+

-+ -+ -+ -+

-+As of 2012 the core team consists additionally of (in alphabetical order): -+

-+ -+
    -+
  • -+Sylwester Arabas -+
    -+Library routines, testing, documentation, portability issues -+
    • -+ -+
  • -+Alain Coulais -+
    -+Library routines, testing, documentation, presentations -+
    • -+ -+
  • -+Gilles Duvert -+
    -+Library routines, plotting, testing -+
    • -+ -+
  • -+Joel Gales -+
    -+Library routines (TV, FFT, HISTOGRAM, HDF support, widgets) -+
    • -+
-+ -+

-+Among many good folks who provided patches and valuable feedback (in alphabetical order): -+

-+

-+Médéric Bocquien, -+Justin Bronn, -+Pierre Chanial, -+Christoph Fuchs, -+Nicolas Galmiche, -+Greg Huey, -+Gaurav Khanna, -+Benjamin Laurent, -+Christopher Lee, -+Maxime Lenoir, -+Peter Messmer, -+Gregory Marchal, -+Thibaut Mermet, -+Léa Noreskal, -+Jeong Bin Park, -+Mathieu Pinter, -+Orion Poplawski, -+Rene Preusker, -+Mateusz Turcza, -+Joanna Woo, -+H Xu, -+... -+

-+ -+

-+GDL contains snippets of code borrowed from other free and open-source projects credited to: -+

-+ -+

-+Deepak Bandyopadhyay, -+Sergio Gelato, -+Lutz Kettner, -+Craig B. Markwardt, -+Paul Ricchiazzi, -+Danny Smith, -+J.D. Smith, -+Richard Schwartz, -+Paul Wessel, -+Bob Withers, -+... -+

-+ -+

Pre-compiled or pre-configured packages of GDL are available for numerous systems thanks to:

-+ -+

-+Juan A. Añel, -+Axel Beckert, -+Markus Dittrich, -+Takeshi Enomoto, -+Sébastien Fabbro, -+Orlando Garcia Feal, -+Gaurav Khanna, -+Justin Lecher, -+Sébastien Maret, -+Léa Noreskal, -+Orion Poplawski, -+Marius Schamschula, -+Gürkan Sengün, -+Thierry Thomas, -+... -+

-+ -+

-+GDL is written in C++ using the Terence Parr's -+ANTLR language-recognition framework. -+Most of the library routines are implemented as interfaces to open-source packages -+ such as GNU Scientific Library, PLPlot, FFTW, ImageMagick, and many many more. -+

-+ -+

-+Last but not least, we would like to acknowledge the designers of IDL and PV-WAVE. -+

-+ -+

-+ Please do report any missing name on the lists above in the same way -+ as any other bug in GDL (see support & feedback). -+ Please also let us know if you would not like to be listed. -+

-+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/documentation.php gdl/doc/www/documentation.php ---- gdl-0.9.3/doc/www/documentation.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/documentation.php 2011-07-08 07:06:48.000000000 -0600 -@@ -0,0 +1,31 @@ -+ -+ -+

GDL Documentation

-+ -+

-+There's an ongoing effort to write the GDL User's and Developer's guide. -+Currently the documentation covers an automatically-generated list of all available library routines -+and their keywords, about 100 code examples, and a few drafts of library -+routine descriptions and other chapters. -+

-+ -+

-+The documentation is available as a single PDF file (only in English): -+http://gnudatalanguage.sf.net/gdl.pdf [PDF, 1.2 MiB] -+

-+ -+

-+While GDL itself reached a beta status of development, the documentation -+ is far from reaching an alpha status - help is very welcome! -+Please report any inconsistencies in the documentation as any other -+ bugs in GDL. Please submit new additions to the text (incl. code examples) -+ as patches to GDL (see support & feedback). -+

-+ -+

-+As GDL is almost 100% compatible to IDL (although not complete as many subroutines -+ are waiting to be implemented), documentation and tutorials for IDL can also be -+ utilized for GDL (see resources). -+

-+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/download.html gdl/doc/www/download.html ---- gdl-0.9.3/doc/www/download.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/download.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ Download GDL -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/downloads.php gdl/doc/www/downloads.php ---- gdl-0.9.3/doc/www/downloads.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/downloads.php 2011-07-08 07:06:48.000000000 -0600 -@@ -0,0 +1,57 @@ -+ -+ -+

Obtaining GDL

-+ -+

-+ GDL compiles "out of the box" on Linux, Mac OS X and several other UNIX systems -+ (see requirements for details). -+

-+ -+

-+ The source code distribution is available from -+ SourceForge. -+

-+ -+

-+ The latest development version of GDL can be obtained via CVS - consult the -+ SF.net project development page -+ for details. It is also possible to -+ -+ browse the CVS repository using a web-based interface. -+

-+ -+

-+ There are numerous packaged versions of GDL available for various OSes: -+

-+ -+ -+

-+ Please note that several features of GDL depend on compile-time configuration, -+ and might not be available in pre-built or pre-configured packages. -+

-+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/faq.php gdl/doc/www/faq.php ---- gdl-0.9.3/doc/www/faq.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/faq.php 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,58 @@ -+ -+ -+

Frequently Asked Questions

-+ -+

Installation and portability issues

-+
    -+
  • -+Is it possible to run GDL on MS-Windows? -+
    Yes. -+
    Solution 1: It's possible to compile GDL under Cygwin or e.g. to run GDL under the coLinux platform. -+
    Solution 2: since GDL 0.9.3, GDL should be compilable under MS-windows thanks to Jeong Bin Park -+Please follow the instructions described here. -+Feedback realy welcome. Please notice SPAWN functionnalities currently not working, which explain large -+number of FAIL in testsuite. -+
    N.B.: Due to lack of Windows developer- or user-base there is virtually no testing done on Windows, though. Help welcome! -+
    • -+
-+ -+

Compatibility with IDL

-+ -+ -+

Mapping

-+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/feedback.html gdl/doc/www/feedback.html ---- gdl-0.9.3/doc/www/feedback.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/feedback.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL Feedback -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/_footer.inc.php gdl/doc/www/_footer.inc.php ---- gdl-0.9.3/doc/www/_footer.inc.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/_footer.inc.php 2011-08-10 03:35:34.000000000 -0600 -@@ -0,0 +1,59 @@ -+
-+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+
-+ -+ -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/_header.inc.php gdl/doc/www/_header.inc.php ---- gdl-0.9.3/doc/www/_header.inc.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/_header.inc.php 2012-02-21 09:54:33.000000000 -0700 -@@ -0,0 +1,68 @@ -+ -+ -+ -+ -+ -+ GDL - GNU Data Language -+ -+ -+ -+ -+ -+ -+ -+
-+ -+ -+ -+ -+ -+
-+
-+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/home.html gdl/doc/www/home.html ---- gdl-0.9.3/doc/www/home.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/home.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL ::. Home -+ -+ -+ -+ -+ -Binary files gdl-0.9.3/doc/www/images/bg.jpg and gdl/doc/www/images/bg.jpg differ -Binary files gdl-0.9.3/doc/www/images/bullet.gif and gdl/doc/www/images/bullet.gif differ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/images/Colourise.css gdl/doc/www/images/Colourise.css ---- gdl-0.9.3/doc/www/images/Colourise.css 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/images/Colourise.css 2012-02-21 09:54:33.000000000 -0700 -@@ -0,0 +1,526 @@ -+/* ---------------------------------------------- -+ Template Name : Colourise -+ Template Code : S-0022 -+ Version : 1.1 -+ Author : Erwin Aligam -+ Author URI : http://www.styleshout.com/ -+ Last Date Modified : January 17, 2010 -+ ------------------------------------------------ */ -+ -+/* ---------------------------------------------- -+ HTML ELEMENTS -+------------------------------------------------- */ -+ -+/* Top Elements */ -+* { margin: 0; padding: 0; outline: 0 } -+ -+body { -+ font: 11px/165% 'Lucida Grande', Geneva, Verdana, Arial, Helvetica, sans-serif; -+ color: #9B9B9B; -+ margin: 0; padding: 0; -+ background: #070707 url(bg.jpg) no-repeat center top; -+ text-align: center; -+} -+ -+/* Links */ -+a, a:active, a:link { -+ text-decoration: none; -+ color: #006193; -+} -+a:visited { -+ text-decoration: none; -+} -+a:hover { -+ color: #fff; -+ border-bottom: 1px dotted #438800; -+} -+ -+/* headers */ -+h1, h2, h3 { -+ font-family: 'Trebuchet MS', Tahoma, Arial, Sans-serif; -+ color: #ABABAB; -+} -+h1 { -+ font-size: 3.6em; -+ font-weight: normal; -+ letter-spacing: -2px; -+ padding: 15px 10px 5px 10px; -+} -+h2 { -+ font-size: 2.2em; -+ color: #895F30; -+ padding: 20px 10px 5px 10px; -+} -+h3 { -+ font-size: 1.8em; -+ font-weight: normal; -+ padding: 20px 10px 5px 10px; -+} -+ -+p, dl { padding: 10px; margin: 0; } -+ -+ul, ol { -+ margin: 10px 20px; -+ padding: 0 20px; -+} -+ul { list-style: none; } -+ -+dt { -+ font-weight: bold; -+ color: #fff; -+} -+dd { -+ padding-left: 25px; -+} -+ -+/* images */ -+img { -+ background: #1B1B1B; -+ border: 1px solid #1B1B1B; -+ padding: 8px; -+} -+img.float-right { -+ margin: 5px 0px 10px 10px; -+} -+img.float-left { -+ margin: 5px 10px 10px 0px; -+} -+ -+code { -+ margin: 5px 0; -+ padding: 15px; -+ text-align: left; -+ display: block; -+ overflow: auto; -+ font: 500 1em/1.5em 'Lucida Console', 'Courier New', Monospace ; -+ /* white-space: pre; */ -+ background: #111; -+} -+acronym { -+ cursor: help; -+ border-bottom: 1px dotted #5B5B5B; -+} -+blockquote { -+ margin: 15px 10px; -+ padding: 10px 10px 10px 35px; -+ background: #111 url(quote.jpg) no-repeat 10px 10px; -+ font-weight: normal; -+ font-size: 18px; -+ line-height: 1.6em; -+ font-style: italic; -+ font-family: Georgia, 'Times New Roman', Times, serif; -+ color: #808080; -+} -+ -+/* start - table */ -+table { -+ margin: 15px 10px; -+ border-collapse: collapse; -+} -+th { -+ background: #000; -+ color: #fff; -+ height: 38px; -+ padding-left: 12px; -+ padding-right: 12px; -+ text-align: left; -+ border-left: 1px solid #211E20; -+ border-right: 1px solid #211E20; -+ border-bottom: 1px solid #211E20; -+ border-top: 1px solid #48780E; -+} -+tr { -+ color: #5b5b5b; -+ height: 34px; -+} -+td { -+ padding-left: 12px; -+ padding-right: 12px; -+ border: 1px solid #111; -+} -+/* end - table */ -+ -+/* form elements */ -+form { -+ margin: 20px 10px; padding: 5px 10px 20px 10px; -+ border: 1px solid #111; -+ background: #070707; -+} -+label { -+ display: block; -+ font-weight: bold; -+ margin: 8px 0; -+ color: #fff; -+} -+input, select, textarea { -+ padding: 5px 4px; -+ font: normal 1em Verdana, Tahoma, sans-serif; -+ color: #6A6969; -+ background: #0C0C0C; -+ border: 1px solid #1C1C1C; -+} -+textarea { -+ width: 400px; -+ height: 100px; -+ display: block; -+} -+input.button { -+ font: bold 12px Arial, Sans-serif; -+ height: 30px; -+ margin: 0; -+ padding: 2px 3px; -+ color: #48780E; -+ background: #000; -+ -+ border-width: 1px; -+ border-style: solid; -+ border-color: #1c1c1c; -+} -+ -+/* search form */ -+.searchform { -+ background-color: transparent; -+ border: none; -+ margin: 0; padding: 20px 0 15px 8px; -+ width: 270px; -+} -+.searchform p { margin: 0; padding: 0 0 10px 0; } -+.searchform input.textbox { -+ width: 185px; -+ height: 18px; -+ padding: 2px; -+ vertical-align: top; -+} -+.searchform input.button { -+ width: 60px; -+ height: 24px; -+ padding: 2px 5px; -+ vertical-align: top; -+} -+ -+/* ------------------------------------------ -+ LAYOUT -+------------------------------------------- */ -+#wrap { -+ position: relative; -+ width: 900px; -+ margin: 0 auto; -+ text-align: left; -+} -+#content-wrap { -+ position: relative; -+ clear: both; -+ width: 900px; -+ padding: 0; -+ margin-left: 5px; -+ background: transparent; -+ float: left; -+ display: inline; -+ border-top: 1px solid #1A1A1A; -+} -+#header { -+ position: relative; -+ width: 900px; -+ height: 370px; -+ margin: 0; padding: 0; -+ background: transparent; -+} -+ -+/* header search */ -+#header form#quick-search { -+ position: absolute; -+ top: 38px; right: 0; -+ padding: 0; margin: 0; -+ border: none; -+ width: 262px; height: 30px; -+ background: url(header-search.jpg) no-repeat; -+ z-index: 999999; -+} -+#header form#quick-search p { -+ margin: 0; padding: 0; -+} -+#header form#quick-search .tbox { -+ margin: 2px 0 0 5px; -+ width: 210px; -+ background: none; -+ border: none; -+} -+#header form#quick-search label, -+#header form#quick-search .btn { -+ display: none; -+} -+ -+/* Navigation */ -+#nav { -+ position: absolute; -+ margin: 0; padding: 0; -+ height: 40px; -+ width: 900px; -+ left: 0; top: 35px; -+ border-bottom: 1px solid #1A1A1A; -+} -+#nav ul { -+ float: left; -+ list-style: none; -+ width: 880px; -+ height: 40px; -+ margin: 0 0 0 5px; padding: 0; -+ display: inline; -+} -+#nav ul li { -+ display: inline; -+ margin: 0; padding: 0; -+} -+#nav ul li a { -+ float: left; -+ margin: 0; padding: 0 8px; -+ font: bold 15px/35px 'Trebuchet MS', Helvetica, Arial, Geneva, sans-serif; -+ text-decoration: none; -+ color: #5c9a12; -+} -+#nav ul li a:hover, -+#nav ul li a:active { -+ color: #eee; -+ background: none; -+ border: none; -+} -+#nav ul li#current a { -+ color: #0077B5; -+} -+ -+#header h1#logo-text a { -+ position: absolute; -+ margin: 0; padding: 0; -+ font: normal 60px Georgia, 'Times New Roman', Times, serif; -+ letter-spacing: -1.5px; -+ color: #fff; -+ text-decoration: none; -+ -+ /* change the values of top and left to adjust the position of the logo*/ -+ top: 120px; left: 10px; -+} -+#header h1#logo-text a:hover { -+ background: none; border: none; -+} -+#header p#intro { -+ position: absolute; -+ margin: 0; padding: 0; -+ font-family: Georgia, 'Times New Roman', Times, serif; -+ font-weight: normal; -+ font-size: 18px; -+ line-height: 1.6em; -+ font-style: italic; -+ text-transform: none; -+ color: #cd9857; -+ width: 500px; -+ -+ /* change the values of top and left to adjust the position */ -+ top: 195px; left: 15px; -+} -+ -+/* Main Column */ -+#main { -+ float: left; -+ width: 545px; -+ padding: 0; margin: 0; -+ display: inline; -+} -+#main h2 { -+ padding-bottom: 3px; -+ margin-top: 15px; -+ font: normal 3.5em 'Trebuchet MS', Tahoma, Helvetica, Arial, sans-serif; -+ color: #fff; -+ letter-spacing: -2px; -+ text-transform: none; -+} -+#main h2 a { -+ color: #fff; -+ text-decoration: none; -+ border: none; -+} -+#main ul li { -+ list-style-image: url(bullet.gif); -+ font-size: 14px; -+} -+#main p { -+ font-size: 14px; -+} -+ -+/* Sidebar */ -+#sidebar { -+ float: right; -+ width: 290px; -+ padding: 0; margin: 25px 0 0 0; -+ display: inline; -+} -+#sidebar h3 { -+ margin-top: 10px; -+ padding: 15px 5px 10px 5px; -+ font: bold 2em 'Trebuchet MS', Tahoma, Helvetica, Arial, sans-serif; -+ background: url(footer-top.jpg) no-repeat center bottom; -+ color: #fefefe; -+} -+#sidebar ul.sidemenu { -+ text-align: left; -+ margin: 7px 5px 8px 0px; padding: 0; -+} -+#sidebar ul.sidemenu li { -+ list-style: none; -+ padding: 8px 10px; -+ margin: 0; -+ border-bottom: 1px solid #111; -+} -+* html body #sidebar ul.sidemenu li { -+ height: 1%; -+} -+#sidebar ul.sidemenu li a { -+ text-decoration: none; -+ border: none; -+ color: #5d5d5d; -+ -+ font-weight: bold; -+ font-family: 'Trebuchet MS', Tahoma, Helvetica, Arial, Sans-serif; -+ font-size: 14px; -+ /* letter-spacing: .5px; */ -+} -+#sidebar ul.sidemenu li a span { -+ color: #444; -+ font-family: Georgia, 'Times New Roman', Times, serif; -+ font-style: italic; -+ font-weight: normal; -+ font-size: 11px; -+} -+#sidebar ul.sidemenu li a:hover, -+#sidebar ul.sidemenu li a:hover span { -+ color: #fff; -+} -+#sidebar ul.sidemenu ul { margin: 0 0 0 5px; padding: 0; } -+#sidebar ul.sidemenu ul li { border: none; } -+ -+/* footer */ -+#footer-wrap { -+ position: relative; -+ clear: both; -+ padding: 1em 0 2.5em 0; -+ margin-top: 30px; -+ font: normal 1em 'Trebuchet MS', Tahoma, sans-serif; -+ background: #070707 url(footer-top.jpg) no-repeat center top; -+ color: #555; -+ width: 900px; -+ float: left; -+ display: inline; -+} -+#footer-wrap h3 { -+ font: bold 2em/1.6em 'Trebuchet MS', Tahoma, sans-serif; -+ color: #ABABAB; -+} -+#footer-content { -+ margin: 0 auto; -+ width: 880px; -+ text-align: left; -+} -+#footer-content ul.col-list { -+ border-top: 1px solid #111; -+ list-style: none; -+ margin: 5px 0 0 5px; padding: 0; -+ width: 98%; -+} -+#footer-content ul.col-list li { -+ border-bottom: 1px solid #111; -+} -+#footer-content ul.col-list li a { -+ display: block; -+ line-height: 1.5em; -+ font-weight: bold; -+ padding: 7px 0 7px 8px; -+ width: 98%; -+ color: #555; -+ border: none; -+} -+#footer-content ul.col-list li a span { -+ color: #444; -+ font-style: italic; -+ font-weight: normal; -+ font-family: Georgia, 'Times New Roman', Times, serif; -+} -+#footer-content ul.col-list li a:hover, -+#footer-content ul.col-list li a:hover span { -+ color: #fff; -+ text-decoration: none; -+} -+ -+#footer-content .col { -+ width: 280px; -+ padding: 0 0 30px 0; -+ display: inline; -+} -+#footer-content .col2 { -+ width: 285px; -+ padding: 0 0 30px 0; -+ display: inline; -+} -+#footer-content .space-sep { -+ margin-right: 12px; -+} -+ -+/* postmeta */ -+.postmeta { -+ padding: 7px 5px; margin: 20px 10px 15px 10px; -+ font-size: 1em; -+ color: #545454; -+ border: 1px solid #111; -+ background: #111; -+} -+.postmeta .date{ margin: 0 10px 0 5px; } -+.postmeta a.comments { margin: 0 10px 0 5px; } -+.postmeta a.readmore { margin: 0 10px 0 5px; } -+ -+.post-info { font-size: .95em; padding-top: 3px; margin-left: 5px; color: #444; } -+.post-info a { color: #BD4200; } -+ -+/* alignment classes */ -+.float-left { float: left; } -+.float-right { float: right; } -+.align-left { text-align: left; } -+.align-right { text-align: right; } -+ -+/* display and additional classes */ -+.clearer { clear: both; } -+ -+.clear { -+ display:inline-block; -+} -+.clear:after { -+ display:block; -+ visibility:hidden; -+ clear:both; -+ height:0; -+ content: "."; -+} -+ -+div.ohloh div.gadget -+{ -+ border:0; -+} -+div.ohloh div.gadget div.main -+{ -+ width:140px; -+} -+div.ohloh div.gadget div.updated -+{ -+ width:240px; -+} -+ -+div.ohloh, div.ohloh div div p, div.ohloh div div h3, div.ohloh div div a -+{ -+ padding:1px; -+ font-size:10px; -+ color: black; -+ background-color: white; -+} -+ -+div.ohloh img -+{ -+ border-color: white; -+ padding:0; -+} -Binary files gdl-0.9.3/doc/www/images/footer-top.jpg and gdl/doc/www/images/footer-top.jpg differ -Binary files gdl-0.9.3/doc/www/images/header-search.jpg and gdl/doc/www/images/header-search.jpg differ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/index.html gdl/doc/www/index.html ---- gdl-0.9.3/doc/www/index.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/index.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL - GNU Data Language -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/index.php gdl/doc/www/index.php ---- gdl-0.9.3/doc/www/index.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/index.php 2011-08-12 10:20:48.000000000 -0600 -@@ -0,0 +1,91 @@ -+ -+ -+

Introduction

-+ -+

-+GNU Data Language (GDL) is a free/libre/open source incremental compiler -+ compatible with IDL and to some extent with PV-WAVE. -+Together with its library routines it serves as a tool for data analysis -+ and visualization in such disciplines as astronomy, geosciences and -+ medical imaging. -+GDL is free software licensed under the GPL. -+GDL is developed by an international team of volunteers led by Marc Schellens - the project's founder -+

-+ -+

-+GDL as a language is dynamically-typed, vectorized and has -+ object-oriented programming capabilities. -+GDL library routines handle numerical calculations, data visualisation, -+ signal/image processing, interaction with host OS and data input/output. -+GDL supports several data formats such as netCDF, HDF4, HDF5, GRIB, PNG, TIFF, -+ DICOM, etc. -+Graphical output is handled by X11, PostScript, SVG or z-buffer terminals, -+ the last one allowing output graphics (plots) to be saved in a variety of -+ raster graphics formats. -+GDL features integrated debugging facilities. -+GDL has also a Python bridge (Python code can be called from GDL; GDL can be compiled -+ as a Python module). -+

-+ -+

-+Packaged versions of GDL are available for several Linux and BSD flavours as well as Mac OS X. -+The source code compiles as well on other UNIX systems, including Solaris. -+

-+ -+

-+Other open-source numerical data analysis tools similar to GDL include -+GNU Octave, -+NCL - NCAR Command Language, -+PDL - Perl Data Language, -+R, -+Scilab, -+SciPy, -+Yorick ... -+

-+ -+

Feature summary

-+ -+

Full syntax compatibility with IDL up to version 7.1 (for >8.0 see below):

-+ -+
    -+
  • objects, pointers, structs and arrays,
    • -+
  • system, common block and assoc variables,
    • -+
  • all operators and datatypes,
    • -+
  • _EXTRA, _STRICT_EXTRA and _REF_EXTRA keywords...
    • -+
-+ -+

Supported IDL 8.0 language elements:

-+ -+
    -+
  • FOREACH loop
    • -+
  • negative array indices
    • -+
  • garbage collection pointers and objects
    • -+
  • call methods on an object using "." (e. g. object.aMemberProcedure,arg1)
    • -+
-+ -+

The file input output system is fully implemented
-+(Exception: For formatted I/O the C() sub-codes are not supported yet)

-+ -+

Supported file formats include:

-+
    -+
  • netCDF 3 (read/write)
    • -+
  • HDF4 (read/write)
    • -+
  • HDF5 (read-only, limited support)
    • -+
  • IDL SAVE files (supported using the Craig Markwardt's CMSVLIB)
    • -+
  • FITS files, when Astro Lib. is in the path ( test suite OK)
    • -+
  • various graphic formats (e.g. PNG if compiled with ImageMagick)
    • -+
  • ...
    • -+
-+ -+

-+Graphical output is partially implemented. The PLOT, OPLOT, PLOTS, -+ XYOUTS, CONTOUR, SURFACE, TVRD and TV commands -+(along with WINDOW, WDELETE, SET_PLOT, WSET, TVLCT) work -+(important keywords, some !P -+system variable tags and multi-plots are supported) -+for X windows, z-buffer and postscript output. -+

-+ -+

GUI support (widgets) is officially provided since the 0.9 version (but it's not complete yet).

-+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/menu.html gdl/doc/www/menu.html ---- gdl-0.9.3/doc/www/menu.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/menu.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL ::. menu -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/_news.inc.php gdl/doc/www/_news.inc.php ---- gdl-0.9.3/doc/www/_news.inc.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/_news.inc.php 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,48 @@ -+

GDL 0.9.3 released

-+

-+ 2013-01-05: Debian port updated
-+ 2013-01-02: Gentoo port updated
-+ 2013-01-01: FreeBSD port updated
-+ 2012-12-28: ArchLinux package updated
-+ 2012-12-28: Fedora package updated
-+ 2012-12-27: GDL 0.9.3 source tarball released.
-+ release notes | downloads -+

-+ -+

GDL 0.9.2 released

-+

-+ 2012-02-20: Ubuntu package updated
-+ 2011-12-27: Gentoo package updated
-+ 2011-11-16: Fink package updated
-+ 2011-11-15: Debian package updated
-+ 2011-11-14: Macports port updated
-+ 2011-11-13: HMUG package updated
-+ 2011-11-13: FreeBSD port updated
-+ 2011-11-12: ArchLinux package updated
-+ 2011-11-11: Fedora package updated
-+ 2011-11-09: GDL 0.9.2 source tarball released.
-+ release notes | downloads -+

-+ -+

GDL @ADASS XXI

-+

2011-11-09: GDL talk and GDL paper at the ADASS XXI in Paris

-+ -+

GDL @GHM2011

-+

2011-08-27: GDL talk at the GHM in Paris

-+ -+

New website

-+

2011-07-07: We have new website!

-+ -+

GDL 0.9.1 released

-+

-+ 2011-07-02: Macports port updated
-+ 2011-04-19: Fink package updated
-+ 2011-04-08: HMUG package updated
-+ 2011-04-08: Gentoo package updated
-+ 2011-04-06: FreeBSD port updated
-+ 2011-04-02: ArchLinux package updated
-+ 2011-03-31: Debian/Ubuntu package updated
-+ 2011-03-30: Fedora package updated
-+ 2011-03-29: GDL 0.9.1 source tarball released. -+ release notes | downloads -+

-diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/require.html gdl/doc/www/require.html ---- gdl-0.9.3/doc/www/require.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/require.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL requirements -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/requirements.php gdl/doc/www/requirements.php ---- gdl-0.9.3/doc/www/requirements.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/requirements.php 2011-09-20 09:46:45.000000000 -0600 -@@ -0,0 +1,86 @@ -+ -+ -+

Requirements

-+ -+

Obligatory libraries:

-+ -+ -+

Optional libraries:

-+
    -+
  • Xlib (part of any X11 distribution; needed for ploting on screens !)
    • -+
  • Magick++ (ImageMagick's C++ API; PNG and JPEG support)
    • -+
  • FFTW (both float and double versions needed; faster than FFT code provide by the GSL for 2^N 3^M 5^O cases)
    • -+
  • netCDF (v3 or v4)
    • -+
  • HDF4
    • -+
  • HDF5
    • -+
  • GRIB API
    • -+
  • UDUNITS-2
    • -+
  • wxWidgets
    • -+
  • libproject (mapping on Earth)
    • -+
  • GSHHS (see GDL's MAP_INSTALL file)
    • -+
  • pslib (fine-tuning PostScript output)
    • -+
-+ -+

The Python interface (see PYTHON.txt) requires:

-+ -+ -+

Useful IDL/GDL-written libraries:

-+
    -+
  • CMSVLIB (for SAVE and RESTORE)
    • -+
  • MPFIT (fitting)
    • -+
  • Astron Lib (FITS format I/O, astronomy-related procedures)
    • -+
  • TeXtoIDL (Greek letters, special symbols, sub/superscripts via TeX commands)
    • -+
-+ -+

At least g++ 3.2 (or a similar C++ standard conforming -+compiler) is needed for compiling GDL. -+ -+Succesfull compilations were reported with Intel C++ compiler and numerous versions -+of GCC including the 3.x and 4.x families, on various UNIX environments including -+Linux, Mac OS X, FreeBSD, OpenSolaris, Cygwin and OpenBSD. -+GCC >= 4.2 is needed for OpenMP. -+

-+ -+

The GNU readline -+library 4.3 or later is needed (GDL should compile -+without it, but it's very inconvenient to use that way, furthermore, -+proper event handling for graphic windows requires readline).
-+OS X 10.4: Note that the the readline library which comes with OS X is -+not GNU readline. You need to install GNU readline and set the --with-readlinedir=DIR option to configure. -+

-+ -+

-+ GDL supports compilation using both the shipped autotools "configure" script as well as using CMake. -+ Consult the README -+ and the INSTALL -+ files in the GDL distribution for further details on GDL requirements and configuration. -+

-+ -+

GDL was developed using ANTLR v2 -+but unless you want to change the grammar (*.g files) you don't need -+ANTLR. All relevant ANTLR files are included in the package.
-+

-+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/resources.html gdl/doc/www/resources.html ---- gdl-0.9.3/doc/www/resources.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/resources.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL Resources -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/resources.php gdl/doc/www/resources.php ---- gdl-0.9.3/doc/www/resources.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/resources.php 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,124 @@ -+ -+ -+

GDL resources

-+ -+

-+ A draft of GDL documentation is currently under development. -+

-+ -+

-+ There were several talks and posters on GDL prepared by the project team: -+

-+ -+ -+

-+ The ADASS talks have corresponding papers in the ASP Conference Series (and in arXiv), and this is currently the best way to cite GDL: -+

-+ -+ -+

-+ Alain Coulais maintains: -+

-+ -+ -+

-+ Several people prepared scholarly materials using or mentioning GDL: -+

-+ -+ -+

-+ Some uses of GDL were documented by the users: -+

-+ -+ -+

IDL resources

-+ -+

As GDL is almost 100% compatible to IDL (although not complete as many -+subroutines are waiting to be implemented), resources for IDL can also -+be utilized for GDL.

-+ -+

-+Many IDL resources can be found on the pages run by IDL gurus: David Fanning -+ and Michael Galloy, -+ and at the comp.lang.idl-pvwave usenet group. -+ -+

-+ -+ -+

-+IDL 6.4 documentation is published at the NASA website. -+Documentation for the current version of IDL is available for download from the ITTVIS website. -+

-+ -+

-+An IDL online tutorial is available at the Scientific Computing and -+Visualization website. -+

-+ -+

-+A (very) quick guide to IDL was written by Chris North. -+

-+ -+

-+Robert da Silva maintains the Slug's Guide to IDL. -+

-+ -+

-+Mark Piper maintains the The IDL Data Point. -+

-+ -+

-+For writing programs in GDL using Emacs the Emacs addon (mode) -+IDLWAVE, maintained -+by J.D. Smith is highly appreciated. Vim support IDL/GDL syntax highlighting by default. -+

-+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/screenshot.html gdl/doc/www/screenshot.html ---- gdl-0.9.3/doc/www/screenshot.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/screenshot.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL ::. Screenshots -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/screenshots/make_thumbnails gdl/doc/www/screenshots/make_thumbnails ---- gdl-0.9.3/doc/www/screenshots/make_thumbnails 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/screenshots/make_thumbnails 2011-07-08 07:06:48.000000000 -0600 -@@ -0,0 +1,4 @@ -+rm *_thumb.png -+for i in *.png; do -+ convert $i -thumbnail 250x400 -unsharp 0x.5 `basename $i .png`_thumb.png -+done -Binary files gdl-0.9.3/doc/www/screenshots/screenshot01.png and gdl/doc/www/screenshots/screenshot01.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot01_thumb.png and gdl/doc/www/screenshots/screenshot01_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot02.png and gdl/doc/www/screenshots/screenshot02.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot02_thumb.png and gdl/doc/www/screenshots/screenshot02_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot03.png and gdl/doc/www/screenshots/screenshot03.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot03_thumb.png and gdl/doc/www/screenshots/screenshot03_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot04.png and gdl/doc/www/screenshots/screenshot04.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot04_thumb.png and gdl/doc/www/screenshots/screenshot04_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot05.png and gdl/doc/www/screenshots/screenshot05.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot05_thumb.png and gdl/doc/www/screenshots/screenshot05_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot06.png and gdl/doc/www/screenshots/screenshot06.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot06_thumb.png and gdl/doc/www/screenshots/screenshot06_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot07.png and gdl/doc/www/screenshots/screenshot07.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot07_thumb.png and gdl/doc/www/screenshots/screenshot07_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot08.png and gdl/doc/www/screenshots/screenshot08.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot08_thumb.png and gdl/doc/www/screenshots/screenshot08_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot09.png and gdl/doc/www/screenshots/screenshot09.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot09_thumb.png and gdl/doc/www/screenshots/screenshot09_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot10.png and gdl/doc/www/screenshots/screenshot10.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot10_thumb.png and gdl/doc/www/screenshots/screenshot10_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot11.png and gdl/doc/www/screenshots/screenshot11.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot11_thumb.png and gdl/doc/www/screenshots/screenshot11_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot12.png and gdl/doc/www/screenshots/screenshot12.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot12_thumb.png and gdl/doc/www/screenshots/screenshot12_thumb.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot13.png and gdl/doc/www/screenshots/screenshot13.png differ -Binary files gdl-0.9.3/doc/www/screenshots/screenshot13_thumb.png and gdl/doc/www/screenshots/screenshot13_thumb.png differ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/screenshots.php gdl/doc/www/screenshots.php ---- gdl-0.9.3/doc/www/screenshots.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/screenshots.php 2011-07-08 07:06:48.000000000 -0600 -@@ -0,0 +1,125 @@ -+ -+ -+

Screenshots

-+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+
-+ -+ GDL drawing fractals -+ -+
-+ GDL rendering the Mandelbrot set. Screenshot generated using the APPLEMAN procedure -+ (included in GDL distribution, file: src/pro/appleman.pro) -+ 		-+ -+ GDL compressing weather-radar data using wavelet transform -+ -+
-+ GDL compressing weather-radar images using truncated wavelet approximation. -+
-+ -+ GDL run via a web interface -+ -+
-+ GDL used as a part of a web-interface for controlling 2D fluid flow simulation and -+ visualizing the output (reading netCDF files and outputting SVG plots). -+ 		-+ -+ GDL plotting data from a MODIS HDF file -+ -+
-+ GDL plotting data from a HDF file with MODIS satellite image. -+
-+ -+ GDL used for demonstrating Kalman filtering -+ -+
-+ GDL used for demonstrating Kalman filtering. -+ 		-+ -+ GDL-generated PostScript plot of a Fourier tranform in a LaTeX-generated PDF file -+ -+ GDL-generated PostScript plot of a Fourier spectrum in a LaTeX-generated PDF file. -+
-+ -+ GDL plotting weather-forecast map from a GRIB file with the GFS model output -+ -+
-+ GDL plotting weather-forecast map from a GRIB file with NOAA GFS model output. -+ 		-+ -+ GDL plotting Daubechies wavelet to an SVG file under OpenSolaris -+ -+
-+ GDL plotting Daubechies wavelet to an SVG file under OpenSolaris. -+
-+ -+ GDL writing a surface plot to a PNG file under Cygwin on Windows -+ -+
-+ GDL writing a surface plot to a PNG file under Cygwin on Windows (by Mateusz Turcza). -+ 		-+ -+ GDL rendering the Madnelbrot set in an X window under coLinux on Windows -+ -+
-+ GDL rendering the Mandelbrot set in an X window under coLinux on Windows (by Merrick Berg). -+
-+ -+ GDL rendering two HST images of Saturn (FITS files read with -+ Astron Lib) on Mandriva Linux 2009 -+ -+
-+ GDL rendering two HST images of Polar Aurorae on Saturn in UV -+ taken with STIS camera (by Palier and Prange, 1999) (FITS files read with -+ Astron Lib) on Mandriva Linux 2009. -+ 		-+ -+ -+ -+
-+ GDL used for analyzing LIDAR data (reading them from netCDF files, producing PostScript plots) on Linux, using the IDLWAVE mode for Emacs. (by Michał Piądłowski) -+
-+ -+ -+ -+
-+ Calling GDL from Python and vice versa (using Numpy and matplotlib). -+ 		  -+
-+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/support.html gdl/doc/www/support.html ---- gdl-0.9.3/doc/www/support.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/support.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL Support -+ -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/support.php gdl/doc/www/support.php ---- gdl-0.9.3/doc/www/support.php 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/support.php 2011-07-08 07:06:48.000000000 -0600 -@@ -0,0 +1,59 @@ -+ -+ -+

How to get support?

-+

-+ If you don't find an answer to your problem in: -+

-+ -+

-+ you might use one of these trackers -+ or -+ forums. -+

-+ -+ -+

How to provide feedback?

-+

-+ Your comments are welcome! Let us know what you use GDL for. -+ Or if you don't, why not. -+ Which functionality are you missing/would appreciate most for comming versions. -+ -+ Please send your bug reports, complaints, suggestions and comments using the -+ trackers -+ or -+ forums. -+

-+ -+

How to contribute?

-+

-+ GDL is actively developed and has already a lot of functionality. -+ But it is still in beta state as of July 2011. -+ Even though it can already be used for many tasks, there are many -+ things left to be done.
-+ Any contributions are very welcome. Currently contributions can be made in C/C++, GDL and python. -+ See the files -+ HACKING -+ and -+ PYHTON.txt -+ in the GDL root directory. -+

-+ -+

Urgent things to do are:

-+
    -+
  • Library functions and procedures
    • -+
  • Documentation and code examples
    • -+
  • Completing the graphical output system
    • -+
  • Testing and test routines written in GDL
    • -+
  • Enhancing the GUI (widget) functionality
    • -+
  • Porting GDL to other platforms
    • -+
-+ -+

-+ Please send your contributions using the trackers. -+

-+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/doc/www/tdl.html gdl/doc/www/tdl.html ---- gdl-0.9.3/doc/www/tdl.html 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/doc/www/tdl.html 2013-02-25 17:04:23.000000000 -0700 -@@ -0,0 +1,9 @@ -+ -+ -+ -+ GDL -TDL -+ -+ -+ -+ -+ -Only in gdl-0.9.3: gdl.kdev4 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/gdl.kdevelop gdl/gdl.kdevelop ---- gdl-0.9.3/gdl.kdevelop 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/gdl.kdevelop 2010-03-26 16:55:40.000000000 -0600 -@@ -0,0 +1,285 @@ -+ -+ -+ -+ Marc Schellens -+ m_schellens@users.sourceforge.net -+ 0.9 -+ KDevAutoProject -+ C++ -+ -+ C++ -+ Code -+ -+ . -+ false -+ -+ -+ -+ Python -+ -+ -+ gdl -+ -+ -+ -+ -+ src/gdl -+ debug -+ true -+ -+ -+ /home/marc/gdl/debug/src/gdl -+ false -+ executable -+ / -+ -+ true -+ -+ -+ -+ -+ -+ /home/marc/gdl/debug/src -+ true -+ false -+ false -+ -+ -+ -+ optimized -+ kdevgccoptions -+ kdevgppoptions -+ kdevg77options -+ -O2 -DNDEBUG -msse3 -mfpmath=sse,387 -+ -+ --enable-debug=full --with-netcdf=no --with-python=no --with-hdf=no --with-hdf5=no --with-plplot=/usr --with-python=no --disable-python_module --with-wxWidgets=no --with-Magick=yes --enable-oldplplot -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ --with-readlinedir=yes --with-hdf=yes --with-hdf5=yes --with-plplotdir=/usr/local --with-python=yes --disable-python_module --with-netcdf=no --disable-oldplplot --with-openmp=no --with-libproj4=no --with-mpich=/usr/lib/mpich --with-wxWidgets=yes --with-Magick=yes -+ debug -+ kdevgccoptions -+ kdevgppoptions -+ kdevg77options -+ -O0 -g3 -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ --with-python=yes --with-hdf=no --with-hdf5=no --with-netcdf=/usr/local --disable-python_module -+ default -+ -+ -+ -pg -+ kdevgccoptions -+ kdevgppoptions -+ kdevg77options -+ -+ -+ -+ -+ -O3 -g3 -DNDEBUG -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ true -+ 2 -+ false -+ -+ 0 -+ true -+ -+ -+ -+ -+ ada -+ ada_bugs_gcc -+ bash -+ bash_bugs -+ clanlib -+ w3c-dom-level2-html -+ fortran_bugs_gcc -+ gnome1 -+ gnustep -+ gtk -+ gtk_bugs -+ haskell -+ haskell_bugs_ghc -+ java_bugs_gcc -+ java_bugs_sun -+ kde2book -+ opengl -+ pascal_bugs_fp -+ php -+ php_bugs -+ perl -+ perl_bugs -+ python -+ python_bugs -+ qt-kdev3 -+ ruby -+ ruby_bugs -+ sdl -+ w3c-svg -+ sw -+ w3c-uaag10 -+ wxwindows_bugs -+ -+ -+ Guide to the Qt Translation Tools -+ Qt Assistant Manual -+ Qt Designer Manual -+ Qt Reference Documentation -+ qmake User Guide -+ -+ -+ KDE Libraries (Doxygen) -+ -+ -+ html/ -+ html/ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ false -+ false -+ -+ -+ *.o,*.lo,CVS -+ false -+ false -+ -+ -+ -+ -+ .hpp -+ .cpp -+ -+ -+ -+ -+ true -+ true -+ true -+ false -+ true -+ true -+ true -+ 250 -+ 400 -+ 250 -+ false -+ 0 -+ true -+ true -+ false -+ std=_GLIBCXX_STD;__gnu_cxx=std -+ true -+ false -+ false -+ false -+ true -+ true -+ true -+ false -+ .; -+ false -+ false -+ -+ -+ -+ -+ set -+ m_,_ -+ theValue -+ true -+ true -+ -+ -+ false -+ 3 -+ /usr/share/qt3 -+ 3 -+ EmbeddedKDevDesigner -+ -+ -+ -+ -+ -+ false -+ true -+ Vertical -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ true -+ true -+ true -+ false -+ -+ -+ true -+ true -+ 10 -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ -+ true -+ true -+ true -+ true -+ -C -+ -+ -+ -+ /home/marc/gdl/tags -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/INSTALL gdl/INSTALL ---- gdl-0.9.3/INSTALL 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/INSTALL 2013-02-25 17:04:20.000000000 -0700 -@@ -93,6 +93,8 @@ - --with-fftw=DIR to specify the FFTW directory tree - --with-fftw=no to not use FFTW - -+--with-eigen=DIR to specify the Eigen3 directory tree -+ - ... and so on for: wxWidgets, hdf, hdf5, fftw, libproj4, python, udunits, - grib, GSHHS, and others - see README file for details (REQUIREMENTS section). - -Only in gdl-0.9.3: install-sh -Only in gdl-0.9.3: .kdev4 -Only in gdl-0.9.3: ltmain.sh -Only in gdl-0.9.3: m4 -Only in gdl-0.9.3: Makefile -Only in gdl-0.9.3: Makefile.in -Only in gdl-0.9.3: missing -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/NEWS gdl/NEWS ---- gdl-0.9.3/NEWS 2012-12-27 10:55:04.000000000 -0700 -+++ gdl/NEWS 2013-07-31 09:41:42.565250484 -0600 -@@ -568,3 +568,49 @@ - _overloadPlus, _overloadMinus, _overloadBracketsLeftSide, - _overloadBracketsRightSide, _overloadEQ, _overloadNE) - - support for .SKIP [NSteps] command -+ -+0.9.4: -+ - when compiled with Eigen3 library, significant speed improvement -+ in MATRIX_MULTIPLY() (and # operators), especially on multi-cores -+ Basic loading managment included (if some core are busy). -+ - LIST and HASH are fully supported -+ even left-side struct access is possible e. g.: -+ GDL> h = HASH('key',{tag1:1}) & h['key'].tag1 = 3 -+ this even works with all (derived) GDL_OBJECTs: -+ In this case (a variable set to) !NULL is passed as the OBJREF -+ parameter to the OBJECT::_OVERLOADBRACKETSLEFTSIDE member procedure, -+ it must in turn set this OBJREF parameter (the variable) to a POINTER to -+ the heap variable to access. -+ - .RESET_SESSION and .FULL_RESET_SESSION commands -+ - CHOLSOL/CHOLDC and LA_CHOLSOL/LA_CHOLDC using Eigen3 (sub-optimal) -+ - large change in various graphic/plotting keywords: -+ - PLOT, OPLOT: All keywords supported except Z and T3D, -+ Correct handling of log/DATA/NORMAL/DEVICE coordinates and CLIPPING. -+ - PSYMs shapes now identical to IDL's. -+ - PLOTS: idem as above, plus /CONTINUE -+ - XYOUTS: idem as above, one-argument support (XYOUTS,"string"). -+ Enhancement wrt. reference program: color,size,angle,etc -+ of text are vectors. -+ - CONTOUR: Support of all options except ZVALUE, ZAXIS,CELL_FILL, -+ C_ANNOTATIONS, CLOSED, DOWNHILL, IRREGULAR, TRIANGULATION,PATH_*** -+ Correct implementation of Z, [X,Y], i.e., contours may be skewed, -+ rotated, etc depending on X and Y. -+ Better than IDL: -+ - a new ZLOG option makes log contours as well. -+ - C_ORIENTATION, C_SPACING are also vectors. -+ - log axes give better results -+ - good contouring of Not-A-Number values in Z and -+ MIN_VALUE/MAX_VALUE -+ - CLIPPING ok. -+ - Automatic limits in some cases still different from IDL. -+ - AXIS and boxes in plots: all [XYZ]TICK[***] options supported except TICKV -+ and a few TICKFORMAT specifics. -+ - CURSOR: full support for CURSOR command, which is interruptible by control-c -+ and has all the options. -+ - Added cursor-related functions TVCRS and command EMPTY. -+ - Added DEVICE options CURSOR_CROSSHAIR, CURSOR_STANDARD, CURSOR_ORIGINAL and -+ GET/SET_GRAPHICS_FUNCTION (GXoR, GXand, etc). -+ - Disabled by default the focus in the X11 graphics windows as IDL does and -+ repositioned WINDOWS by default to top-right of screen. -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/README gdl/README ---- gdl-0.9.3/README 2012-12-27 09:22:45.000000000 -0700 -+++ gdl/README 2013-02-25 17:04:20.000000000 -0700 -@@ -101,6 +101,7 @@ - GSHHS (consult the MAP_INSTALL file) - wxWidgets http://www.wxwidgets.org/ - pslib http://pslib.sourceforge.net/ -+Eigen http://eigen.tuxfamily.org - - Only with python: - numpy http://numpy.scipy.org/ -@@ -119,6 +120,8 @@ - If installed, the SAVE and RESTORE commands (data only) are - available through wrapper routines. You get CMSVLIB here: - http://cow.physics.wisc.edu/~craigm/idl/down/cmsvlib.tar.gz -+You must add yourself the CMSVLIB path in the GDL_PATH. -+CMSVLIB provides a test suite: please run CMSV_TEST. - - At least g++ 3.2 (or a similar C++ standard conforming - compiler) is needed for compiling GDL. -@@ -144,7 +147,7 @@ - A possible problem was reported: - On opening more than one window, plplot causes a segmentation fault - if GDL is compiled with ImageMagick. This happens if plplot uses --dynamic drivers . -+dynamic drivers. - The current solution is to disable dynamic drivers for plplot - (-DENABLE_DYNDRIVERS=OFF option for cmake). - Current ubuntu/debian distributions are using dynamic drivers, so plplot -@@ -272,11 +275,18 @@ - library (http://www.unidata.ucar.edu/software/udunits/) - If you want to use it, use --with-udunits=DIR - --GDL supports the GRIB file format - see README_GRIB -+GDL supports the GRIB file format - see README_GRIB (optional) - --GDL uses GSHHS to implement MAP_CONTINENTS - see MAP_INSTALL -+GDL uses GSHHS to implement MAP_CONTINENTS - see MAP_INSTALL (optional) - --GDL uses pslib for fine-tuning PostScript output. -+GDL uses pslib for fine-tuning PostScript output. (optional) -+ -+GDL uses Eigen for fast matrix multiplication. (optional) -+The simpliest way to compile with it is to copy all the header files -+under sub-directory src/Eigen. Another solution is to provide full path -+to the include files (e.g. --with-eigen=/home/toto/Eigen3.1.4/include/eigen3/ -+in that case Eigen would have been prepared using: -+cmake . -DCMAKE_INSTALL_PREFIX=/home/toto/Eigen3.1.4/ ) - - GDL 0.9 was developed using ANTLR 2.7.6, - but unless you want to change the grammar (*.g files) you don't need -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/accessdesc.hpp gdl/src/accessdesc.hpp ---- gdl-0.9.3/src/accessdesc.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/accessdesc.hpp 2013-03-25 10:36:38.000000000 -0600 -@@ -300,32 +300,32 @@ - SizeT nDot=tag.size(); - SizeT d; - for( d=0; dN_Elements() > 1) -+ dim >> dStruct[d]->Dim(); -+ } -+ else - { -- if( ix[d] == NULL) -- { // loop over all elements -- if( dStruct[d]->N_Elements() > 1) -- dim >> dStruct[d]->Dim(); -- } -- else -- { -- ix[d]->SetVariable( dStruct[d]); -- if( ix[d]->N_Elements() > 1) -- dim >> ix[d]->GetDim(); -- } -+ ix[d]->SetVariable( dStruct[d]); -+ if( ix[d]->N_Elements() > 1) -+ dim >> ix[d]->GetDim(); - } --// dimension topDim; -+ } -+ // dimension topDim; - if( ix[d] == NULL) - { // loop over all elements --// topDim=top->Dim(); --// dim >> topDim; -- dim >> top->Dim(); -+ // topDim=top->Dim(); -+ // dim >> topDim; -+ dim >> top->Dim(); - } - else - { -- ix[d]->SetVariable( top); --// topDim=ix[d]->GetDim(); --// dim >> topDim; -- dim >> ix[d]->GetDim(); -+ ix[d]->SetVariable( top); -+ // topDim=ix[d]->GetDim(); -+ // dim >> topDim; -+ dim >> ix[d]->GetDim(); - } - } - -@@ -364,7 +364,7 @@ - - BaseGDL* newData; - // no zeroing, here the new variable is created -- // zero only for GDL_PTR and GDL_OBJ (refcounting) -+ // zero only for GDL_PTR and GDL_OBJ (because of ref counting) - if( top->Type() == GDL_PTR || top->Type() == GDL_OBJ) - newData=top->New( dim);//, BaseGDL::NOZERO); - else -@@ -391,7 +391,7 @@ - SizeT rRank=r->Rank(); - - // if( rRank > lRank) --// throw GDLException(NULL,"Conflicting data structures (rank).",true,false); -+// throw GDLException(-1,NULL,"Conflicting data structures (rank).",true,false); - - SizeT topRank=top->Rank(); - -@@ -408,7 +408,7 @@ - { - // IDL seems to allow a maximum of one rank more for the r-value - // if( rRank > (topRank+1)) --// throw GDLException(NULL,"Conflicting data structures (top-rank).",true,false); -+// throw GDLException(-1,NULL,"Conflicting data structures (top-rank).",true,false); - - // inplace copy to every instance of top - // just loop over all top elements and insert (at appropriate indices) -@@ -418,7 +418,7 @@ - if( r->Type() != top->Type()) - { - BaseGDL* rConv = r->Convert2( top->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - DoAssign( dStruct[0], rConv); - } -@@ -431,7 +431,7 @@ - // all dimensions must match here - for( SizeT i=0; iDim(i)) -- throw GDLException(NULL,"Conflicting data structures (dim).",true,false); -+ throw GDLException(-1,NULL,"Conflicting data structures (dim).",true,false); - - // copy only topRank dimensions each time (topElem elements) - // topRank is the dim to start the outer loop with -@@ -445,7 +445,7 @@ - if( r->Type() != top->Type()) - { - BaseGDL* rConv = r->Convert2( top->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - DoAssign( dStruct[0], rConv); - } -@@ -491,7 +491,7 @@ - void ADRoot( DStructGDL* s, ArrayIndexListT* ix_=NULL) // root - { - // if( s->IsAssoc()) --// throw GDLException(NULL,"File expression not allowed in this context.",true,false); -+// throw GDLException(-1,NULL,"File expression not allowed in this context.",true,false); - propertyAccess = false; - dStruct.push_back(s); - ix.push_back(ix_); -@@ -507,20 +507,27 @@ - // // must only have one time property access - // if( propertyAccess) - // { --// throw GDLException(NULL,"Cannot access tag: "+ tagName+" [of property: "+propertyName+"].",true,false); -+// throw GDLException(-1,NULL,"Cannot access tag: "+ tagName+" [of property: "+propertyName+"].",true,false); - // } - // propertyName = tagName; - // propertyAccess = true; - // return; // no further change - // // hence "Add( SizeT)" will fail next time as well -> no further action here - // } -- throw GDLException(NULL,"Left side of a tag must be a STRUCT: "+tagName); -+ assert( top != NULL); -+ if( top->Type() == GDL_OBJ) -+ throw GDLException(-1,NULL,"Nested structure references are not allowed with objects. Consider using parentheses: "+tagName); -+ else -+ throw GDLException(-1,NULL,"Left side of a tag must be a STRUCT: "+tagName); - } - - int t=dStruct.back()->Desc()->TagIndex( tagName); - if( t == -1) -- throw GDLException(NULL,"Tag name: "+tagName+" is undefined for STRUCT.",true,false); -- -+ { -+ // TODO: Check for call to Get/SetProperty -+ -+ throw GDLException(-1,NULL,"Tag name: "+tagName+" is undefined for STRUCT.",true,false); -+ } - // call SizeT version - SizeT tagIx=static_cast(t); - ADAdd( tagIx); -@@ -532,35 +539,38 @@ - DStructGDL* actTop=dStruct.back(); - - if( actTop == NULL) -- throw GDLException(NULL,"Expression must be a STRUCT in this context.",true,false); -+ throw GDLException(-1,NULL,"Expression must be a STRUCT in this context.",true,false); - - if( actTop->N_Elements() == 0) // maybe not needed -- throw GDLException(NULL,"Error struct data empty.",true,false); -+ throw GDLException(-1,NULL,"Error struct data empty.",true,false); - - SizeT nTags=actTop->Desc()->NTags(); - - if( tagN >= nTags) -- throw GDLException(NULL,"Invalid tag number.",true,false); -+ throw GDLException(-1,NULL,"Invalid tag number.",true,false); - -+ // TODO: Insert object struct for Get/SetProperty -+ // tagN == -1 (change type to int)? -+ - top=actTop->GetTag( tagN, 0); - - // push struct onto struct stack -- DStructGDL* newTop; - if( top->Type() == GDL_STRUCT) -- newTop = static_cast(top); -+ { -+ DStructGDL* newTop=static_cast(top); -+ dStruct.push_back( newTop); -+ } - else -- newTop = NULL; -- -- // if( newTop != NULL) dStruct.push_back( newTop); -- dStruct.push_back( newTop); -- -+ { -+ dStruct.push_back( NULL); -+ } - tag.push_back(tagN); - } - - void ADAddIx( ArrayIndexListT* ix_) // tags - { - if( propertyAccess && ix_ != NULL) -- throw GDLException(NULL,"Property must not be indexed: "+propertyName+".",true,false); -+ throw GDLException(-1,NULL,"Property must not be indexed: "+propertyName+".",true,false); - ix.push_back(ix_); - } - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/allix.cpp gdl/src/allix.cpp ---- gdl-0.9.3/src/allix.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/allix.cpp 2013-02-25 17:04:24.000000000 -0700 -@@ -60,7 +60,7 @@ - assert( upperSet); - SizeT index = ref->GetAsIndexStrict( i); - if( index > upper) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range subscript (at index: "+i2s(i)+").",true,false); - return index; - } -@@ -71,7 +71,7 @@ - seqIx = 0; - SizeT index = ref->GetAsIndexStrict( 0); - if( index > upper) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range subscript (at index: "+i2s(index)+").",true,false); - return index; - } -@@ -81,7 +81,7 @@ - assert( upperSet); - SizeT index = ref->GetAsIndexStrict( ++seqIx); - if( index > upper) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range subscript (at index: "+i2s(index)+").",true,false); - return index; - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/antlr/LLkParser.cpp gdl/src/antlr/LLkParser.cpp ---- gdl-0.9.3/src/antlr/LLkParser.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/antlr/LLkParser.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -2,7 +2,7 @@ - * Project led by Terence Parr at http://www.jGuru.com - * Software rights: http://www.antlr.org/license.html - * -- * $Id: LLkParser.cpp,v 1.6 2012/11/13 14:30:14 m_schellens Exp $ -+ * $Id: LLkParser.cpp,v 1.8 2013/05/07 13:13:52 m_schellens Exp $ - */ - - #include "antlr/LLkParser.hpp" -@@ -40,7 +40,8 @@ - - void LLkParser::trace(const char* ee, const char* rname) - { -- //if(inputState->guessing>0) return; -+ // only show non-guessing (production) calls -+ if(inputState->guessing>0) return; - - traceIndent(); - -Only in gdl-0.9.3/src/antlr: LLkParser.cpp~ -Only in gdl-0.9.3/src/antlr: .#LLkParser.cpp.1.4 -Only in gdl-0.9.3/src/antlr: Makefile.in -Only in gdl-0.9.3/src/antlr: Parser.cpp~ -Only in gdl-0.9.3/src/antlr: Parser.hpp~ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/arrayindex.cpp gdl/src/arrayindex.cpp ---- gdl-0.9.3/src/arrayindex.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/arrayindex.cpp 2013-07-08 12:39:21.424398704 -0600 -@@ -40,7 +40,7 @@ - // { - // s = GDLInterpreter::CallStackBack()->GetKW( varIx)->LoopIndex(); - // --// if( s >= var->Size()) -+// if( s >= var->N_Elements()/*var->Size()*/) - // { - // throw GDLException("Scalar subscript out of range [>].a"); - // } -@@ -50,7 +50,7 @@ - // { - // s = varPtr->Data()->LoopIndex(); - // --// if( s >= var->Size()) -+// if( s >= var->N_Elements()/*var->Size()*/) - // { - // throw GDLException("Scalar subscript out of range [>].b"); - // } -@@ -131,11 +131,11 @@ - sInit = GDLInterpreter::CallStackBack()->GetKW( varIx)->LoopIndex(); - - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - { - throw GDLException("Scalar subscript out of range [>].e"); - } -@@ -160,17 +160,17 @@ - sInit = GDLInterpreter::CallStackBack()->GetKW( varIx)->LoopIndex(); - - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - { -- throw GDLException("Scalar subscript out of range [>].e"); -+ throw GDLException("Scalar subscript out of range [>].e ("+i2s(s)+")"); - } - if( s < 0) - { -- throw GDLException("Scalar subscript out of range [<].e"); -+ throw GDLException("Scalar subscript out of range [<].e ("+i2s(s)+")"); - } - - return var->NewIx( s); -@@ -182,7 +182,7 @@ - // return var->Index( this); - } - --void ArrayIndexListOneScalarNoAssocT::InitAsOverloadIndex( IxExprListT& ix_, IxExprListT* cleanupIxIn, IxExprListT& ixOut) -+void ArrayIndexListOneScalarNoAssocT::InitAsOverloadIndex( IxExprListT& ix_, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut) - { - assert( 0 == nParam); - -@@ -195,7 +195,7 @@ - ixOut.push_back(oIx); - } - --void ArrayIndexListOneScalarVPNoAssocT::InitAsOverloadIndex( IxExprListT& ix_, IxExprListT* cleanupIxIn, IxExprListT& ixOut) -+void ArrayIndexListOneScalarVPNoAssocT::InitAsOverloadIndex( IxExprListT& ix_, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut) - { - assert( varPtr != NULL); - assert( 0 == nParam); -@@ -217,11 +217,11 @@ - { - sInit = varPtr->Data()->LoopIndex(); - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - { - throw GDLException("Scalar subscript out of range [>].f"); - } -@@ -245,11 +245,11 @@ - // { - sInit = varPtr->Data()->LoopIndex(); - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - { - throw GDLException("Scalar subscript out of range [>].f"); - } -@@ -271,7 +271,7 @@ - { - sInit = GDLInterpreter::CallStackBack()->GetKW( varIx)->LoopIndex(); - if( sInit < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException(-1,NULL,"Record number must be a scalar > 0 in this context.",true,false); - lastIx = sInit; - return true; - } -@@ -284,16 +284,16 @@ - return; - } - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - if( s < 0) - throw GDLException("Scalar subscript out of range [<].h"); -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - throw GDLException("Scalar subscript out of range [>].h"); - - // for assoc variables last index is the record -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - throw GDLException("Scalar subscript out of range [>].g"); - } - void ArrayIndexListOneScalarNoAssocT::SetVariable( BaseGDL* var) -@@ -306,16 +306,16 @@ - } - // if( var->IsAssoc()) return; - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - if( s < 0) - throw GDLException("Scalar subscript out of range [<].h"); -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - throw GDLException("Scalar subscript out of range [>].h"); - - // for assoc variables last index is the record -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - throw GDLException("Scalar subscript out of range [>].g"); - } - void ArrayIndexListOneScalarT::AssignAt( BaseGDL* var, BaseGDL* right) -@@ -326,12 +326,12 @@ - { - sInit = GDLInterpreter::CallStackBack()->GetKW( varIx)->LoopIndex(); - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - if( s < 0) - throw GDLException("Scalar subscript out of range [<].h"); -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - throw GDLException("Scalar subscript out of range [>].h"); - var->AssignAtIx( s, right); - return; -@@ -345,7 +345,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -358,12 +358,12 @@ - { - sInit = GDLInterpreter::CallStackBack()->GetKW( varIx)->LoopIndex(); - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - else - s = sInit; - if( s < 0) - throw GDLException("Scalar subscript out of range [<].h"); -- if( s >= var->Size()) -+ if( s >= var->N_Elements()/*var->Size()*/) - throw GDLException("Scalar subscript out of range [>].h"); - var->AssignAtIx( s, right); - return; -@@ -377,7 +377,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/arrayindex.hpp gdl/src/arrayindex.hpp ---- gdl-0.9.3/src/arrayindex.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/arrayindex.hpp 2013-07-08 12:39:21.426398680 -0600 -@@ -78,10 +78,10 @@ - virtual void Init( BaseGDL*, BaseGDL*, BaseGDL*) { assert( false);} - - virtual bool IsRange() { return false;} // default for non-ranges -- virtual BaseGDL* OverloadIndexNew() { assert( false);} -- virtual BaseGDL* OverloadIndexNew( BaseGDL*) { assert( false);} -- virtual BaseGDL* OverloadIndexNew( BaseGDL*, BaseGDL*) { assert( false);} -- virtual BaseGDL* OverloadIndexNew( BaseGDL*, BaseGDL*, BaseGDL*) { assert( false);} -+ virtual BaseGDL* OverloadIndexNew() { assert( false); return 0;} -+ virtual BaseGDL* OverloadIndexNew( BaseGDL*) { assert( false); return 0;} -+ virtual BaseGDL* OverloadIndexNew( BaseGDL*, BaseGDL*) { assert( false); return 0;} -+ virtual BaseGDL* OverloadIndexNew( BaseGDL*, BaseGDL*, BaseGDL*) { assert( false); return 0;} - - virtual void Clear() {} - virtual ~ArrayIndexT() {} -@@ -133,6 +133,7 @@ - SizeT size() const { return sz;} - void push_back( ArrayIndexT* aIx) - { -+// if( sz >= MAXRANK) // debug - assert( sz < MAXRANK); - arrayIxArr[ sz++] = aIx; - } -@@ -389,8 +390,8 @@ - // // if this is used, Init was NOT called before - // BaseGDL* Index( BaseGDL* var, IxExprListT& ixL) - // { --// if( s >= var->Size()) --// throw GDLException(NULL,"Scalar subscript out of range [>].h1",true,false); -+// if( s >= var->N_Elements()/*var->Size()*/) -+// throw GDLException(-1,NULL,"Scalar subscript out of range [>].h1",true,false); - // return var->NewIx( s); - // } - -@@ -404,13 +405,13 @@ - s = sInit; - - if( s < 0) -- throw GDLException(NULL,"Constant scalar subscript out of range [-i].",true,false); -+ throw GDLException(-1,NULL,"Constant scalar subscript out of range [-i].",true,false); - if( s >= varDim && s > 0) // varDim == 0 && s == 0 ok -- throw GDLException(NULL,"Constant scalar out of range [i].",true,false); -+ throw GDLException(-1,NULL,"Constant scalar out of range [i].",true,false); - return 1; - - // if( s >= varDim && s > 0) // varDim == 0 && s == 0 ok --// throw GDLException(NULL,"Scalar subscript out of range [>].h2",true,false); -+// throw GDLException(-1,NULL,"Scalar subscript out of range [>].h2",true,false); - // return 1; - } - }; //class CArrayIndexScalar: public ArrayIndexT -@@ -528,7 +529,7 @@ - // if( ret == -1) // index < 0 - // { - // throw -- // GDLException(NULL, "Subscript range values of the" -+ // GDLException(-1,NULL, "Subscript range values of the" - // " form low:high must be >= 0, < size," - // " with low <= high.",true,false); - // } -@@ -543,7 +544,7 @@ - - int typeCheck = DTypeOrder[ dType]; - if( typeCheck >= 100) -- throw GDLException(NULL,"Type not allowed as subscript.",true,false); -+ throw GDLException(-1, NULL,"Type not allowed as subscript.",true,false); - - //SizeT nElem = ix_->N_Elements(); - // ix = new SizeT[ nElem]; // allocate array -@@ -572,9 +573,9 @@ - s = sInit; - - if( s < 0) -- throw GDLException(NULL,"Subscript out of range [-i].",true,false); -+ throw GDLException(-1, NULL,"Subscript out of range [-i].",true,false); - if( s >= varDim && s > 0) -- throw GDLException(NULL,"Subscript out of range [i].",true,false); -+ throw GDLException(-1, NULL,"Subscript out of range [i].",true,false); - return 1; - } - // INDEXED -@@ -684,7 +685,7 @@ - DType dType = rawData->Type(); - int typeCheck = DTypeOrder[ dType]; - if( typeCheck >= 100) -- throw GDLException(NULL,"Type not allowed as subscript.",true,false); -+ throw GDLException(-1, NULL,"Type not allowed as subscript.",true,false); - - if( strictArrSubs) - ix = new (ixBuf) AllIxIndicesStrictT( rawData); -@@ -715,9 +716,9 @@ - s = sInit; - - if( s < 0) -- throw GDLException(NULL,"Subscript out of range [-i].",true,false); -+ throw GDLException(-1, NULL,"Subscript out of range [-i].",true,false); - if( s >= varDim && s > 0) -- throw GDLException(NULL,"Subscript out of range [i].",true,false); -+ throw GDLException(-1, NULL,"Subscript out of range [i].",true,false); - return 1; - } - // INDEXED -@@ -778,7 +779,7 @@ - BaseGDL* OverloadIndexNew( BaseGDL* s_) - { - Init( s_); -- DLong arr[3] = {sInit,-1,1}; -+ DLong arr[3] = {static_cast(sInit),-1,1}; - return new DLongGDL( arr, 3); - } - -@@ -803,18 +804,18 @@ - { - if( s_->N_Elements() == 0) - throw -- GDLException(NULL,"Internal error: Scalar2RangeT:" -+ GDLException(-1,NULL,"Internal error: Scalar2RangeT:" - " 1st index empty",true,false); - else - throw -- GDLException(NULL,"Expression must be a scalar" -+ GDLException(-1,NULL,"Expression must be a scalar" - " in this context.",true,false); - } - // not with Scalar2RangeT(): - // if( retMsg == -1) // index < 0 - // { - // throw --// GDLException(NULL,"Subscript range values of the" -+// GDLException(-1,NULL,"Subscript range values of the" - // " form low:high must be >= 0, < size, " - // "with low <= high.",true,false); - // } -@@ -823,12 +824,12 @@ - SizeT NIter( SizeT varDim) - { - if( sInit >= varDim) // && s > 0) -- throw GDLException(NULL,"Subscript out of range [s:*].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [s:*].",true,false); - if( sInit < 0) - { - s = sInit + varDim; - if( s < 0) -- throw GDLException(NULL,"Subscript out of range [-s:*].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [-s:*].",true,false); - - return (varDim - s); - } -@@ -848,7 +849,7 @@ - - BaseGDL* OverloadIndexNew() - { -- DLong arr[3] = {sInit,-1,1}; -+ DLong arr[3] = {static_cast(sInit),-1,1}; - return new DLongGDL( arr, 3); - } - -@@ -888,7 +889,7 @@ - BaseGDL* OverloadIndexNew( BaseGDL* s_, BaseGDL* e_) - { - Init( s_, e_); -- DLong arr[3] = {sInit,eInit,1}; -+ DLong arr[3] = {static_cast(sInit),static_cast(eInit),1}; - return new DLongGDL( arr, 3); - } - -@@ -909,22 +910,22 @@ - - void Init( BaseGDL* s_, BaseGDL* e_) - { --// SizeT varSize = var->Size(); -+// SizeT varSize = var->N_Elements()/*var->Size()*/; - - int retMsg=s_->Scalar2RangeT(sInit); - if( retMsg == 0) // index empty or array - { - if( s_->N_Elements() == 0) - throw -- GDLException(NULL,"Internal error: Scalar2RangeT: 1st index empty.",true,false); -+ GDLException(-1,NULL,"Internal error: Scalar2RangeT: 1st index empty.",true,false); - else - throw -- GDLException(NULL,"Expression must be a scalar in this context.",true,false); -+ GDLException(-1,NULL,"Expression must be a scalar in this context.",true,false); - } - // if( retMsg == -1) // index < 0 - // { - // throw --// GDLException(NULL,"Subscript range values of the form low:high " -+// GDLException(-1,NULL,"Subscript range values of the form low:high " - // "must be >= 0, < size, with low <= high.",true,false); - // } - -@@ -933,10 +934,10 @@ - { - if( e_->N_Elements() == 0) - throw -- GDLException(NULL,"Internal error: Scalar2RangeT: 2nd index empty.",true,false); -+ GDLException(-1,NULL,"Internal error: Scalar2RangeT: 2nd index empty.",true,false); - else - throw -- GDLException(NULL,"Expression must be a scalar in this context.",true,false); -+ GDLException(-1,NULL,"Expression must be a scalar in this context.",true,false); - } - } - -@@ -949,7 +950,7 @@ - { - s = sInit + varDim; - if( s < 0) -- throw GDLException(NULL,"Subscript out of range [S:e].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [S:e].",true,false); - } - else - s = sInit; -@@ -957,17 +958,17 @@ - { - e = eInit + varDim; - if( e < 0) -- throw GDLException(NULL,"Subscript out of range [s:E].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [s:E].",true,false); - } - else - e = eInit; - - if( s > e) - throw -- GDLException(NULL,"Subscript range values of the form low:high " -+ GDLException(-1,NULL,"Subscript range values of the form low:high " - "must be < size, with low <= high",true,false); - if( e >= varDim) // && e > 0) -- throw GDLException(NULL,"Subscript out of range [s:e].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [s:e].",true,false); - return (e - s + 1); - } - }; -@@ -983,7 +984,7 @@ - - BaseGDL* OverloadIndexNew() - { -- DLong arr[3] = {sInit,eInit,1}; -+ DLong arr[3] = {static_cast(sInit),static_cast(eInit),1}; - return new DLongGDL( arr, 3); - } - -@@ -1026,7 +1027,7 @@ - BaseGDL* OverloadIndexNew( BaseGDL* s_, BaseGDL* stride_) - { - Init( s_, stride_); -- DLong arr[3] = {sInit,-1,stride}; -+ DLong arr[3] = {static_cast(sInit),-1,static_cast(stride)}; - return new DLongGDL( arr, 3); - } - -@@ -1066,12 +1067,12 @@ - // " form low:high must be >= 0, < size, with low <= high.",true,false); - // } - // stride -- retMsg=stride_->Scalar2index( stride); -+ retMsg=stride_->Scalar2Index( stride); - if( retMsg == 0) // index empty or array - { - if( stride_->N_Elements() == 0) - throw -- GDLException( "Internal error: Scalar2index:" -+ GDLException( "Internal error: Scalar2Index:" - " stride index empty",true,false); - else - throw -@@ -1093,14 +1094,14 @@ - { - s = sInit + varDim; - if( s < 0) -- throw GDLException(NULL,"Subscript out of range [-S:*:stride].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [-S:*:stride].",true,false); - return (varDim - s + stride - 1)/stride; - } - else - s= sInit; - - if( s >= varDim) // && s > 0) -- throw GDLException(NULL,"Subscript out of range [s:*:stride].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [s:*:stride].",true,false); - return (varDim - s + stride - 1)/stride; - } - }; -@@ -1114,7 +1115,7 @@ - - BaseGDL* OverloadIndexNew() - { -- DLong arr[3] = {sInit,-1,stride}; -+ DLong arr[3] = {static_cast(sInit),-1,static_cast(stride)}; - return new DLongGDL( arr, 3); - } - -@@ -1166,7 +1167,7 @@ - BaseGDL* OverloadIndexNew( BaseGDL* s_, BaseGDL* e_, BaseGDL* stride_) - { - Init( s_, e_, stride_); -- DLong arr[3] = {sInit,eInit,stride}; -+ DLong arr[3] = {static_cast(sInit),static_cast(eInit),static_cast(stride)}; - return new DLongGDL( arr, 3); - } - -@@ -1218,12 +1219,12 @@ - } - - // stride -- retMsg=stride_->Scalar2index(stride); -+ retMsg=stride_->Scalar2Index(stride); - if( retMsg == 0) // index empty or array - { - if( stride_->N_Elements() == 0) - throw -- GDLException( "Internal error: Scalar2index:" -+ GDLException( "Internal error: Scalar2Index:" - " stride index empty",true,false); - else - throw -@@ -1246,7 +1247,7 @@ - { - s = sInit + varDim; - if( s < 0) -- throw GDLException(NULL,"Subscript out of range [-S:e:stride].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [-S:e:stride].",true,false); - } - else - s = sInit; -@@ -1254,19 +1255,19 @@ - { - e = eInit + varDim; - if( e < 0) -- throw GDLException(NULL,"Subscript out of range [s:-E:stride].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [s:-E:stride].",true,false); - } - else - e = eInit; - - if( s > e) - throw -- GDLException(NULL,"Subscript range values of the form low:high " -+ GDLException(-1,NULL,"Subscript range values of the form low:high " - "must be < size, with low <= high",true,false); - - if( e >= varDim) // && e > 0) - { -- throw GDLException(NULL,"Subscript out of range [s:E:st].",true,false); -+ throw GDLException(-1,NULL,"Subscript out of range [s:E:st].",true,false); - } - return (e - s + stride)/stride; - } -@@ -1281,7 +1282,7 @@ - - BaseGDL* OverloadIndexNew() - { -- DLong arr[3] = {sInit,eInit,stride}; -+ DLong arr[3] = {static_cast(sInit),static_cast(eInit),static_cast(stride)}; - return new DLongGDL( arr, 3); - } - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/arrayindexlistnoassoct.hpp gdl/src/arrayindexlistnoassoct.hpp ---- gdl-0.9.3/src/arrayindexlistnoassoct.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/arrayindexlistnoassoct.hpp 2013-07-08 12:39:21.429398645 -0600 -@@ -87,13 +87,14 @@ - - ArrayIndexListT* Clone() { return new ArrayIndexListOneNoAssocT( *this);} - -- void InitAsOverloadIndex( IxExprListT& ix_, IxExprListT* cleanupIxIn, IxExprListT& ixOut) -+ IxExprListT* GetCleanupIx() { return &cleanupIx;} -+ void InitAsOverloadIndex( IxExprListT& ix_, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut) - { - assert( allIx == NULL); - assert( ix_.size() == nParam); - -- if( cleanupIxIn != NULL) -- cleanupIx = *cleanupIxIn; -+// if( cleanupIxIn != NULL) -+// cleanupIx = *cleanupIxIn; - - DLongGDL* isRange = new DLongGDL( dimension(1, BaseGDL::NOZERO)); - ixOut.push_back(isRange); -@@ -125,13 +126,13 @@ - } - } - -- void Init( IxExprListT& ix_, IxExprListT* cleanupIxIn) -+ void Init( IxExprListT& ix_)//, IxExprListT* cleanupIxIn) - { - assert( allIx == NULL); - assert( ix_.size() == nParam); - -- if( cleanupIxIn != NULL) -- cleanupIx = *cleanupIxIn; -+// if( cleanupIxIn != NULL) -+// cleanupIx = *cleanupIxIn; - - if( nParam == 0) //return; - { -@@ -165,7 +166,7 @@ - bool ToAssocIndex( SizeT& lastIx) - { - assert( 0); -- throw GDLException( NULL,"Internal error: ArrayIndexListOneNoAssocT::ToAssocIndex(...) called.",true,false); -+ throw GDLException(-1,NULL,"Internal error: ArrayIndexListOneNoAssocT::ToAssocIndex(...) called.",true,false); - return true; - } - -@@ -180,7 +181,7 @@ - // ArrayIndexScalar[VP] are not initialized - // they need the NIter call, but - // for only one index they have their own ArrayIndexListT -- nIx=ix->NIter( var->Size()); -+ nIx=ix->NIter( var->N_Elements()/*var->Size()*/); - } - - // structure of indexed expression -@@ -276,7 +277,7 @@ - { - // scalar case - if( right->N_Elements() == 1 && //!var->IsAssoc() && -- ix->NIter( var->Size()) == 1)// && var->Type() != GDL_STRUCT) -+ ix->NIter( var->N_Elements()/*var->Size()*/) == 1)// && var->Type() != GDL_STRUCT) - { - var->AssignAtIx( ix->GetIx0(), right); - return; -@@ -291,7 +292,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -300,11 +301,11 @@ - // optimized for one dimensional access - BaseGDL* Index( BaseGDL* var, IxExprListT& ix_) - { -- Init( ix_, NULL); -- if( ix->Scalar())// && ix->NIter( var->Size()) == 1)// && var->Type() != GDL_STRUCT) --// if( !var->IsAssoc() && ix->NIter( var->Size()) == 1)// && var->Type() != GDL_STRUCT) -+ Init( ix_);//, NULL); -+ if( ix->Scalar())// && ix->NIter( var->N_Elements()/*var->Size()*/) == 1)// && var->Type() != GDL_STRUCT) -+// if( !var->IsAssoc() && ix->NIter( var->N_Elements()/*var->Size()*/) == 1)// && var->Type() != GDL_STRUCT) - { -- SizeT assertValue = ix->NIter( var->Size()); -+ SizeT assertValue = ix->NIter( var->N_Elements()/*var->Size()*/); - assert( assertValue == 1); - - return var->NewIx( ix->GetIx0()); -@@ -379,7 +380,7 @@ - - ArrayIndexListT* Clone() { return new ArrayIndexListOneScalarNoAssocT( *this);} - -- void InitAsOverloadIndex( IxExprListT& ix_, IxExprListT* cleanupIxIn, IxExprListT& ixOut); -+ void InitAsOverloadIndex( IxExprListT& ix_, IxExprListT& ixOut); - - void Init() {} - -@@ -500,7 +501,7 @@ - - ArrayIndexListT* Clone() { return new ArrayIndexListOneScalarVPNoAssocT( *this);} - -- void InitAsOverloadIndex( IxExprListT& ix_, IxExprListT* cleanupIxIn, IxExprListT& ixOut); -+ void InitAsOverloadIndex( IxExprListT& ix_, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut); - - void Init() {} - -@@ -511,7 +512,7 @@ - { - sInit = varPtr->Data()->LoopIndex(); - if( sInit < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException(-1,NULL,"Record number must be a scalar > 0 in this context.",true,false); - s = sInit; - lastIx = s; - return true; -@@ -528,10 +529,10 @@ - - // for assoc variables last index is the record - // if( var->IsAssoc()) return; -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].1",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1,NULL,"Scalar subscript too large.",true,false); - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].1",true,false); -+ throw GDLException(-1,NULL,"Scalar subscript too small (<-1).",true,false); - } - - // structure of indexed expression -@@ -575,8 +576,8 @@ - if( right->N_Elements() == 1) // && !var->IsAssoc()) // && var->Type() != GDL_STRUCT) - { - s = varPtr->Data()->LoopIndex(); -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].2",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>].2",true,false); - var->AssignAtIx( s, right); - return; - } -@@ -589,7 +590,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -665,7 +666,7 @@ - // delete (*aIV)[0]; - } - -- void InitAsOverloadIndex( IxExprListT& ix_, IxExprListT* cleanupIxIn, IxExprListT& ixOut) -+ void InitAsOverloadIndex( IxExprListT& ix_, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut) - { - assert( 0 == nParam); - assert( rawData != NULL); -@@ -709,7 +710,7 @@ - bool ToAssocIndex( SizeT& lastIx) - { - if( sInit < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException(-1,NULL,"Record number must be a scalar > 0 in this context. ("+i2s(sInit)+")",true,false); - lastIx = sInit; - return true; - } -@@ -719,12 +720,12 @@ - { - // if( var->IsAssoc()) return; - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - // for assoc variables last index is the record - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].1",true,false); -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].1",true,false); -+ throw GDLException(-1,NULL,"Scalar subscript out of range [<0] ("+i2s(s)+")",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>] ("+i2s(s)+")",true,false); - } - - // returns one dim long ix in case of one element array index -@@ -745,11 +746,11 @@ - if( right->N_Elements() == 1)// && !var->IsAssoc())// && var->Type() != GDL_STRUCT) - { - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].4",true,false); -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].4",true,false); -+ throw GDLException(-1,NULL,"Scalar subscript out of range [<0]. ("+i2s(s)+")",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>]. ("+i2s(s)+")",true,false); - var->AssignAtIx( s, right); // must use COPY_BYTE_AS_INT - return; - } -@@ -762,7 +763,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -775,13 +776,13 @@ - // if( !var->IsAssoc())// && var->Type() != GDL_STRUCT) - { - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].5",true,false); -- if( s >= var->Size()) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [<0]: ("+i2s(s)+")",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) - { --// std::cout << s << " var->Size():" << var->Size() << std::endl; -- throw GDLException(NULL,"Scalar subscript out of range [>].5",true,false); -+// std::cout << s << " var->N_Elements()/*var->Size()*/:" << var->N_Elements()/*var->Size()*/ << std::endl; -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>]: ("+i2s(s)+")",true,false); - } - - return var->NewIx( s); -@@ -877,7 +878,7 @@ - // ixListEnd( NULL) - { - if( ix->size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - assert( ixList.size() > 1); // must be, from compiler - -@@ -887,7 +888,7 @@ - nParam = 0; - } - -- void InitAsOverloadIndex( IxExprListT& ix, IxExprListT* cleanupIxIn, IxExprListT& ixOut) -+ void InitAsOverloadIndex( IxExprListT& ix, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut) - { - assert( ix.size() == 0); - -@@ -1001,7 +1002,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace (not only scalar) - } -@@ -1089,13 +1090,13 @@ - ixList( *ix) - { - if( ix->size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - assert( ixList.size() == 2); // must be, from compiler - nParam = 0; - } - -- void InitAsOverloadIndex( IxExprListT& ix, IxExprListT* cleanupIxIn, IxExprListT& ixOut) -+ void InitAsOverloadIndex( IxExprListT& ix, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut) - { - assert( ix.size() == 0); - -@@ -1177,7 +1178,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace (not only scalar) - } -@@ -1227,7 +1228,7 @@ - class ArrayIndexListMultiNoAssocT: public ArrayIndexListT - { - private: -- IxExprListT cleanupIx; -+ IxExprListT cleanupIx; - - protected: - ArrayIndexVectorT ixList; -@@ -1271,7 +1272,7 @@ - // for( std::vector::iterator i=ixList.begin(); - // i != ixList.end(); ++i) - // { delete *i;} -- cleanupIx.Cleanup(); -+ cleanupIx.Cleanup(); - } - - // constructor -@@ -1308,7 +1309,7 @@ - assert( ix->size() != 0); // must be, from compiler - - if( ixList.size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - nParam = 0; - for( SizeT i=0; isize(); ++i) -@@ -1366,15 +1367,17 @@ - cleanupIx.Cleanup(); - } - -+ IxExprListT* GetCleanupIx() { return &cleanupIx;} -+ - ArrayIndexListT* Clone() { return new ArrayIndexListMultiNoAssocT( *this);} - -- void InitAsOverloadIndex( IxExprListT& ix, IxExprListT* cleanupIxIn, IxExprListT& ixOut) -+ void InitAsOverloadIndex( IxExprListT& ix, /*IxExprListT* cleanupIxIn,*/ IxExprListT& ixOut) - { - assert( allIx == NULL); - assert( ix.size() == nParam); - -- if( cleanupIxIn != NULL) -- cleanupIx = *cleanupIxIn; -+// if( cleanupIxIn != NULL) -+// cleanupIx = *cleanupIxIn; - - DLongGDL* isRange = new DLongGDL( dimension(ixList.size(), BaseGDL::NOZERO)); - ixOut.push_back(isRange); -@@ -1414,13 +1417,13 @@ - } - } - -- void Init( IxExprListT& ix, IxExprListT* cleanupIxIn) -+ void Init( IxExprListT& ix)//, IxExprListT* cleanupIxIn) - { - assert( allIx == NULL); - assert( ix.size() == nParam); - -- if( cleanupIxIn != NULL) -- cleanupIx = *cleanupIxIn; -+// if( cleanupIxIn != NULL) -+// cleanupIx = *cleanupIxIn; - - SizeT pIX = 0; - for( SizeT i=0; i all scalar - { -- accessType = ALLONE; // needed for GetDim() -- const dimension& varDim = var->Dim(); -- SizeT varRank = varDim.Rank(); -- -- varStride = varDim.Stride(); -- nIterLimitGt1 = 0; // marker for BuildIx -- -- ixList[0]->NIter( (0GetIx0(); // * varStride[0]; // GetS() not ok because INDEXED -+ accessType = ALLONE; // needed for GetDim() -+ const dimension& varDim = var->Dim(); -+ SizeT varRank = varDim.Rank(); -+ -+ varStride = varDim.Stride(); -+ nIterLimitGt1 = 0; // marker for BuildIx -+ -+ ixList[0]->NIter( (0GetIx0(); // * varStride[0]; // GetS() not ok because INDEXED - -- // check boundary -- for(SizeT i=1; iNIter( (iGetIx0() * varStride[i]; // GetS() not ok because INDEXED -- } -+ // check boundary -+ for(SizeT i=1; iNIter( (iGetIx0() * varStride[i]; // GetS() not ok because INDEXED -+ } - -- nIx = 1; -- return; -+ nIx = 1; -+ return; - // accessType = ALLONE; - // varStride = var->Dim().Stride(); - // // check boundary -@@ -1577,30 +1580,31 @@ - const dimension& varDim = var->Dim(); - SizeT varRank = varDim.Rank(); - -+ varStride = var->Dim().Stride(); -+ - if( accessType == ALLINDEXED) - { -+ baseIx = 0; -+ - nIx=ixList[0]->NIter( (0 1); -- for( SizeT i=1; iNIter( (iNIter( (iDim().Stride(); --// varDim.Stride( varStride,acRank); // copy variables stride into varStride -+ //varDim.Stride( varStride,acRank); // copy variables stride into varStride - return; - } - - // NORMAL -- varStride = var->Dim().Stride(); - // varDim.Stride( varStride,acRank); // copy variables stride into varStride - assert( varStride[0] == 1); - -@@ -1735,7 +1739,7 @@ - } - allIx = new (allIxInstance) AllIxNewMultiT( &ixList, acRank, nIx, varStride, nIterLimit, stride); - return allIx; --} -+ } - - // returns one dim long ix in case of one element array index - // used by AssignAt and Index functions -@@ -1758,7 +1762,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -1768,7 +1772,7 @@ - BaseGDL* Index( BaseGDL* var, IxExprListT& ix) - { - // normal case -- Init( ix, NULL); -+ Init( ix);//, NULL); - SetVariable( var); - if( nIx == 1)// && !var->IsAssoc()) - { -@@ -1829,7 +1833,7 @@ - assert( ix->size() != 0); // must be, from compiler - - if( ixList.size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - nParam = 0; - for( SizeT i=0; isize(); ++i) -@@ -2133,7 +2137,7 @@ - assert( ix->size() != 0); // must be, from compiler - - if( ixList.size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - nParam = 0; - for( SizeT i=0; isize(); ++i) -@@ -2222,7 +2226,7 @@ - { - SizeT nIter = ixList[i]->NIter( (iInit(); - RangeT lastValIx; - if( !ix->Scalar( lastValIx)) -- throw GDLException( NULL,"Record number must be a scalar in this context.",true,false); -+ throw GDLException( -1, NULL,"Record number must be a scalar in this context.",true,false); - - if( lastValIx < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException( -1, NULL,"Record number must be a scalar > 0 in this context.",true,false); - - lastIx = lastValIx; - return true; -@@ -209,7 +216,7 @@ - // ArrayIndexScalar[VP] are not initialized - // they need the NIter call, but - // for only one index they have their own ArrayIndexListT -- nIx=ix->NIter( var->Size()); -+ nIx=ix->NIter( var->N_Elements()/*var->Size()*/); - } - - // structure of indexed expression -@@ -304,7 +311,7 @@ - { - // scalar case - if( right->N_Elements() == 1 && !var->IsAssoc() && -- ix->NIter( var->Size()) == 1)// && var->Type() != GDL_STRUCT) -+ ix->NIter( var->N_Elements()/*var->Size()*/) == 1)// && var->Type() != GDL_STRUCT) - { - var->AssignAtIx( ix->GetIx0(), right); - return; -@@ -319,7 +326,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -328,10 +335,10 @@ - // optimized for one dimensional access - BaseGDL* Index( BaseGDL* var, IxExprListT& ix_) - { -- Init( ix_, NULL); -- if( !var->IsAssoc() && ix->Scalar()) //ix->NIter( var->Size()) == 1)// && var->Type() != GDL_STRUCT) -+ Init( ix_);//, NULL); -+ if( !var->IsAssoc() && ix->Scalar()) //ix->NIter( var->N_Elements()/*var->Size()*/) == 1)// && var->Type() != GDL_STRUCT) - { -- SizeT assertValue = ix->NIter( var->Size()); -+ SizeT assertValue = ix->NIter( var->N_Elements()/*var->Size()*/); - assert( assertValue == 1); - - return var->NewIx( ix->GetIx0()); -@@ -535,7 +542,7 @@ - { - sInit = varPtr->Data()->LoopIndex(); - if( sInit < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException( -1, NULL,"Record number must be a scalar > 0 in this context.",true,false); - s = sInit; - lastIx = s; - return true; -@@ -552,10 +559,10 @@ - - // for assoc variables last index is the record - if( var->IsAssoc()) return; -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].1",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1, NULL,"Scalar subscript out of range (>).",true,false); - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].1",true,false); -+ throw GDLException(-1,NULL,"Scalar subscript out of range (<-1).",true,false); - } - - // structure of indexed expression -@@ -599,8 +606,8 @@ - if( right->N_Elements() == 1 && !var->IsAssoc()) // && var->Type() != GDL_STRUCT) - { - s = varPtr->Data()->LoopIndex(); -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].2",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>].2",true,false); - var->AssignAtIx( s, right); - return; - } -@@ -613,7 +620,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -714,7 +721,7 @@ - bool ToAssocIndex( SizeT& lastIx) - { - if( sInit < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException(-1,NULL,"Record number must be a scalar > 0 in this context.",true,false); - lastIx = sInit; - return true; - } -@@ -724,12 +731,12 @@ - { - if( var->IsAssoc()) return; - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - // for assoc variables last index is the record - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].1",true,false); -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].1",true,false); -+ throw GDLException(-1,NULL,"Scalar subscript out of range [<].1",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>].1",true,false); - } - - // returns one dim long ix in case of one element array index -@@ -750,11 +757,11 @@ - if( right->N_Elements() == 1 && !var->IsAssoc())// && var->Type() != GDL_STRUCT) - { - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].2",true,false); -- if( s >= var->Size()) -- throw GDLException(NULL,"Scalar subscript out of range [>].2",true,false); -+ throw GDLException(-1,NULL,"Scalar subscript out of range [<].2",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>].2",true,false); - var->AssignAtIx( s, right); - return; - } -@@ -767,7 +774,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -780,13 +787,13 @@ - if( !var->IsAssoc())// && var->Type() != GDL_STRUCT) - { - if( sInit < 0) -- s = sInit + var->Size(); -+ s = sInit + var->N_Elements()/*var->Size()*/; - if( s < 0) -- throw GDLException(NULL,"Scalar subscript out of range [<].3",true,false); -- if( s >= var->Size()) -+ throw GDLException(-1,NULL,"Scalar subscript out of range [<].3",true,false); -+ if( s >= var->N_Elements()/*var->Size()*/) - { --// std::cout << s << " var->Size():" << var->Size() << std::endl; -- throw GDLException(NULL,"Scalar subscript out of range [>].3",true,false); -+// std::cout << s << " var->N_Elements()/*var->Size()*/:" << var->N_Elements()/*var->Size()*/ << std::endl; -+ throw GDLException(-1,NULL,"Scalar subscript out of range [>].3",true,false); - } - - return var->NewIx( s); -@@ -879,7 +886,7 @@ - assert( ixList.size() > 1); // must be, from compiler - - if( ix->size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - nParam = 0; - for( SizeT i=0; iScalar( lastIxVal); // always scalar - - if( lastIxVal < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException(-1,NULL,"Record number must be a scalar > 0 in this context.",true,false); - - lastIx = lastIxVal; - return false; // multi dim -@@ -1047,7 +1054,7 @@ - else - { - BaseGDL* rConv = right->Convert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace (not only scalar) - } -@@ -1164,7 +1171,8 @@ - bool indexed; // is the variable index indexed? - - public: -- -+ IxExprListT* GetCleanupIx() { return &cleanupIx;} -+ - ~ArrayIndexListMultiT() - { - // delete allIx; -@@ -1209,7 +1217,7 @@ - assert( ix->size() != 0); // must be, from compiler - - if( ixList.size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - nParam = 0; - for( SizeT i=0; isize(); ++i) -@@ -1276,13 +1284,13 @@ - ArrayIndexListT* Clone() { return new ArrayIndexListMultiT( *this);} - - -- void Init( IxExprListT& ix, IxExprListT* cleanupIxIn) -+ void Init( IxExprListT& ix)//, IxExprListT* cleanupIxIn) - { - assert( allIx == NULL); - assert( ix.size() == nParam); - -- if( cleanupIxIn != NULL) -- cleanupIx = *cleanupIxIn; -+// if( cleanupIxIn != NULL) -+// cleanupIx = *cleanupIxIn; - - SizeT pIX = 0; - for( SizeT i=0; iScalar( lastValIx)) -- throw GDLException(NULL ,"Record number must be a scalar in this context.",true,false); -+ throw GDLException(-1, NULL ,"Record number must be a scalar in this context.",true,false); - - if( lastValIx < 0) -- throw GDLException( NULL,"Record number must be a scalar > 0 in this context.",true,false); -+ throw GDLException(-1, NULL,"Record number must be a scalar > 0 in this context.",true,false); - - lastIx = lastValIx; - -@@ -1463,7 +1471,7 @@ - { - SizeT nIter = ixList[i]->NIter( (iConvert2( var->Type(), BaseGDL::COPY); -- std::auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - - var->AssignAt( rConv, this); // assigns inplace - } -@@ -1678,7 +1686,7 @@ - BaseGDL* Index( BaseGDL* var, IxExprListT& ix) - { - // normal case -- Init( ix, NULL); -+ Init( ix);//, NULL); - SetVariable( var); - if( nIx == 1 && !var->IsAssoc()) - { -@@ -1738,7 +1746,7 @@ - assert( ix->size() != 0); // must be, from compiler - - if( ixList.size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - nParam = 0; - for( SizeT i=0; isize(); ++i) -@@ -1976,7 +1984,7 @@ - assert( ix->size() != 0); // must be, from compiler - - if( ixList.size() > MAXRANK) -- throw GDLException(NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); -+ throw GDLException(-1,NULL,"Maximum of "+MAXRANK_STR+" dimensions allowed.",true,false); - - nParam = 0; - for( SizeT i=0; isize(); ++i) -@@ -2066,7 +2074,7 @@ - { - SizeT nIter = ixList[i]->NIter( (i --deque< void*> Assoc_< Parent_>::freeList; -+vector< void*> Assoc_< Parent_>::freeList; - - template< class Parent_> - void* Assoc_< Parent_>::operator new( size_t bytes) - { -- assert( bytes == sizeof( Assoc_< Parent_> )); -- -- if( freeList.size() > 0) -- { -- void* res = freeList.back(); -- freeList.pop_back(); -- return res; -- } -- --// cout << "Alloc: " << bytes << " " << Sp::str << endl; -- -- const size_t newSize = multiAlloc - 1; -- freeList.resize( newSize); -- char* res = static_cast< char*>( malloc( sizeof( Assoc_< Parent_>) * multiAlloc)); // one more than newSize -- for( size_t i=0; i); -- } -- -- return res; -+ assert( bytes == sizeof( Assoc_< Parent_> )); -+ -+ if( freeList.size() > 0) -+ { -+ void* res = freeList.back(); -+ freeList.pop_back(); -+ return res; -+ } -+ -+ const size_t newSize = multiAlloc - 1; -+ -+ static long callCount = 0; -+ ++callCount; -+ -+ // reserve space for all instances -+ freeList.reserve( callCount*multiAlloc); -+ -+ // resize to what is needed now -+ freeList.resize( newSize); -+ -+#ifdef USE_EIGEN -+ // we need this allocation here as well (as in typedefs.hpp), because GDLArray needs to be aligned -+ const int alignmentInBytes = 16; // set to multiple of 16 >= sizeof( char*) -+ const size_t realSizeOfType = sizeof( Assoc_< Parent_>); -+ const SizeT exceed = realSizeOfType % alignmentInBytes; -+ const size_t sizeOfType = realSizeOfType + (alignmentInBytes - exceed); -+ char* res = static_cast< char*>( Eigen::internal::aligned_malloc( sizeOfType * multiAlloc)); // one more than newSize -+#else -+ const size_t sizeOfType = sizeof( Assoc_< Parent_>); -+ char* res = static_cast< char*>( malloc( sizeOfType * multiAlloc)); // one more than newSize -+#endif -+ -+ for( size_t i=0; i -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/assocdata.hpp gdl/src/assocdata.hpp ---- gdl-0.9.3/src/assocdata.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/assocdata.hpp 2013-07-08 12:39:21.451398384 -0600 -@@ -31,7 +31,7 @@ - - public: - // memory management optimization --static std::deque< void*> freeList; -+static std::vector< void*> freeList; - - // operator new and delete - static void* operator new( size_t bytes); -@@ -134,7 +134,7 @@ - throw GDLException("Assoc_::GetInstance(...) called."); - } - -- int Scalar2index(SizeT& ret) const -+ int Scalar2Index(SizeT& ret) const - { - throw GDLException("File expression not allowed in this context."); - } -@@ -346,7 +346,7 @@ - throw GDLException("File expression not allowed in this context."); - } - -- Parent_* MatrixOp( BaseGDL* r) -+ Parent_* MatrixOp( BaseGDL* r, bool, bool) - { - throw GDLException("File expression not allowed in this context."); - } -@@ -385,6 +385,10 @@ - { - throw GDLException("File expression not allowed in this context."); - } -+ SizeT OFmtCal( std::ostream* os, SizeT offset, SizeT num, int width) -+ { -+ throw GDLException("File expression not allowed in this context."); -+ } - SizeT IFmtA( std::istream* os, SizeT offset, SizeT num, int width) - { - throw GDLException("File expression not allowed in this context."); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basegdl.cpp gdl/src/basegdl.cpp ---- gdl-0.9.3/src/basegdl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basegdl.cpp 2013-07-31 09:41:43.676246614 -0600 -@@ -63,7 +63,10 @@ - // { - // throw GDLException("BaseGDL::Abs() called."); - // } -- -+int BaseGDL::HashCompare( BaseGDL*) const -+{ -+ throw GDLException("BaseGDL::HashCompare( BaseGDL*) called."); -+} - bool BaseGDL::Greater(SizeT i1, SizeT i2) const - { - throw GDLException("BaseGDL::Greater(SizeT,SizeT) called."); -@@ -202,7 +205,7 @@ - throw GDLException("BaseGDL::SetBufferSize called."); - } - --int BaseGDL::Scalar2index(SizeT& ret) const -+int BaseGDL::Scalar2Index(SizeT& ret) const - { - throw GDLException("Operation not defined for UNDEF 1."); - } -@@ -456,7 +459,7 @@ - throw GDLException("Operation not defined for UNDEF 170."); - } - --BaseGDL* BaseGDL::MatrixOp( BaseGDL* r, bool rtranspose, bool transposeResult, bool strassen) -+BaseGDL* BaseGDL::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose) - { - throw GDLException("Operation not defined for UNDEF 18."); - } -@@ -508,6 +511,10 @@ - int minN, char fill, BaseGDL::IOMode oM) - {throw GDLException("BaseGDL::OFmtI(...) called.");} - -+SizeT BaseGDL::OFmtCal( std::ostream* os, SizeT offs, SizeT num, int width, -+ int minN, char fill, BaseGDL::Cal_IOMode oM) -+{throw GDLException("BaseGDL::OFmtC(...) called.");} -+ - SizeT BaseGDL::IFmtA( std::istream* is, SizeT offset, SizeT num, int width) - {throw GDLException("BaseGDL::IFmtA(...) called.");} - -@@ -518,8 +525,8 @@ - BaseGDL::IOMode oM) - {throw GDLException("BaseGDL::IFmtI(...) called.");} - --BaseGDL* BaseGDL::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode) -+BaseGDL* BaseGDL::Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) - { - throw GDLException("BaseGDL::Convol(...) called."); - } -@@ -672,6 +679,11 @@ - throw GDLException("Operation not defined for UNDEF 29."); - } - -+DDouble BaseGDL::HashValue() const -+{ -+ throw GDLException("Operation not defined for UNDEF 29a."); -+} -+ - BaseGDL* BaseGDL::Rotate( DLong dir) - { - throw GDLException("Operation not defined for UNDEF 30."); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basegdl.hpp gdl/src/basegdl.hpp ---- gdl-0.9.3/src/basegdl.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basegdl.hpp 2013-07-31 09:41:43.681246597 -0600 -@@ -63,6 +63,22 @@ - GDL_ULONG, // 13 unsigned long int - GDL_LONG64, // 14 64 bit integer - GDL_ULONG64 // 15 unsigned 64 bit integer -+ -+ // not yet implemented -+ , GDL_LONG128 // 128 bit integer -+ , GDL_ULONG128 // unsigned 128 bit integer -+ -+ , GDL_LONGABI // arbitrary length int -+ //, GDL_ULONGABI // arbitrary length unsigned int (pointless) -+ -+ , GDL_LDOUBLE // long double precision float (80 or 128bit) -+ , GDL_COMPLEXLDBL // Complex long double -+ -+ , GDL_ARBITRARY // arbitrary precision float -+ , GDL_COMPLEXABI // Complex arbitrary -+ -+ , GDL_RATIONAL // arbitrary length rational -+ , GDL_COMPLEXRAT // Complex arbitrary length rational - }; - - // order of conversion precedence if two types are the same, -@@ -74,17 +90,55 @@ - 4, //GDL_LONG, - 8, //GDL_FLOAT, - 9, //GDL_DOUBLE, -- 10, //GDL_COMPLEX, -+ 20, //GDL_COMPLEX, - 1, //GDL_STRING, - 101, //GDL_STRUCT, -- 11, //GDL_COMPLEXDBL, -+ 21, //GDL_COMPLEXDBL, - 102, //GDL_PTR, - 103, //GDL_OBJ, // must be highest number (see AdjustTypes... functions) - 3, //GDL_UINT, - 4, //GDL_ULONG, - 5, //GDL_LONG64, - 5 //GDL_ULONG64 -+ -+ // not yet implemented -+ ,6 // , GDL_LONG128 // 128 bit integer -+ ,6 // , GDL_ULONG128 // unsigned 128 bit integer -+ // -+ ,7 // , GDL_LONGAB // arbitrary length int -+ // ,7 // , GDL_ULONGAR // arbitrary length unsigned int (pointless) -+ // -+ ,10 // , GDL_LDOUBLE // quad precision float (80 or 128bit) -+ ,22 // , GDL_COMPLEXLDBL // Complex quad -+ // -+ ,11 // , GDL_ARBITRARY // arbitrary precision float -+ ,23 // , GDL_COMPLEXAR // Complex arbitrary -+ // -+ ,12 // , GDL_RATIONAL // arbitrary length rational -+ ,24 // , GDL_COMPLEXRAT // Complex arbitrary length rational - }; -+ -+ -+inline DType PromoteMatrixOperands( DType aTy, DType bTy) -+{ -+ DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -+ if( maxTy == GDL_BYTE || maxTy == GDL_INT) -+ return GDL_LONG; -+ else if( maxTy == GDL_UINT) -+ return GDL_ULONG; -+ return maxTy; -+} -+ -+inline DType PromoteComplexOperand( DType aTy, DType bTy) -+{ -+ if((aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) || -+ (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE) ) -+ return GDL_COMPLEXDBL; -+ return GDL_UNDEF; -+} -+ -+namespace gdl_type_lookup { -+ - const bool IsConvertableType[]={ - false, //GDL_UNDEF - true, //GDL_BYTE -@@ -176,14 +230,17 @@ - false //GDL_ULONG64 - }; - -+ -+} //namespace gdl_type_lookup -+ - inline bool NonPODType( DType t) - { -- return IsNonPODType[ t]; -+ return gdl_type_lookup::IsNonPODType[ t]; - // return (t == GDL_COMPLEX) || (t == GDL_COMPLEXDBL) || (t == GDL_STRING) || (t == GDL_STRUCT); - } - inline bool IntType( DType t) - { -- return IsIntType[ t]; -+ return gdl_type_lookup::IsIntType[ t]; - // int o = DTypeOrder[ t]; - // return (o >= 2 && o <= 5); - } -@@ -193,7 +250,7 @@ - } - inline bool RealType( DType t) // Float or Int - { -- return IsRealType[ t]; -+ return gdl_type_lookup::IsRealType[ t]; - // int o = DTypeOrder[ t]; - // return (o >= 2 && o <= 9); - } -@@ -203,13 +260,13 @@ - } - inline bool NumericType( DType t) // Float or Int or Complex - { -- return IsNumericType[ t]; -+ return gdl_type_lookup::IsNumericType[ t]; - // int o = DTypeOrder[ t]; - // return (o >= 2 && o <= 11); - } - inline bool ConvertableType( DType t) // everything except Struct, Ptr, Obj - { -- return IsConvertableType[ t]; -+ return gdl_type_lookup::IsConvertableType[ t]; - // int o = DTypeOrder[ t]; - // return (o >= 1 && o <= 11); - } -@@ -354,7 +411,27 @@ - HEXL, // lower case characters - AUTO - }; -- -+ -+ enum Cal_IOMode { -+ DEFAULT=0, -+ CMOA, -+ CMoA, -+ CmoA, -+ CMOI, -+ CDI, -+ CYI, -+ CHI, -+ ChI, -+ CMI, -+ CSI, -+ CSF, -+ CDWA, -+ CDwA, -+ CdwA, -+ CAPA, -+ CApA, -+ CapA -+ }; - // FIRST VIRTUAL FUNCTION'S GDL_OBJ FILE CONTAINS ALSO THE VTABLE - // therefore it must be defined non-inline (g++) - virtual ~BaseGDL(); // defined in basegdl.cpp -@@ -394,6 +471,8 @@ - virtual SizeT NBytes() const; // total bytes of data - virtual SizeT ToTransfer() const; // elements to transfer - virtual SizeT Sizeof() const; // size of scalar data -+ -+ virtual int HashCompare( BaseGDL* p2) const; - - virtual BaseGDL* Transpose( DUInt* perm); - virtual BaseGDL* Rotate( DLong dir); -@@ -441,11 +520,13 @@ - virtual BaseGDL* GetEmptyInstance() const; - virtual BaseGDL* SetBuffer( const void* b); - virtual void SetBufferSize( SizeT s); -- virtual int Scalar2index(SizeT& ret) const; -+ virtual int Scalar2Index(SizeT& ret) const; - virtual int Scalar2RangeT(RangeT& ret) const; - virtual SizeT GetAsIndex( SizeT i) const; - virtual SizeT GetAsIndexStrict( SizeT i) const; - virtual RangeT LoopIndex() const; -+ virtual DDouble HashValue() const; -+ - virtual bool True(); - virtual bool False(); - virtual bool LogTrue(); -@@ -481,8 +562,8 @@ - virtual BaseGDL* NewIxFromStride( SizeT s, SizeT e, SizeT stride); - - // library functions -- virtual BaseGDL* Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode); -+ virtual BaseGDL* Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode); - virtual BaseGDL* Rebin( const dimension& newDim, bool sample); - // for STRUCT_ASSIGN - virtual void Assign( BaseGDL* src, SizeT nEl); -@@ -598,7 +679,7 @@ - - - // virtual BaseGDL* PowInvNew( BaseGDL* r); -- virtual BaseGDL* MatrixOp( BaseGDL* r, bool rtranspose = false, bool transposeResult =false, bool strassen = false); -+ virtual BaseGDL* MatrixOp( BaseGDL* r, bool atranspose=false, bool btranspose=false); - virtual void AssignAt( BaseGDL* srcIn, ArrayIndexListT* ixList, SizeT offset); - virtual void AssignAt( BaseGDL* srcIn, ArrayIndexListT* ixList); - virtual void AssignAt( BaseGDL* srcIn); -@@ -617,6 +698,8 @@ - int prec, char fill, IOMode oM = FIXED); - virtual SizeT OFmtI( std::ostream* os, SizeT offs, SizeT num, int width, - int minN, char fill, BaseGDL::IOMode oM = DEC); -+ virtual SizeT OFmtCal( std::ostream* os, SizeT offs, SizeT num, int width, -+ int minN, char fill, BaseGDL::Cal_IOMode oM = DEFAULT); - virtual SizeT IFmtA( std::istream* is, SizeT offset, SizeT num, int width); - virtual SizeT IFmtF( std::istream* is, SizeT offs, SizeT num, int width); - virtual SizeT IFmtI( std::istream* is, SizeT offs, SizeT num, int width, -@@ -626,6 +709,9 @@ - - virtual PyObject* ToPython(); - #endif -+ -+ virtual bool Test2() {return false;} -+ - }; - - -@@ -652,6 +738,7 @@ - BaseGDL* endLoopVar; // the source for foreach as well - BaseGDL* loopStepVar; - DLong foreachIx; -+// bool isHash; // only used in FOREACH_INDEXNode::Run() and FOREACH_INDEX_LOOPNode::Run() - - ForLoopInfoT() - : endLoopVar(NULL) -Only in gdl-0.9.3/src: .#basegdl.hpp.1.71 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_fun_cl.cpp gdl/src/basic_fun_cl.cpp ---- gdl-0.9.3/src/basic_fun_cl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_fun_cl.cpp 2013-07-08 12:39:21.538397353 -0600 -@@ -1,529 +1,531 @@ --/*************************************************************************** -- basic_fun.cpp - basic GDL library function -- ------------------- -- begin : March 14 2004 -- copyright : (C) 2004 by Christopher Lee -- email : leec_gdl@publius.co.uk -- ***************************************************************************/ -- --/*************************************************************************** -- * * -- * This program is free software; you can redistribute it and/or modify * -- * it under the terms of the GNU General Public License as published by * -- * the Free Software Foundation; either version 2 of the License, or * -- * (at your option) any later version. * -- * * -- ***************************************************************************/ --#ifdef HAVE_CONFIG_H --#include --#else --// default: assume we have netCDF --#define USE_NETCDF 1 --// default: assume we have ImageMagick --#define USE_MAGICK 1 --#endif -- --#include "includefirst.hpp" -- --#include --#include --#include -- --#include --#include --#include --#include --#include -- --#include "initsysvar.hpp" --#include "datatypes.hpp" --#include "envt.hpp" --//#include "dpro.hpp" --//#include "dinterpreter.hpp" --#include "basic_fun_cl.hpp" --//#include "terminfo.hpp" -- --#define MAX_DATE_STRING_LENGTH 80 -- -+/*************************************************************************** -+ basic_fun.cpp - basic GDL library function -+ ------------------- -+ begin : March 14 2004 -+ copyright : (C) 2004 by Christopher Lee -+ email : leec_gdl@publius.co.uk -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+#ifdef HAVE_CONFIG_H -+#include -+#else -+// default: assume we have netCDF -+#define USE_NETCDF 1 -+// default: assume we have ImageMagick -+#define USE_MAGICK 1 -+#endif -+ -+#include "includefirst.hpp" -+ -+#include -+#include -+#include -+ -+#include -+#include -+#include -+#include -+#include -+ -+#include "initsysvar.hpp" -+#include "datatypes.hpp" -+#include "envt.hpp" -+//#include "dpro.hpp" -+//#include "dinterpreter.hpp" -+#include "basic_fun_cl.hpp" -+//#include "terminfo.hpp" -+ -+#define MAX_DATE_STRING_LENGTH 80 -+ - #ifdef _MSC_VER - #include "gtdhelper.hpp" - #else - #include --#endif -- --namespace lib { -- -- using namespace std; -- using namespace antlr; -- -- BaseGDL* magick_exists(EnvT *e) -- { --#ifdef USE_MAGICK -- return new DIntGDL(1); --#else -- return new DIntGDL(0); --#endif -- } -- -- BaseGDL* ncdf_exists(EnvT* e) -- { --#ifdef USE_NETCDF -- return new DIntGDL(1); --#else -- return new DIntGDL(0); --#endif -- } -- -- double Gregorian2Julian(struct tm *ts) -- { -- double jd; -- // SA: gives bad results, e.g.: -- // IDL> print, systime(/julian), f='(G)' -- // 2454995.131712963 -- // GDL> print, systime(/julian), f='(G)' -- // 2454994.527534722 -- // -- // jd = 367.0*(1900.+ts->tm_year) -- // - (7.0*((1900.+ts->tm_year) + ((1+ts->tm_mon+9.0)/12.0))/4.0) -- // + (275.0*(1+ts->tm_mon)/9.0)+ts->tm_mday -- // + (ts->tm_hour + (ts->tm_min + ts->tm_sec/60.0)/60.0)/24.0 -- // + 1721013.5; -- // -- // SA: an alterntive from the NOVAS library -- // (http://aa.usno.navy.mil/software/novas/novas_c/novasc_info.php) -- jd = ts->tm_mday - 32075L + 1461L * (ts->tm_year + 1900 + 4800L -- + (1 + ts->tm_mon - 14L) / 12L) / 4L -- + 367L * (1 + ts->tm_mon - 2L - (1 + ts->tm_mon - 14L) / 12L * 12L) -- / 12L - 3L * ((1900 + ts->tm_year + 4900L + (1 + ts->tm_mon - 14L) / 12L) -- / 100L) / 4L -- + (ts->tm_hour + (ts->tm_min + ts->tm_sec/60.0)/60.0)/24.0 - .5; -- // SA: end of modifications, the code below was here before -- -- if ((100.0*(1900.+ts->tm_year) + 1+ts->tm_mon - 190002.5) < 0) jd=jd+1.0; -- -- return jd; -- -- } -- -- BaseGDL* systime(EnvT* e) -- { -- struct timeval tval; -- struct timezone tzone; -- -- /*get the time before doing anything else, -- this hopefully gives a more meaningful "time" -- than if the t=time(0) call came after an -- arbitary number of conditional statements.*/ -- // cout << "lib::systime: " << t << endl; -- gettimeofday(&tval,&tzone); -- double tt = tval.tv_sec+tval.tv_usec/1e+6; // time in UTC seconds -- -- SizeT nParam=e->NParam(0); //,"SYSTIME"); -- bool ret_seconds=false; -- -- auto_ptr v_guard; -- auto_ptr v1_guard; -- -- if (nParam == 1) { -- //1 parameter, -- // 1->current UTC time seconds -- // default -- DIntGDL* v = static_cast(e->GetParDefined(0)->Convert2(GDL_INT,BaseGDL::COPY)); -- v_guard.reset( v); // e->Guard(v); -- -- if ( (*v)[0] == 1) //->EqualNoDelete( static_cDIntGDL(1))) -- ret_seconds=true; -- } else if (nParam == 2) { -- if (e->KeywordSet("JULIAN")) e->Throw("Conflicting keywords."); -- -- //2 parameters -- //if the first param is 0, return the date of the second arg -- //if the first param is 1, return the 'double' of the second arg -- DIntGDL* v1 = static_cast(e->GetParDefined(0)->Convert2(GDL_INT,BaseGDL::COPY)); -- v_guard.reset( v1); // e->Guard(v1); -- DDoubleGDL* v2 = static_cast(e->GetParDefined(1)->Convert2(GDL_DOUBLE,BaseGDL::COPY)); -- -- if( (*v1)[0] == 0) { //v1->EqualNoDelete( DIntGDL(0))) { //0, read the second argument as time_t; -- tval.tv_sec = static_cast((*v2)[0]); -- tval.tv_usec = static_cast(((*v2)[0]-tval.tv_sec)*1e+6); -- delete v2; // we delete v2 here as it is not guarded. Avoids a "new" in the following "else" -- } else { //1 -- return v2; -- } -- } -- -- //return the variable in seconds, either JULIAN, JULIAN+UTC, -- //or no other keywords -- struct tm *tstruct; -- if( ret_seconds || e->KeywordSet("SECONDS") ) -- { -- if( e->KeywordSet("JULIAN") ) -- { -- if( e->KeywordSet("UTC") ) -- tstruct=gmtime((time_t *)&tval.tv_sec); -- else -- tstruct=localtime((time_t *)&tval.tv_sec); -- -- return new DDoubleGDL(Gregorian2Julian(tstruct)); -- } -- else -- { -- // does not (necessaryly) work: time might count backwards -- //double tickTime = static_cast(t) + tt - floor( tt); -- return new DDoubleGDL(static_cast(tt)); -- } -- } -- -- //return a string of the time, either UTC or local (default) -- if(e->KeywordSet("UTC")) -- tstruct= gmtime((time_t *)&tval.tv_sec); -- else -- tstruct= localtime((time_t *)&tval.tv_sec); -- -- //Convert the time to JULIAN or NOT -- if(e->KeywordSet("JULIAN")) -- return new DDoubleGDL(Gregorian2Julian(tstruct)); -- else -- { -- char *st=new char[MAX_DATE_STRING_LENGTH]; -- const char *format="%a %h %d %T %Y";//my IDL date format. -- DStringGDL *S; -- -- SizeT res=strftime(st,MAX_DATE_STRING_LENGTH,format,tstruct); -- -- if(res != 0) -- S=new DStringGDL(st); -- else -- S=new DStringGDL(""); -- -- delete st; -- -- return S; -- } -- } -- -- BaseGDL* legendre(EnvT* e) -- { -- auto_ptr x_guard; -- auto_ptr l_guard; -- auto_ptr m_guard; -- -- SizeT nParam=e->NParam(2); //, "LEGENDRE"); -- auto_ptr guard; -- int count; -- -- -- BaseGDL* xvals,* lvals,* mvals; -- -- xvals= e->GetParDefined(0); //,"LEGENDRE"); -- -- SizeT nEx,nEl, nEm,nmin; -- nEl=0; -- nEm=0; -- -- -- nEx=xvals->N_Elements(); -- if(nEx == 0) -- e->Throw( -- "Variable is undefined: " -- +e->GetParString(0)); -- -- lvals=e->GetParDefined(1); //,"LEGENDRE"); -- nEl=lvals->N_Elements(); -- if(nEl == 0) -- e->Throw( -- "Variable is undefined: " -- +e->GetParString(1)); -- -- -- if(nParam > 2) -- { -- mvals=e->GetParDefined(2); //,"LEGENDRE"); -- nEm=mvals->N_Elements(); -- } else { -- mvals=new DIntGDL(0); -- nEm=1; -- guard.reset(mvals); -- } -- -- if(nEm == 0) -- e->Throw( -- "Variable is undefined: " -- +e->GetParString(2)); -- -- -- nmin=nEx; -- if(nEl < nmin && nEl > 1) nmin=nEl; -- if(nEm < nmin && nEm > 1) nmin=nEm; -- -- if (xvals->Type() == GDL_STRING) { -- e->Throw( -- "String expression not allowed in this context: " -- +e->GetParString(0)); -- } else if (xvals->Type() == GDL_PTR) { -- e->Throw( -- "Pointer expression not allowed in this context: " -- +e->GetParString(0)); -- } else if (xvals->Type() == GDL_OBJ) { -- e->Throw( -- "Object expression not allowed in this context: " -- +e->GetParString(0)); -- } else if (xvals->Type() == GDL_STRUCT) { -- e->Throw( -- "Struct expression not allowed in this context: " -- +e->GetParString(0)); -- } else if(xvals->Type() == GDL_COMPLEX || -- xvals->Type() == GDL_COMPLEXDBL) { -- e->Throw( -- "Complex Legendre not implemented: "); -- } else { -- //byte, int, long float, double, uint, ulong, int64, uint64 -- -- DDoubleGDL* res; -- DDoubleGDL* x_cast; -- DIntGDL* l_cast,*m_cast; -- -- if(xvals->Type() == GDL_DOUBLE) -- x_cast= static_cast(xvals); -- else -- { -- x_cast= static_cast(xvals->Convert2(GDL_DOUBLE,BaseGDL::COPY)); -- x_guard.reset(x_cast);//e->Guard( x_cast); -- } -- -- //lval check -- if (lvals->Type() == GDL_STRING) -- e->Throw( -- "String expression not allowed in this context: " -- +e->GetParString(1)); -- else if (lvals->Type() == GDL_PTR) -- e->Throw( -- "Pointer expression not allowed in this context: " -- +e->GetParString(1)); -- else if (lvals->Type() == GDL_OBJ) -- e->Throw( -- "Object expression not allowed in this context: " -- +e->GetParString(1)); -- else if (lvals->Type() == GDL_STRUCT) -- e->Throw( -- "Struct expression not allowed in this context: " -- +e->GetParString(1)); -- else if(lvals->Type() == GDL_COMPLEX || -- lvals->Type() == GDL_COMPLEXDBL) -- e->Throw( -- "Complex Legendre not implemented: "); -- else if(lvals->Type() == GDL_INT) -- l_cast=static_cast(lvals); -- else -- { -- l_cast=static_cast(lvals->Convert2(GDL_INT,BaseGDL::COPY)); -- l_guard.reset(l_cast);//e->Guard( l_cast); -- } -- -- //mval check -- if (mvals->Type() == GDL_STRING) -- e->Throw( -- "String expression not allowed in this context: " -- +e->GetParString(2)); -- else if (mvals->Type() == GDL_PTR) -- e->Throw( -- "Pointer expression not allowed in this context: " -- +e->GetParString(2)); -- else if (mvals->Type() == GDL_OBJ) -- e->Throw( -- "Object expression not allowed in this context: " -- +e->GetParString(2)); -- else if (mvals->Type() == GDL_STRUCT) -- e->Throw( -- "Struct expression not allowed in this context: " -- +e->GetParString(2)); -- else if(mvals->Type() == GDL_COMPLEX || -- mvals->Type() == GDL_COMPLEXDBL) -- e->Throw( -- "Complex Legendre not implemented: "); -- else if(mvals->Type() == GDL_INT) -- m_cast=static_cast(mvals); -- else -- { -- m_cast=static_cast(mvals->Convert2(GDL_INT,BaseGDL::COPY)); -- //e->Guard( m_cast); -- m_guard.reset(m_cast); -- } -- -- //x,m,l are converted to the correct format (double, int, int) here -- -- -- //make the result array have the same size as the smallest x,m,l array -- if(nmin == nEx) res=new DDoubleGDL(xvals->Dim(),BaseGDL::NOZERO); -- else if(nmin == nEl) res=new DDoubleGDL(lvals->Dim(),BaseGDL::NOZERO); -- else if(nmin == nEm) res=new DDoubleGDL(mvals->Dim(),BaseGDL::NOZERO); -- -- for (count=0;count nEx?0:count]; -- DInt lNow = (*l_cast)[nmin > nEl?0:count]; -- DInt mNow = (*m_cast)[nmin > nEm?0:count]; -- -- if( xNow < -1.0 || xNow > 1.0) -- e->Throw( "Argument X must be in the range [-1.0, 1.0]"); -- if( lNow < 0) -- e->Throw( "Argument L must be greater than or equal to zero."); -- if( mNow < -lNow || mNow > lNow) -- e->Throw( "Argument M must be in the range [-L, L]."); -- -- if( mNow >= 0) -- (*res)[count]= -- gsl_sf_legendre_Plm( lNow, mNow, xNow); -- else -- { -- mNow = -mNow; -- -- int addIx = lNow+mNow; -- DDouble mul = 1.0; -- DDouble dD = static_cast( lNow-mNow+1); -- for( int d=lNow-mNow+1; d<=addIx; ++d) -- { -- mul *= dD; -- dD += 1.0; -- } -- -- DDouble Pm = gsl_sf_legendre_Plm( lNow, mNow, xNow); -- if( mNow % 2 == 1) Pm = -Pm; -- -- (*res)[count] = Pm / mul; -- } -- } -- -- //convert things back -- if(xvals->Type() != GDL_DOUBLE && !e->KeywordSet("DOUBLE")) -- { -- return res->Convert2(GDL_FLOAT,BaseGDL::CONVERT); -- } -- else -- { -- return res; -- } -- } -- return new DByteGDL(0); -- } -- -- // Gamma, LnGamma, IGamma and Beta are now in math_fun_gm.cpp -- // I rewrite them because they had many bugs (gregory.marchal_at_obspm.fr) -- -- BaseGDL* gsl_exp(EnvT* e) -- { -- auto_ptr cdr_guard; -- auto_ptr cd_guard; -- auto_ptr d_guard; -- auto_ptr fr_guard; -- -- -- SizeT nParam = e->NParam(1); -- BaseGDL* v=e->GetParDefined(0); -- -- size_t nEl = v->N_Elements(); -- size_t i; -- if (v->Type() == GDL_STRING) { -- e->Throw( -- "String expression not allowed in this context: " -- +e->GetParString(0)); -- } else if (v->Type() == GDL_PTR) { -- e->Throw( -- "Pointer expression not allowed in this context: " -- +e->GetParString(0)); -- } else if (v->Type() == GDL_OBJ) { -- e->Throw( -- "Object expression not allowed in this context: " -- +e->GetParString(0)); -- } else if (v->Type() == GDL_STRUCT) { -- e->Throw( -- "Struct expression not allowed in this context: " -- +e->GetParString(0)); -- } else { -- // DDoubleGDL* d; -- DDoubleGDL* dr = new DDoubleGDL(v->Dim(), BaseGDL::NOZERO); -- // e->Guard( dr); -- -- if(v->Type() == GDL_COMPLEX) { -- DComplexDblGDL* cd= -- static_cast(v->Convert2(GDL_COMPLEXDBL, BaseGDL::COPY)); -- cd_guard.reset(cd);//e->Guard( cd); -- -- DComplexDblGDL* cdr = -- new DComplexDblGDL(v->Dim(), BaseGDL::NOZERO); -- cdr_guard.reset(cdr);//e->Guard( cdr); -- -- if(nEl == 1) -- (*cdr)[0]= -- DComplex((gsl_sf_exp((*cd)[0].real())*cos((*cd)[0].imag())), -- (gsl_sf_exp((*cd)[0].real())*sin((*cd)[0].imag()))); -- else -- for(i=0;i(cdr->Convert2(GDL_COMPLEX,BaseGDL::COPY)); -- -- } else if(v->Type() == GDL_COMPLEXDBL) { -- DComplexDblGDL* cd= -- static_cast(v->Convert2(GDL_COMPLEXDBL, BaseGDL::COPY)); -- cd_guard.reset(cd);//e->Guard( cd); -- -- DComplexDblGDL* cdr = -- new DComplexDblGDL(v->Dim(), BaseGDL::NOZERO); -- -- if(nEl == 1) -- (*cdr)[0]= -- DComplex((gsl_sf_exp((*cd)[0].real())*cos((*cd)[0].imag())), -- (gsl_sf_exp((*cd)[0].real())*sin((*cd)[0].imag()))); -- else -- for(i=0;iType() == GDL_DOUBLE) { -- -- DDoubleGDL* d=static_cast(v->Convert2(GDL_DOUBLE, -- BaseGDL::COPY)); -- d_guard.reset(d);//e->Guard( d); -- if(nEl == 1) -- (*dr)[0]=gsl_sf_exp((*d)[0]); -- else -- for (i=0;iType() == GDL_FLOAT || -- v->Type() == GDL_INT || -- v->Type() == GDL_LONG) { -- -- DFloatGDL *fr=new DFloatGDL(v->Dim(), BaseGDL::NOZERO); -- fr_guard.reset(fr);//e->Guard( fr); -- -- DDoubleGDL* d=static_cast(v->Convert2(GDL_DOUBLE, -- BaseGDL::COPY)); -- d_guard.reset(d);//e->Guard( d); -- -- if(nEl == 1) -- (*dr)[0]=gsl_sf_exp((*d)[0]); -- else -- for (i=0;i(dr->Convert2(GDL_FLOAT,BaseGDL::COPY)); -- } -- -- } -- } -- -- -- -- -- -- -- -- -- --} // namespace -+#endif -+ -+namespace lib { -+ -+ using namespace std; -+ using namespace antlr; -+ -+ BaseGDL* magick_exists(EnvT *e) -+ { -+#ifdef USE_MAGICK -+ return new DIntGDL(1); -+#else -+ return new DIntGDL(0); -+#endif -+ } -+ -+ BaseGDL* ncdf_exists(EnvT* e) -+ { -+#ifdef USE_NETCDF -+ return new DIntGDL(1); -+#else -+ return new DIntGDL(0); -+#endif -+ } -+ -+ double Gregorian2Julian(struct tm *ts) -+ { -+ double jd; -+ // SA: gives bad results, e.g.: -+ // IDL> print, systime(/julian), f='(G)' -+ // 2454995.131712963 -+ // GDL> print, systime(/julian), f='(G)' -+ // 2454994.527534722 -+ // -+ // jd = 367.0*(1900.+ts->tm_year) -+ // - (7.0*((1900.+ts->tm_year) + ((1+ts->tm_mon+9.0)/12.0))/4.0) -+ // + (275.0*(1+ts->tm_mon)/9.0)+ts->tm_mday -+ // + (ts->tm_hour + (ts->tm_min + ts->tm_sec/60.0)/60.0)/24.0 -+ // + 1721013.5; -+ // -+ // SA: an alterntive from the NOVAS library -+ // (http://aa.usno.navy.mil/software/novas/novas_c/novasc_info.php) -+ jd = ts->tm_mday - 32075L + 1461L * (ts->tm_year + 1900 + 4800L -+ + (1 + ts->tm_mon - 14L) / 12L) / 4L -+ + 367L * (1 + ts->tm_mon - 2L - (1 + ts->tm_mon - 14L) / 12L * 12L) -+ / 12L - 3L * ((1900 + ts->tm_year + 4900L + (1 + ts->tm_mon - 14L) / 12L) -+ / 100L) / 4L -+ + (ts->tm_hour + (ts->tm_min + ts->tm_sec/60.0)/60.0)/24.0 - .5; -+ // SA: end of modifications, the code below was here before -+ -+ if ((100.0*(1900.+ts->tm_year) + 1+ts->tm_mon - 190002.5) < 0) jd=jd+1.0; -+ -+ return jd; -+ -+ } -+ -+ BaseGDL* systime(EnvT* e) -+ { -+ struct timeval tval; -+ struct timezone tzone; -+ -+ /*get the time before doing anything else, -+ this hopefully gives a more meaningful "time" -+ than if the t=time(0) call came after an -+ arbitary number of conditional statements.*/ -+ // cout << "lib::systime: " << t << endl; -+ gettimeofday(&tval,&tzone); -+ double tt = tval.tv_sec+tval.tv_usec/1e+6; // time in UTC seconds -+ -+ SizeT nParam=e->NParam(0); //,"SYSTIME"); -+ bool ret_seconds=false; -+ -+ Guard v_guard; -+ Guard v1_guard; -+ -+ if (nParam == 1) { -+ //1 parameter, -+ // 1->current UTC time seconds -+ // default -+ DIntGDL* v = static_cast(e->GetParDefined(0)->Convert2(GDL_INT,BaseGDL::COPY)); -+ v_guard.Reset( v); // e->Guard(v); -+ -+ if ( (*v)[0] == 1) //->EqualNoDelete( static_cDIntGDL(1))) -+ ret_seconds=true; -+ } else if (nParam == 2) { -+ if (e->KeywordSet("JULIAN")) e->Throw("Conflicting keywords."); -+ -+ //2 parameters -+ //if the first param is 0, return the date of the second arg -+ //if the first param is 1, return the 'double' of the second arg -+ DIntGDL* v1 = static_cast(e->GetParDefined(0)->Convert2(GDL_INT,BaseGDL::COPY)); -+ v_guard.Reset( v1); // e->Guard(v1); -+ DDoubleGDL* v2 = static_cast(e->GetParDefined(1)->Convert2(GDL_DOUBLE,BaseGDL::COPY)); -+ -+ if( (*v1)[0] == 0) { //v1->EqualNoDelete( DIntGDL(0))) { //0, read the second argument as time_t; -+ tval.tv_sec = static_cast((*v2)[0]); -+ tval.tv_usec = static_cast(((*v2)[0]-tval.tv_sec)*1e+6); -+ delete v2; // we delete v2 here as it is not guarded. Avoids a "new" in the following "else" -+ } else { //1 -+ return v2; -+ } -+ } -+ -+ //return the variable in seconds, either JULIAN, JULIAN+UTC, -+ //or no other keywords -+ struct tm *tstruct; -+ if( ret_seconds || e->KeywordSet("SECONDS") ) -+ { -+ if( e->KeywordSet("JULIAN") ) -+ { -+ if( e->KeywordSet("UTC") ) -+ tstruct=gmtime((time_t *)&tval.tv_sec); -+ else -+ tstruct=localtime((time_t *)&tval.tv_sec); -+ -+ return new DDoubleGDL(Gregorian2Julian(tstruct)); -+ } -+ else -+ { -+ // does not (necessaryly) work: time might count backwards -+ //double tickTime = static_cast(t) + tt - floor( tt); -+ return new DDoubleGDL(static_cast(tt)); -+ } -+ } -+ -+ //return a string of the time, either UTC or local (default) -+ if(e->KeywordSet("UTC")) -+ tstruct= gmtime((time_t *)&tval.tv_sec); -+ else -+ tstruct= localtime((time_t *)&tval.tv_sec); -+ -+ //Convert the time to JULIAN or NOT -+ if(e->KeywordSet("JULIAN")) -+ return new DDoubleGDL(Gregorian2Julian(tstruct)); -+ else -+ { -+ char st[MAX_DATE_STRING_LENGTH]; -+// char *st=new char[MAX_DATE_STRING_LENGTH]; -+// ArrayGuard stGuard( st); -+ const char *format="%a %h %d %T %Y";//my IDL date format. -+ DStringGDL *S; -+ -+ SizeT res=strftime(st,MAX_DATE_STRING_LENGTH,format,tstruct); -+ -+ if(res != 0) -+ S=new DStringGDL(st); -+ else -+ S=new DStringGDL(""); -+ -+ //delete st; should have been delete[] -+ -+ return S; -+ } -+ } -+ -+ BaseGDL* legendre(EnvT* e) -+ { -+ Guard x_guard; -+ Guard l_guard; -+ Guard m_guard; -+ -+ SizeT nParam=e->NParam(2); //, "LEGENDRE"); -+ Guard guard; -+ int count; -+ -+ -+ BaseGDL* xvals,* lvals,* mvals; -+ -+ xvals= e->GetParDefined(0); //,"LEGENDRE"); -+ -+ SizeT nEx,nEl, nEm,nmin; -+ nEl=0; -+ nEm=0; -+ -+ -+ nEx=xvals->N_Elements(); -+ if(nEx == 0) -+ e->Throw( -+ "Variable is undefined: " -+ +e->GetParString(0)); -+ -+ lvals=e->GetParDefined(1); //,"LEGENDRE"); -+ nEl=lvals->N_Elements(); -+ if(nEl == 0) -+ e->Throw( -+ "Variable is undefined: " -+ +e->GetParString(1)); -+ -+ -+ if(nParam > 2) -+ { -+ mvals=e->GetParDefined(2); //,"LEGENDRE"); -+ nEm=mvals->N_Elements(); -+ } else { -+ mvals=new DIntGDL(0); -+ nEm=1; -+ guard.Reset(mvals); -+ } -+ -+ if(nEm == 0) -+ e->Throw( -+ "Variable is undefined: " -+ +e->GetParString(2)); -+ -+ -+ nmin=nEx; -+ if(nEl < nmin && nEl > 1) nmin=nEl; -+ if(nEm < nmin && nEm > 1) nmin=nEm; -+ -+ if (xvals->Type() == GDL_STRING) { -+ e->Throw( -+ "String expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else if (xvals->Type() == GDL_PTR) { -+ e->Throw( -+ "Pointer expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else if (xvals->Type() == GDL_OBJ) { -+ e->Throw( -+ "Object expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else if (xvals->Type() == GDL_STRUCT) { -+ e->Throw( -+ "Struct expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else if(xvals->Type() == GDL_COMPLEX || -+ xvals->Type() == GDL_COMPLEXDBL) { -+ e->Throw( -+ "Complex Legendre not implemented: "); -+ } else { -+ //byte, int, long float, double, uint, ulong, int64, uint64 -+ -+ DDoubleGDL* res; -+ DDoubleGDL* x_cast; -+ DIntGDL* l_cast,*m_cast; -+ -+ if(xvals->Type() == GDL_DOUBLE) -+ x_cast= static_cast(xvals); -+ else -+ { -+ x_cast= static_cast(xvals->Convert2(GDL_DOUBLE,BaseGDL::COPY)); -+ x_guard.Reset(x_cast);//e->Guard( x_cast); -+ } -+ -+ //lval check -+ if (lvals->Type() == GDL_STRING) -+ e->Throw( -+ "String expression not allowed in this context: " -+ +e->GetParString(1)); -+ else if (lvals->Type() == GDL_PTR) -+ e->Throw( -+ "Pointer expression not allowed in this context: " -+ +e->GetParString(1)); -+ else if (lvals->Type() == GDL_OBJ) -+ e->Throw( -+ "Object expression not allowed in this context: " -+ +e->GetParString(1)); -+ else if (lvals->Type() == GDL_STRUCT) -+ e->Throw( -+ "Struct expression not allowed in this context: " -+ +e->GetParString(1)); -+ else if(lvals->Type() == GDL_COMPLEX || -+ lvals->Type() == GDL_COMPLEXDBL) -+ e->Throw( -+ "Complex Legendre not implemented: "); -+ else if(lvals->Type() == GDL_INT) -+ l_cast=static_cast(lvals); -+ else -+ { -+ l_cast=static_cast(lvals->Convert2(GDL_INT,BaseGDL::COPY)); -+ l_guard.Reset(l_cast);//e->Guard( l_cast); -+ } -+ -+ //mval check -+ if (mvals->Type() == GDL_STRING) -+ e->Throw( -+ "String expression not allowed in this context: " -+ +e->GetParString(2)); -+ else if (mvals->Type() == GDL_PTR) -+ e->Throw( -+ "Pointer expression not allowed in this context: " -+ +e->GetParString(2)); -+ else if (mvals->Type() == GDL_OBJ) -+ e->Throw( -+ "Object expression not allowed in this context: " -+ +e->GetParString(2)); -+ else if (mvals->Type() == GDL_STRUCT) -+ e->Throw( -+ "Struct expression not allowed in this context: " -+ +e->GetParString(2)); -+ else if(mvals->Type() == GDL_COMPLEX || -+ mvals->Type() == GDL_COMPLEXDBL) -+ e->Throw( -+ "Complex Legendre not implemented: "); -+ else if(mvals->Type() == GDL_INT) -+ m_cast=static_cast(mvals); -+ else -+ { -+ m_cast=static_cast(mvals->Convert2(GDL_INT,BaseGDL::COPY)); -+ //e->Guard( m_cast); -+ m_guard.Reset(m_cast); -+ } -+ -+ //x,m,l are converted to the correct format (double, int, int) here -+ -+ -+ //make the result array have the same size as the smallest x,m,l array -+ if(nmin == nEx) res=new DDoubleGDL(xvals->Dim(),BaseGDL::NOZERO); -+ else if(nmin == nEl) res=new DDoubleGDL(lvals->Dim(),BaseGDL::NOZERO); -+ else if(nmin == nEm) res=new DDoubleGDL(mvals->Dim(),BaseGDL::NOZERO); -+ -+ for (count=0;count nEx?0:count]; -+ DInt lNow = (*l_cast)[nmin > nEl?0:count]; -+ DInt mNow = (*m_cast)[nmin > nEm?0:count]; -+ -+ if( xNow < -1.0 || xNow > 1.0) -+ e->Throw( "Argument X must be in the range [-1.0, 1.0]"); -+ if( lNow < 0) -+ e->Throw( "Argument L must be greater than or equal to zero."); -+ if( mNow < -lNow || mNow > lNow) -+ e->Throw( "Argument M must be in the range [-L, L]."); -+ -+ if( mNow >= 0) -+ (*res)[count]= -+ gsl_sf_legendre_Plm( lNow, mNow, xNow); -+ else -+ { -+ mNow = -mNow; -+ -+ int addIx = lNow+mNow; -+ DDouble mul = 1.0; -+ DDouble dD = static_cast( lNow-mNow+1); -+ for( int d=lNow-mNow+1; d<=addIx; ++d) -+ { -+ mul *= dD; -+ dD += 1.0; -+ } -+ -+ DDouble Pm = gsl_sf_legendre_Plm( lNow, mNow, xNow); -+ if( mNow % 2 == 1) Pm = -Pm; -+ -+ (*res)[count] = Pm / mul; -+ } -+ } -+ -+ //convert things back -+ if(xvals->Type() != GDL_DOUBLE && !e->KeywordSet("DOUBLE")) -+ { -+ return res->Convert2(GDL_FLOAT,BaseGDL::CONVERT); -+ } -+ else -+ { -+ return res; -+ } -+ } -+ return new DByteGDL(0); -+ } -+ -+ // Gamma, LnGamma, IGamma and Beta are now in math_fun_gm.cpp -+ // I rewrite them because they had many bugs (gregory.marchal_at_obspm.fr) -+ -+ BaseGDL* gsl_exp(EnvT* e) -+ { -+ Guard cdr_guard; -+ Guard cd_guard; -+ Guard d_guard; -+ Guard fr_guard; -+ -+ -+ SizeT nParam = e->NParam(1); -+ BaseGDL* v=e->GetParDefined(0); -+ -+ size_t nEl = v->N_Elements(); -+ size_t i; -+ if (v->Type() == GDL_STRING) { -+ e->Throw( -+ "String expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else if (v->Type() == GDL_PTR) { -+ e->Throw( -+ "Pointer expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else if (v->Type() == GDL_OBJ) { -+ e->Throw( -+ "Object expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else if (v->Type() == GDL_STRUCT) { -+ e->Throw( -+ "Struct expression not allowed in this context: " -+ +e->GetParString(0)); -+ } else { -+ // DDoubleGDL* d; -+ DDoubleGDL* dr = new DDoubleGDL(v->Dim(), BaseGDL::NOZERO); -+ // e->Guard( dr); -+ -+ if(v->Type() == GDL_COMPLEX) { -+ DComplexDblGDL* cd= -+ static_cast(v->Convert2(GDL_COMPLEXDBL, BaseGDL::COPY)); -+ cd_guard.Reset(cd);//e->Guard( cd); -+ -+ DComplexDblGDL* cdr = -+ new DComplexDblGDL(v->Dim(), BaseGDL::NOZERO); -+ cdr_guard.Reset(cdr);//e->Guard( cdr); -+ -+ if(nEl == 1) -+ (*cdr)[0]= -+ DComplex((gsl_sf_exp((*cd)[0].real())*cos((*cd)[0].imag())), -+ (gsl_sf_exp((*cd)[0].real())*sin((*cd)[0].imag()))); -+ else -+ for(i=0;i(cdr->Convert2(GDL_COMPLEX,BaseGDL::COPY)); -+ -+ } else if(v->Type() == GDL_COMPLEXDBL) { -+ DComplexDblGDL* cd= -+ static_cast(v->Convert2(GDL_COMPLEXDBL, BaseGDL::COPY)); -+ cd_guard.Reset(cd);//e->Guard( cd); -+ -+ DComplexDblGDL* cdr = -+ new DComplexDblGDL(v->Dim(), BaseGDL::NOZERO); -+ -+ if(nEl == 1) -+ (*cdr)[0]= -+ DComplex((gsl_sf_exp((*cd)[0].real())*cos((*cd)[0].imag())), -+ (gsl_sf_exp((*cd)[0].real())*sin((*cd)[0].imag()))); -+ else -+ for(i=0;iType() == GDL_DOUBLE) { -+ -+ DDoubleGDL* d=static_cast(v->Convert2(GDL_DOUBLE, -+ BaseGDL::COPY)); -+ d_guard.Reset(d);//e->Guard( d); -+ if(nEl == 1) -+ (*dr)[0]=gsl_sf_exp((*d)[0]); -+ else -+ for (i=0;iType() == GDL_FLOAT || -+ v->Type() == GDL_INT || -+ v->Type() == GDL_LONG) { -+ -+ DFloatGDL *fr=new DFloatGDL(v->Dim(), BaseGDL::NOZERO); -+ fr_guard.Reset(fr);//e->Guard( fr); -+ -+ DDoubleGDL* d=static_cast(v->Convert2(GDL_DOUBLE, -+ BaseGDL::COPY)); -+ d_guard.Reset(d);//e->Guard( d); -+ -+ if(nEl == 1) -+ (*dr)[0]=gsl_sf_exp((*d)[0]); -+ else -+ for (i=0;i(dr->Convert2(GDL_FLOAT,BaseGDL::COPY)); -+ } -+ -+ } -+ } -+ -+ -+ -+ -+ -+ -+ -+ -+ -+} // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_fun.cpp gdl/src/basic_fun.cpp ---- gdl-0.9.3/src/basic_fun.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_fun.cpp 2013-07-31 09:41:43.699246534 -0600 -@@ -1,6657 +1,6777 @@ --/*************************************************************************** -- basic_fun.cpp - basic GDL library function -- ------------------- -- begin : July 22 2002 -- copyright : (C) 2002 by Marc Schellens (exceptions see below) -- email : m_schellens@users.sf.net -- -- strtok_fun, getenv_fun, tag_names_fun, stregex_fun: -- (C) 2004 by Peter Messmer -- --***************************************************************************/ -- --/*************************************************************************** -- * * -- * This program is free software; you can redistribute it and/or modify * -- * it under the terms of the GNU General Public License as published by * -- * the Free Software Foundation; either version 2 of the License, or * -- * (at your option) any later version. * -- * * -- ***************************************************************************/ -- --#include "includefirst.hpp" -- --// get_kbrd patch --// http://sourceforge.net/forum/forum.php?thread_id=3292183&forum_id=338691 --#ifndef _MSC_VER --#include --#include --#endif --#include --#include --#include --//#include --#include // stregex -- --#ifdef __APPLE__ --# include --# define environ (*_NSGetEnviron()) --#endif -- --#if defined(__FreeBSD__) || defined(__sun__) || defined(__OpenBSD__) --extern "C" char **environ; --#endif -- --#include "nullgdl.hpp" --#include "datatypes.hpp" --#include "envt.hpp" --#include "dpro.hpp" --#include "dinterpreter.hpp" --#include "basic_pro.hpp" --#include "terminfo.hpp" --#include "typedefs.hpp" --#include "base64.hpp" -- --#ifdef HAVE_LOCALE_H --# include --#endif -- --/* max regexp error message length */ --#define MAX_REGEXPERR_LENGTH 80 -- --#ifdef _MSC_VER --#define isfinite _finite --#define isnan _isnan --#define round(f) floor(f+0.5) --int strncasecmp(const char *s1, const char *s2, size_t n) --{ -- if (n == 0) -- return 0; -- while (n-- != 0 && tolower(*s1) == tolower(*s2)) -- { -- if (n == 0 || *s1 == '\0' || *s2 == '\0') -- break; -- s1++; -- s2++; -- } -- -- return tolower(*(unsigned char *) s1) - tolower(*(unsigned char *) s2); --} --#else --#include --#endif -- --namespace lib { -- -- using namespace std; -- using namespace antlr; -- -- // assumes all parameters from pOffs till end are dim -- void arr( EnvT* e, dimension& dim, SizeT pOffs=0) -- { -- -- int nParam=e->NParam()-pOffs; -- -- if( nParam <= 0) -- e->Throw( "Incorrect number of arguments."); -- -- const string BadDims="Array dimensions must be greater than 0."; -- -- -- if( nParam == 1 ) { -- -- BaseGDL* par = e->GetParDefined( pOffs); -- -- SizeT newDim; -- int ret = par->Scalar2index( newDim); -- -- if (ret < 0) throw GDLException(BadDims); -- -- if( ret > 0) { // single argument -- if (newDim < 1) throw GDLException(BadDims); -- dim << newDim; -- return; -- } -- if( ret == 0) { // array argument -- DLongGDL* ind = -- static_cast(par->Convert2(GDL_LONG, BaseGDL::COPY)); -- auto_ptr ind_guard( ind); -- //e->Guard( ind); -- -- for(SizeT i =0; i < par->N_Elements(); ++i){ -- if ((*ind)[i] < 1) throw GDLException(BadDims); -- dim << (*ind)[i]; -- } -- return; -- } -- e->Throw( "arr: should never arrive here."); -- return; -- } -- -- // max number checked in interpreter -- SizeT endIx=nParam+pOffs; -- for( SizeT i=pOffs; iGetParDefined( i); -- -- SizeT newDim; -- int ret=par->Scalar2index( newDim); -- if( ret < 1 || newDim == 0) throw GDLException(BadDims); -- dim << newDim; -- } -- } -- -- BaseGDL* bytarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DByteGDL(dim, BaseGDL::NOZERO); -- return new DByteGDL(dim); -- // } -- // catch( GDLException& ex) -- // { --// e->Throw( ex.getMessage()); --// } -- } -- BaseGDL* intarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DIntGDL(dim, BaseGDL::NOZERO); -- return new DIntGDL(dim); --// } --// catch( GDLException& ex) --// { --// e->Throw( "INTARR: "+ex.getMessage()); --// } -- } -- BaseGDL* uintarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DUIntGDL(dim, BaseGDL::NOZERO); -- return new DUIntGDL(dim); --// } --// catch( GDLException& ex) --// { --// e->Throw( "UINTARR: "+ex.getMessage()); --// } -- } -- BaseGDL* lonarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DLongGDL(dim, BaseGDL::NOZERO); -- return new DLongGDL(dim); --/* } -- catch( GDLException& ex) -- { -- e->Throw( "LONARR: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* ulonarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DULongGDL(dim, BaseGDL::NOZERO); -- return new DULongGDL(dim); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "ULONARR: "+ex.getMessage()); -- } -- */ --} -- BaseGDL* lon64arr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DLong64GDL(dim, BaseGDL::NOZERO); -- return new DLong64GDL(dim); --/* } -- catch( GDLException& ex) -- { -- e->Throw( "LON64ARR: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* ulon64arr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DULong64GDL(dim, BaseGDL::NOZERO); -- return new DULong64GDL(dim); --/* } -- catch( GDLException& ex) -- { -- e->Throw( "ULON64ARR: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* fltarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DFloatGDL(dim, BaseGDL::NOZERO); -- return new DFloatGDL(dim); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "FLTARR: "+ex.getMessage()); -- } -- */} -- BaseGDL* dblarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DDoubleGDL(dim, BaseGDL::NOZERO); -- return new DDoubleGDL(dim); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "DBLARR: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* strarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) -- e->Throw( "Keyword parameters not allowed in call."); -- return new DStringGDL(dim); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "STRARR: "+ex.getMessage()); -- } -- */ } -- BaseGDL* complexarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- if( e->KeywordSet(0)) return new DComplexGDL(dim, BaseGDL::NOZERO); -- return new DComplexGDL(dim); -- /*} -- catch( GDLException& ex) -- { -- e->Throw( "COMPLEXARR: "+ex.getMessage()); -- } -- */ } -- BaseGDL* dcomplexarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- -- if( e->KeywordSet(0)) return new DComplexDblGDL(dim, BaseGDL::NOZERO); -- return new DComplexDblGDL(dim); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "DCOMPLEXARR: "+ex.getMessage()); -- } -- */ } -- BaseGDL* ptrarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- DPtrGDL* ret; -- --// if( e->KeywordSet(0)) --// ret= new DPtrGDL(dim);//, BaseGDL::NOZERO); --// else --// if( e->KeywordSet(1)) --// ret= new DPtrGDL(dim, BaseGDL::NOZERO); --// else --// return new DPtrGDL(dim); -- if( !e->KeywordSet(1)) -- return new DPtrGDL(dim); -- -- ret= new DPtrGDL(dim, BaseGDL::NOZERO); -- -- SizeT nEl=ret->N_Elements(); -- SizeT sIx=e->NewHeap(nEl); --// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) --{ --// #pragma omp for -- for( SizeT i=0; iThrow( "PTRARR: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* objarr( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- --// reference counting if( e->KeywordSet(0)) return new DObjGDL(dim, BaseGDL::NOZERO); -- return new DObjGDL(dim); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "OBJARR: "+ex.getMessage()); -- } -- */ } -- -- BaseGDL* ptr_new( EnvT* e) -- { -- int nParam=e->NParam(); -- -- if( nParam > 0) -- { -- // new ptr from undefined variable is allowed as well -- BaseGDL* p= e->GetPar( 0); -- if( p == NULL) -- { -- DPtr heapID= e->NewHeap(); -- return new DPtrGDL( heapID); -- } -- -- if( e->KeywordSet(0)) // NO_COPY -- { -- BaseGDL** p= &e->GetPar( 0); -- // if( *p == NULL) -- // e->Throw( "Parameter undefined: "+ -- // e->GetParString(0)); -- -- DPtr heapID= e->NewHeap( 1, *p); -- *p=NULL; -- return new DPtrGDL( heapID); -- } -- else -- { -- BaseGDL* p= e->GetParDefined( 0); -- -- DPtr heapID= e->NewHeap( 1, p->Dup()); -- return new DPtrGDL( heapID); -- } -- } -- else -- { -- if( e->KeywordSet(1)) // ALLOCATE_HEAP -- { -- DPtr heapID= e->NewHeap(); -- return new DPtrGDL( heapID); -- } -- else -- { -- return new DPtrGDL( 0); // null ptr -- } -- } -- } -- -- BaseGDL* ptr_valid( EnvT* e) -- { -- int nParam=e->NParam(); -- -- if( e->KeywordPresent( 1)) // COUNT -- { -- e->SetKW( 1, new DLongGDL( e->Interpreter()->HeapSize())); -- } -- -- if( nParam == 0) -- { -- return e->Interpreter()->GetAllHeap(); -- } -- -- BaseGDL* p = e->GetPar( 0); -- if( p == NULL) -- { -- return new DByteGDL( 0); -- } -- -- if( e->KeywordSet( 0)) // CAST -- { -- DLongGDL* pL = dynamic_cast( p); -- auto_ptr pL_guard; -- if( pL == NULL) -- { -- pL = static_cast(p->Convert2(GDL_LONG,BaseGDL::COPY)); -- pL_guard.reset( pL); -- } -- -- SizeT nEl = pL->N_Elements(); -- DPtrGDL* ret = new DPtrGDL( pL->Dim()); // zero -- GDLInterpreter* interpreter = e->Interpreter(); -- for( SizeT i=0; iPtrValid( (*pL)[ i])) -- (*ret)[ i] = (*pL)[ i]; -- } -- return ret; -- } -- -- DPtrGDL* pPtr = dynamic_cast( p); -- if( pPtr == NULL) -- { -- return new DByteGDL( p->Dim()); // zero -- } -- -- SizeT nEl = pPtr->N_Elements(); -- DByteGDL* ret = new DByteGDL( pPtr->Dim()); // zero -- GDLInterpreter* interpreter = e->Interpreter(); -- for( SizeT i=0; iPtrValid( (*pPtr)[ i])) -- (*ret)[ i] = 1; -- } -- return ret; -- } -- -- BaseGDL* obj_valid( EnvT* e) -- { -- int nParam=e->NParam(); -- -- if( e->KeywordPresent( 1)) // COUNT -- { -- e->SetKW( 1, new DLongGDL( e->Interpreter()->ObjHeapSize())); -- } -- -- if( nParam == 0) -- { -- return e->Interpreter()->GetAllObjHeap(); -- } -- -- BaseGDL* p = e->GetPar( 0); -- if( p == NULL) -- { -- return new DByteGDL( 0); -- } -- -- if( e->KeywordSet( 0)) // CAST -- { -- DLongGDL* pL = dynamic_cast( p); -- auto_ptr pL_guard; -- if( pL == NULL) -- { -- pL = static_cast(p->Convert2(GDL_LONG,BaseGDL::COPY)); -- pL_guard.reset( pL); -- // e->Guard( pL); -- } -- -- SizeT nEl = pL->N_Elements(); -- DObjGDL* ret = new DObjGDL( pL->Dim()); // zero -- GDLInterpreter* interpreter = e->Interpreter(); -- for( SizeT i=0; iObjValid( (*pL)[ i])) -- (*ret)[ i] = (*pL)[ i]; -- } -- return ret; -- } -- -- DObjGDL* pObj = dynamic_cast( p); -- if( pObj == NULL) -- { -- return new DByteGDL( p->Dim()); // zero -- } -- -- SizeT nEl = pObj->N_Elements(); -- DByteGDL* ret = new DByteGDL( pObj->Dim()); // zero -- GDLInterpreter* interpreter = e->Interpreter(); -- for( SizeT i=0; iObjValid( (*pObj)[ i])) -- (*ret)[ i] = 1; -- } -- return ret; -- } -- -- BaseGDL* obj_new( EnvT* e) -- { -- StackGuard guard( e->Interpreter()->CallStack()); -- -- int nParam=e->NParam(); -- -- if( nParam == 0) -- { -- return new DObjGDL( 0); -- } -- -- DString objName; -- e->AssureScalarPar( 0, objName); -- -- // this is a struct name -> convert to UPPERCASE -- objName=StrUpCase(objName); -- if( objName == "IDL_OBJECT") -- objName = GDL_OBJECT_NAME; // replacement also done in GDLParser -- -- DStructDesc* objDesc=e->Interpreter()->GetStruct( objName, e->CallingNode()); -- -- DStructGDL* objStruct= new DStructGDL( objDesc, dimension()); -- -- DObj objID= e->NewObjHeap( 1, objStruct); // owns objStruct -- -- BaseGDL* newObj = new DObjGDL( objID); // the object -- -- try { -- // call INIT function -- DFun* objINIT= objDesc->GetFun( "INIT"); -- if( objINIT != NULL) -- { -- // morph to obj environment and push it onto the stack again -- e->PushNewEnvUD( objINIT, 1, &newObj); -- -- BaseGDL* res=e->Interpreter()->call_fun( objINIT->GetTree()); -- -- if( res == NULL || (!res->Scalar()) || res->False()) -- { -- GDLDelete(res); -- return new DObjGDL( 0); -- } -- GDLDelete(res); -- } -- } catch(...) { -- e->FreeObjHeap( objID); // newObj might be changed -- GDLDelete(newObj); -- throw; -- } -- -- return newObj; -- } -- -- BaseGDL* bindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DByteGDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "BINDGEN: "+ex.getMessage()); -- } -- */ } -- // keywords not supported yet -- BaseGDL* indgen( EnvT* e) -- { -- dimension dim; -- -- // Defaulting to GDL_INT -- DType type = GDL_INT; -- -- static int kwIx1 = e->KeywordIx("BYTE"); -- if (e->KeywordSet(kwIx1)){ type = GDL_BYTE; } -- -- static int kwIx2 = e->KeywordIx("COMPLEX"); -- if (e->KeywordSet(kwIx2)){ type = GDL_COMPLEX; } -- -- static int kwIx3 = e->KeywordIx("DCOMPLEX"); -- if (e->KeywordSet(kwIx3)){ type = GDL_COMPLEXDBL; } -- -- static int kwIx4 = e->KeywordIx("DOUBLE"); -- if (e->KeywordSet(kwIx4)){ type = GDL_DOUBLE; } -- -- static int kwIx5 = e->KeywordIx("FLOAT"); -- if (e->KeywordSet(kwIx5)){ type = GDL_FLOAT; } -- -- static int kwIx6 = e->KeywordIx("L64"); -- if (e->KeywordSet(kwIx6)){ type = GDL_LONG64; } -- -- static int kwIx7 = e->KeywordIx("LONG"); -- if (e->KeywordSet(kwIx7)){ type = GDL_LONG; } -- -- static int kwIx8 = e->KeywordIx("STRING"); -- if (e->KeywordSet(kwIx8)){ type = GDL_STRING; } -- -- static int kwIx9 = e->KeywordIx("UINT"); -- if (e->KeywordSet(kwIx9)){ type = GDL_UINT; } -- -- static int kwIx10 = e->KeywordIx("UL64"); -- if (e->KeywordSet(kwIx10)){ type = GDL_ULONG64; } -- -- static int kwIx11 = e->KeywordIx("ULONG"); -- if (e->KeywordSet(kwIx11)){ type = GDL_ULONG; } -- -- /*try -- {*/ -- // Seeing if the user passed in a TYPE code -- static int kwIx12 = e->KeywordIx("TYPE"); -- if ( e->KeywordPresent(kwIx12)){ -- DLong temp_long; -- e->AssureLongScalarKW(kwIx12, temp_long); -- type = static_cast(temp_long); -- } -- -- arr(e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- switch(type) -- { -- case GDL_INT: return new DIntGDL(dim, BaseGDL::INDGEN); -- case GDL_BYTE: return new DByteGDL(dim, BaseGDL::INDGEN); -- case GDL_COMPLEX: return new DComplexGDL(dim, BaseGDL::INDGEN); -- case GDL_COMPLEXDBL: return new DComplexDblGDL(dim, BaseGDL::INDGEN); -- case GDL_DOUBLE: return new DDoubleGDL(dim, BaseGDL::INDGEN); -- case GDL_FLOAT: return new DFloatGDL(dim, BaseGDL::INDGEN); -- case GDL_LONG64: return new DLong64GDL(dim, BaseGDL::INDGEN); -- case GDL_LONG: return new DLongGDL(dim, BaseGDL::INDGEN); -- case GDL_STRING: { -- DULongGDL* iGen = new DULongGDL(dim, BaseGDL::INDGEN); -- return iGen->Convert2(GDL_STRING); -- } -- case GDL_UINT: return new DUIntGDL(dim, BaseGDL::INDGEN); -- case GDL_ULONG64: return new DULong64GDL(dim, BaseGDL::INDGEN); -- case GDL_ULONG: return new DULongGDL(dim, BaseGDL::INDGEN); -- default: -- e->Throw( "Invalid type code specified."); -- break; -- } --/* } -- catch( GDLException& ex) -- { -- e->Throw( ex.getMessage()); -- }*/ -- } -- -- BaseGDL* uindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DUIntGDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "UINDGEN: "+ex.getMessage()); -- } -- */ } -- BaseGDL* sindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- DULongGDL* iGen = new DULongGDL(dim, BaseGDL::INDGEN); -- return iGen->Convert2( GDL_STRING); --/* } -- catch( GDLException& ex) -- { -- e->Throw( "SINDGEN: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* lindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- return new DLongGDL(dim, BaseGDL::INDGEN); --/* } -- catch( GDLException& ex) -- { -- e->Throw( "LINDGEN: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* ulindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DULongGDL(dim, BaseGDL::INDGEN); --/* } -- catch( GDLException& ex) -- { -- e->Throw( "ULINDGEN: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* l64indgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DLong64GDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "L64INDGEN: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* ul64indgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DULong64GDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "UL64INDGEN: "+ex.getMessage()); -- } -- */ } -- BaseGDL* findgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DFloatGDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "FINDGEN: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* dindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DDoubleGDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "DINDGEN: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* cindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DComplexGDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "CINDGEN: "+ex.getMessage()); -- }*/ -- } -- BaseGDL* dcindgen( EnvT* e) -- { -- dimension dim; --// try{ -- arr( e, dim); -- if (dim[0] == 0) -- throw GDLException( "Array dimensions must be greater than 0"); -- -- return new DComplexDblGDL(dim, BaseGDL::INDGEN); -- /* } -- catch( GDLException& ex) -- { -- e->Throw( "DCINDGEN: "+ex.getMessage()); -- } -- */ } -- -- // only called from CALL_FUNCTION -- // otherwise done directly in FCALL_LIB_N_ELEMENTSNode::Eval(); -- // (but must be defined anyway for LibInit() for correct parametrization) -- // N_ELEMENTS is special because on error it just returns 0L -- // (the error is just caught and dropped) -- BaseGDL* n_elements( EnvT* e) -- { -- SizeT nParam=e->NParam(1); -- -- BaseGDL* p0=e->GetPar( 0); -- -- if( p0 == NULL) return new DLongGDL( 0); -- return new DLongGDL( p0->N_Elements()); -- --// assert( 0); --// e->Throw("Internal error: lib::n_elements called."); --// return NULL; // get rid of compiler warning -- } -- -- template< typename ComplexGDL, typename Complex, typename Float> -- BaseGDL* complex_fun_template( EnvT* e) -- { -- SizeT nParam=e->NParam( 1); -- if( nParam <= 2) -- { -- if( nParam == 2) -- { -- BaseGDL* p0=e->GetParDefined( 0); -- BaseGDL* p1=e->GetParDefined( 1); -- auto_ptr p0Float( static_cast -- (p0->Convert2( Float::t,BaseGDL::COPY))); -- auto_ptr p1Float( static_cast -- (p1->Convert2( Float::t,BaseGDL::COPY))); -- if( p0Float->Rank() == 0) -- { -- ComplexGDL* res = new ComplexGDL( p1Float->Dim(), -- BaseGDL::NOZERO); -- -- SizeT nE=p1Float->N_Elements(); --// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) --{ --// #pragma omp for -- for( SizeT i=0; iRank() == 0) -- { -- ComplexGDL* res = new ComplexGDL( p0Float->Dim(), -- BaseGDL::NOZERO); -- -- SizeT nE=p0Float->N_Elements(); --// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) --{ --// #pragma omp for -- for( SizeT i=0; iN_Elements() >= p1Float->N_Elements()) -- { -- ComplexGDL* res = new ComplexGDL( p1Float->Dim(), -- BaseGDL::NOZERO); -- -- SizeT nE=p1Float->N_Elements(); --// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) --{ --// #pragma omp for -- for( SizeT i=0; iDim(), -- BaseGDL::NOZERO); -- -- SizeT nE=p0Float->N_Elements(); --// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) --{ --// #pragma omp for -- for( SizeT i=0; iGetParDefined( 0); -- if (ComplexGDL::t == p0->Type() && e->GlobalPar(0)) return p0; -- return p0->Convert2( ComplexGDL::t, BaseGDL::COPY); -- } -- } -- else // GDL_COMPLEX( expr, offs, dim1,..,dim8) -- { -- BaseGDL* p0 = e->GetParDefined( 0); -- // *** WRONG: with offs data is converted bytewise -- auto_ptr p0Float(static_cast -- (p0->Convert2( Float::t, -- BaseGDL::COPY))); -- DLong offs; -- e->AssureLongScalarPar( 1, offs); -- -- dimension dim; -- arr( e, dim, 2); -- -- SizeT nElCreate=dim.NDimElements(); -- -- SizeT nElSource=p0->N_Elements(); -- -- if( (offs+2*nElCreate) > nElSource) -- e->Throw( "Specified offset to" -- " array is out of range: "+e->GetParString(0)); -- -- ComplexGDL* res=new ComplexGDL( dim, BaseGDL::NOZERO); -- --// #pragma omp parallel if (nElCreate >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nElCreate)) --{ --// #pragma omp for -- for( SizeT i=0; iKeywordSet("DOUBLE")) { -- return complex_fun_template< DComplexDblGDL, DComplexDbl, DDoubleGDL>( e); -- } else { -- return complex_fun_template< DComplexGDL, DComplex, DFloatGDL>( e); -- } --} --BaseGDL* dcomplex_fun( EnvT* e) --{ -- return complex_fun_template< DComplexDblGDL, DComplexDbl, DDoubleGDL>( e); --} -- -- template< class TargetClass> -- BaseGDL* type_fun( EnvT* e) -- { -- SizeT nParam=e->NParam(1); -- -- if( nParam == 1) -- { -- BaseGDL* p0=e->GetParDefined( 0); -- -- assert( dynamic_cast< EnvUDT*>( e->Caller()) != NULL); -- -- // type_fun( expr) just convert -- if( static_cast< EnvUDT*>( e->Caller())->GetIOError() != NULL) -- return p0->Convert2( TargetClass::t, -- BaseGDL::COPY_THROWIOERROR); -- // SA: see tracker item no. 3151760 -- else if (TargetClass::t == p0->Type() && e->GlobalPar(0)) -- return p0; -- else -- return p0->Convert2( TargetClass::t, BaseGDL::COPY); -- } -- -- BaseGDL* p0=e->GetNumericParDefined( 0); -- -- // GDL_BYTE( expr, offs, dim1,..,dim8) -- DLong offs; -- e->AssureLongScalarPar( 1, offs); -- -- dimension dim; -- -- if( nParam > 2) -- arr( e, dim, 2); -- -- TargetClass* res=new TargetClass( dim, BaseGDL::NOZERO); -- -- SizeT nByteCreate=res->NBytes(); // net size of new data -- -- SizeT nByteSource=p0->NBytes(); // net size of src -- -- if( offs < 0 || (offs+nByteCreate) > nByteSource) -- { -- GDLDelete(res); -- e->Throw( "Specified offset to" -- " expression is out of range: "+e->GetParString(0)); -- } -- -- //*** POSSIBLE ERROR because of alignment here -- void* srcAddr = static_cast( static_cast(p0->DataAddr()) + -- offs); -- void* dstAddr = static_cast(&(*res)[0]); -- memcpy( dstAddr, srcAddr, nByteCreate); -- -- // char* srcAddr = reinterpret_cast(p0->DataAddr()); -- // char* dstAddr = reinterpret_cast(&(*res)[0]); -- // copy( srcAddr, srcAddr+nByteCreate, dstAddr); -- -- return res; -- } -- -- BaseGDL* byte_fun( EnvT* e) -- { -- return type_fun( e); -- } -- BaseGDL* uint_fun( EnvT* e) -- { -- return type_fun( e); -- } -- BaseGDL* long_fun( EnvT* e) -- { -- return type_fun( e); -- } -- BaseGDL* ulong_fun( EnvT* e) -- { -- return type_fun( e); -- } -- BaseGDL* long64_fun( EnvT* e) -- { -- return type_fun( e); -- } -- BaseGDL* ulong64_fun( EnvT* e) -- { -- return type_fun( e); -- } -- BaseGDL* float_fun( EnvT* e) -- { -- return type_fun( e); -- } -- BaseGDL* double_fun( EnvT* e) -- { -- return type_fun( e); -- } -- // GDL_STRING function behaves different -- BaseGDL* string_fun( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- -- if( nParam == 0) -- e->Throw( "Incorrect number of arguments."); -- -- bool printKey = e->KeywordSet( 4); -- int parOffset = 0; -- -- // SA: handling special VMS-compatibility syntax, e.g.: string(1,'$(F)') -- // (if nor FORMAT neither PRINT defined, >1 parameter, last param is scalar string -- // which begins with "$(" or "(" but is not "()" then last param [minus "$"] is treated as FORMAT) -- bool vmshack = false; -- if (!printKey && (e->GetKW(0) == NULL) && nParam > 1) -- { -- vmshack = true; -- BaseGDL* par = e->GetParDefined(nParam - 1); -- if (par->Type() == GDL_STRING && par->Scalar()) -- { -- int dollar = (*static_cast(par))[0].compare(0,2,"$("); -- if (dollar == 0 || ((*static_cast(par))[0].compare(0,1,"(") == 0 && (*static_cast(par))[0] != "()")) -- { -- e->SetKeyword("FORMAT", new DStringGDL( -- (*static_cast(par))[0].c_str() + (dollar == 0 ? 1 : 0) -- )); -- } -- } -- } -- -- BaseGDL* format_kw = e->GetKW( 0); -- bool formatKey = format_kw != NULL; -- -- if (formatKey && format_kw->Type() == GDL_STRING && (*static_cast(format_kw))[0] == "") formatKey = false; -- -- if( printKey || formatKey) // PRINT or FORMAT -- { -- stringstream os; -- -- SizeT width = 0; -- if( printKey) // otherwise: FORMAT -> width is ignored -- { -- // for /PRINT always a terminal width of 80 is assumed -- width = 80;//TermWidth(); -- } -- -- if (vmshack) -- { -- parOffset = 1; -- e->ShiftParNumbering(1); -- } -- print_os( &os, e, parOffset, width); -- if (vmshack) -- { -- e->ShiftParNumbering(-1); -- } -- -- deque buf; -- while( os.good()) -- { -- string line; -- getline( os, line); -- if( os.good()) buf.push_back( line); -- } -- -- SizeT bufSize = buf.size(); -- if( bufSize == 0) -- e->Throw( "Internal error: print buffer empty."); -- -- if( bufSize > 1) -- { -- DStringGDL* retVal = -- new DStringGDL( dimension( bufSize), BaseGDL::NOZERO); -- -- for( SizeT i=0; i conversion -- { -- BaseGDL* p0 = e->GetParDefined( 0); -- // SA: see tracker item no. 3151760 -- if (p0->Type() == GDL_STRING && e->GlobalPar(0)) return p0; -- return p0->Convert2( GDL_STRING, BaseGDL::COPY); -- } -- else // concatenation -- { -- DString s; -- for( SizeT i=0; iGetParDefined( i); -- DStringGDL* sP = static_cast -- ( p->Convert2(GDL_STRING, -- BaseGDL::COPY_BYTE_AS_INT)); -- -- SizeT nEl = sP->N_Elements(); -- for( SizeT e=0; eIfDefGetKWAs( 0); -- if (type != NULL) { -- int typ = (*type)[0]; -- if (typ == GDL_BYTE) -- { -- // SA: slow yet simple solution using GDL_BYTE->GDL_INT->GDL_BYTE conversion -- return (e->KeywordSet(1) && e->GetPar(0)->Type() == GDL_STRING) -- ? type_fun( e)->Convert2(GDL_BYTE, BaseGDL::CONVERT) -- : type_fun( e); -- } -- if (typ == 0 || typ == GDL_INT) return type_fun( e); -- if (typ == GDL_UINT) return type_fun( e); -- if (typ == GDL_LONG) return type_fun( e); -- if (typ == GDL_ULONG) return type_fun( e); -- if (typ == GDL_LONG64) return type_fun( e); -- if (typ == GDL_ULONG64) return type_fun( e); -- if (typ == GDL_FLOAT) return type_fun( e); -- if (typ == GDL_DOUBLE) return type_fun( e); -- if (typ == GDL_COMPLEX) return type_fun( e); -- if (typ == GDL_COMPLEXDBL) return type_fun( e); -- if (typ == GDL_STRING) -- { -- // SA: calling GDL_STRING() with correct parameters -- static int stringIx = LibFunIx("STRING"); -- -- assert( stringIx >= 0); -- -- EnvT* newEnv= new EnvT(e, libFunList[stringIx], NULL); -- -- auto_ptr guard( newEnv); -- -- newEnv->SetNextPar(&e->GetPar(0)); // pass as global -- if (e->KeywordSet(1) && e->GetPar(0)->Type() == GDL_BYTE) -- newEnv->SetKeyword("PRINT", new DIntGDL(1)); --// e->Interpreter()->CallStack().push_back( newEnv); -- return static_cast(newEnv->GetPro())->Fun()(newEnv); -- } -- e->Throw( "Improper TYPE value."); -- } -- return type_fun( e); -- } -- -- BaseGDL* call_function( EnvT* e) -- { -- int nParam=e->NParam(); -- if( nParam == 0) -- e->Throw( "No function specified."); -- -- DString callF; -- e->AssureScalarPar( 0, callF); -- -- // this is a function name -> convert to UPPERCASE -- callF = StrUpCase( callF); -- -- // first search library funcedures -- int funIx=LibFunIx( callF); -- if( funIx != -1) -- { --// e->PushNewEnv( libFunList[ funIx], 1); -- // make the call --// EnvT* newEnv = static_cast(e->Interpreter()->CallStack().back()); -- -- // handle direct call functions -- if( libFunList[ funIx]->DirectCall()) -- { -- BaseGDL* directCallParameter = e->GetParDefined(1); -- BaseGDL* res = -- static_cast(libFunList[ funIx])->FunDirect()(directCallParameter, true /*isReference*/); -- return res; -- } -- else -- { -- EnvT* newEnv = e->NewEnv( libFunList[ funIx], 1); -- auto_ptr guard( newEnv); -- return static_cast(newEnv->GetPro())->Fun()(newEnv); -- } -- } -- else -- { -- // no direct call here -- -- StackGuard guard( e->Interpreter()->CallStack()); -- -- funIx = GDLInterpreter::GetFunIx( callF); -- -- e->PushNewEnvUD( funList[ funIx], 1); -- -- // make the call -- EnvUDT* newEnv = static_cast(e->Interpreter()->CallStack().back()); -- return e->Interpreter()->call_fun(static_cast(newEnv->GetPro())->GetTree()); -- } -- } -- -- BaseGDL* call_method_function( EnvT* e) -- { -- StackGuard guard( e->Interpreter()->CallStack()); -- -- int nParam=e->NParam(); -- if( nParam < 2) -- e->Throw( "Name and object reference" -- " must be specified."); -- -- DString callP; -- e->AssureScalarPar( 0, callP); -- -- // this is a procedure name -> convert to UPPERCASE -- callP = StrUpCase( callP); -- -- DStructGDL* oStruct = e->GetObjectPar( 1); -- -- DFun* method= oStruct->Desc()->GetFun( callP); -- -- if( method == NULL) -- e->Throw( "Method not found: "+callP); --// // // /**/ -- e->PushNewEnvUD( method, 2, &e->GetPar( 1)); -- -- // make the call -- return e->Interpreter()->call_fun( method->GetTree()); -- } -- -- -- -- BaseGDL* execute( EnvT* e) -- { -- int nParam=e->NParam( 1); -- -- bool quietCompile = false; -- if( nParam == 2) -- { -- BaseGDL* p1 = e->GetParDefined( 1); -- -- if( !p1->Scalar()) -- e->Throw( "Expression must be scalar in this context: "+ -- e->GetParString(1)); -- -- quietCompile = p1->True(); -- } -- -- if (e->GetParDefined(0)->Rank() != 0) -- e->Throw("Expression must be scalar in this context: "+e->GetParString(0)); -- -- DString line; -- e->AssureScalarPar( 0, line); -- -- // remove current environment (own one) -- assert( dynamic_cast(e->Caller()) != NULL); -- EnvUDT* caller = static_cast(e->Caller()); --// e->Interpreter()->CallStack().pop_back(); -- --// wrong: e is guarded, do not delete it here --// delete e; -- -- istringstream istr(line+"\n"); -- -- RefDNode theAST; -- try { -- GDLLexer lexer(istr, "", caller->CompileOpt()); -- GDLParser& parser=lexer.Parser(); -- -- parser.interactive(); -- -- theAST=parser.getAST(); -- } -- catch( GDLException& ex) -- { -- if( !quietCompile) GDLInterpreter::ReportCompileError( ex); -- return new DIntGDL( 0); -- } -- catch( ANTLRException ex) -- { -- if( !quietCompile) cerr << "EXECUTE: Lexer/Parser exception: " << -- ex.getMessage() << endl; -- return new DIntGDL( 0); -- } -- -- if( theAST == NULL) return new DIntGDL( 1); -- -- RefDNode trAST; -- try -- { -- GDLTreeParser treeParser( caller); -- -- treeParser.interactive(theAST); -- -- trAST=treeParser.getAST(); -- } -- catch( GDLException& ex) -- { -- if( !quietCompile) GDLInterpreter::ReportCompileError( ex); -- return new DIntGDL( 0); -- } -- -- catch( ANTLRException ex) -- { -- if( !quietCompile) cerr << "EXECUTE: Compiler exception: " << -- ex.getMessage() << endl; -- return new DIntGDL( 0); -- } -- -- if( trAST == NULL) return new DIntGDL( 1); -- -- int nForLoopsIn = caller->NForLoops(); -- try -- { -- ProgNodeP progAST = ProgNode::NewProgNode( trAST); -- auto_ptr< ProgNode> progAST_guard( progAST); -- -- int nForLoops = ProgNode::NumberForLoops( progAST, nForLoopsIn); -- caller->ResizeForLoops( nForLoops); -- -- progAST->setLine( e->GetLineNumber()); -- -- RetCode retCode = caller->Interpreter()->execute( progAST); -- -- caller->ResizeForLoops( nForLoopsIn); -- -- if( retCode == RC_OK) -- return new DIntGDL( 1); -- else -- return new DIntGDL( 0); -- } -- catch( GDLException& ex) -- { -- caller->ResizeForLoops( nForLoopsIn); -- // are we throwing to target environment? --// if( ex.GetTargetEnv() == NULL) -- if( !quietCompile) cerr << "EXECUTE: " << -- ex.getMessage() << endl; -- return new DIntGDL( 0); -- } -- catch( ANTLRException ex) -- { -- caller->ResizeForLoops( nForLoopsIn); -- -- if( !quietCompile) cerr << "EXECUTE: Interpreter exception: " << -- ex.getMessage() << endl; -- return new DIntGDL( 0); -- } -- -- return new DIntGDL( 0); // control flow cannot reach here - compiler shut up -- } -- -- BaseGDL* assoc( EnvT* e) -- { -- SizeT nParam=e->NParam( 2); -- -- DLong lun; -- e->AssureLongScalarPar( 0, lun); -- -- bool stdLun = check_lun( e, lun); -- if( stdLun) -- e->Throw( "File unit does not allow" -- " this operation. Unit: "+i2s( lun)); -- -- DLong offset = 0; -- if( nParam >= 3) e->AssureLongScalarPar( 2, offset); -- -- BaseGDL* arr = e->GetParDefined( 1); -- -- if( arr->StrictScalar()) -- e->Throw( "Scalar variable not allowed in this" -- " context: "+e->GetParString(1)); -- -- return arr->AssocVar( lun, offset); -- } -- -- // gdl_ naming because of weired namespace problem in MSVC -- BaseGDL* gdl_logical_and( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- if( nParam != 2) -- e->Throw( -- "Incorrect number of arguments."); -- -- BaseGDL* e1=e->GetParDefined( 0);//, "LOGICAL_AND"); -- BaseGDL* e2=e->GetParDefined( 1);//, "LOGICAL_AND"); -- -- ULong nEl1 = e1->N_Elements(); -- ULong nEl2 = e2->N_Elements(); -- -- Data_* res; -- -- if( e1->Scalar()) -- { -- if( e1->LogTrue(0)) -- { -- res= new Data_( e2->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl2; i++) -- (*res)[i] = e2->LogTrue( i) ? 1 : 0; --} -- } -- else -- { -- return new Data_( e2->Dim()); -- } -- } -- else if( e2->Scalar()) -- { -- if( e2->LogTrue(0)) -- { -- res= new Data_( e1->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl1; i++) -- (*res)[i] = e1->LogTrue( i) ? 1 : 0; --} -- } -- else -- { -- return new Data_( e1->Dim()); -- } -- } -- else if( nEl2 < nEl1) -- { -- res= new Data_( e2->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl2; i++) -- (*res)[i] = (e1->LogTrue( i) && e2->LogTrue( i)) ? 1 : 0; --} -- } -- else // ( nEl2 >= nEl1) -- { -- res= new Data_( e1->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl1; i++) -- (*res)[i] = (e1->LogTrue( i) && e2->LogTrue( i)) ? 1 : 0; --} -- } -- return res; -- } -- -- // gdl_ naming because of weired namespace problem in MSVC -- BaseGDL* gdl_logical_or( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- if( nParam != 2) -- e->Throw( -- "Incorrect number of arguments."); -- -- BaseGDL* e1=e->GetParDefined( 0);//, "LOGICAL_OR"); -- BaseGDL* e2=e->GetParDefined( 1);//, "LOGICAL_OR"); -- -- ULong nEl1 = e1->N_Elements(); -- ULong nEl2 = e2->N_Elements(); -- -- Data_* res; -- -- if( e1->Scalar()) -- { -- if( e1->LogTrue(0)) -- { -- res= new Data_( e2->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl2; i++) -- (*res)[i] = 1; --} -- } -- else -- { -- res= new Data_( e2->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl2; i++) -- (*res)[i] = e2->LogTrue( i) ? 1 : 0; --} -- } -- } -- else if( e2->Scalar()) -- { -- if( e2->LogTrue(0)) -- { -- res= new Data_( e1->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl1; i++) -- (*res)[i] = 1; --} -- } -- else -- { -- res= new Data_( e1->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl1; i++) -- (*res)[i] = e1->LogTrue( i) ? 1 : 0; --} -- } -- } -- else if( nEl2 < nEl1) -- { -- res= new Data_( e2->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl2; i++) -- (*res)[i] = (e1->LogTrue( i) || e2->LogTrue( i)) ? 1 : 0; --} -- } -- else // ( nEl2 >= nEl1) -- { -- res= new Data_( e1->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl1; i++) -- (*res)[i] = (e1->LogTrue( i) || e2->LogTrue( i)) ? 1 : 0; --} -- } -- return res; -- } -- -- BaseGDL* logical_true( BaseGDL* e1, bool isReference)//( EnvT* e); -- { -- assert( e1 != NULL); -- assert( e1->N_Elements() > 0); -- -- --// SizeT nParam=e->NParam(); --// if( nParam != 1) --// e->Throw( --// "Incorrect number of arguments."); --// --// BaseGDL* e1=e->GetParDefined( 0);//, "LOGICAL_TRUE"); --// -- ULong nEl1 = e1->N_Elements(); -- -- Data_* res = new Data_( e1->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) --{ --// #pragma omp for -- for( SizeT i=0; i < nEl1; i++) -- (*res)[i] = e1->LogTrue( i) ? 1 : 0; --} -- return res; -- } -- -- BaseGDL* replicate( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- if( nParam < 2) -- e->Throw( "Incorrect number of arguments."); -- dimension dim; -- arr( e, dim, 1); -- -- BaseGDL* p0=e->GetParDefined( 0);//, "REPLICATE"); -- if( !p0->Scalar()) -- e->Throw( "Expression must be a scalar in this context: "+ -- e->GetParString(0)); -- -- return p0->New( dim, BaseGDL::INIT); -- } -- -- BaseGDL* strtrim( EnvT* e) -- { -- SizeT nParam = e->NParam( 1);//, "STRTRIM"); -- -- BaseGDL* p0 = e->GetPar( 0); -- if( p0 == NULL) -- e->Throw( -- "Variable is undefined: "+ -- e->GetParString(0)); -- DStringGDL* p0S = static_cast -- (p0->Convert2(GDL_STRING,BaseGDL::COPY)); -- -- DLong mode = 0; -- if( nParam == 2) -- { -- BaseGDL* p1 = e->GetPar( 1); -- if( p1 == NULL) -- e->Throw( -- "Variable is undefined: "+e->GetParString(1)); -- if( !p1->Scalar()) -- e->Throw( -- "Expression must be a " -- "scalar in this context: "+ -- e->GetParString(1)); -- DLongGDL* p1L = static_cast -- (p1->Convert2(GDL_LONG,BaseGDL::COPY)); -- -- mode = (*p1L)[ 0]; -- -- GDLDelete(p1L); -- -- if( mode < 0 || mode > 2) -- { -- ostringstream os; -- p1->ToStream( os); -- e->Throw( -- "Value of <"+ p1->TypeStr() + -- " ("+os.str()+ -- ")> is out of allowed range."); -- } -- } -- -- SizeT nEl = p0S->N_Elements(); -- -- if( mode == 2) // both -- { --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; iNParam( 1); -- -- DStringGDL* p0S = e->GetParAs( 0); -- -- bool removeAll = e->KeywordSet(0); -- -- DStringGDL* res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -- -- SizeT nEl = p0S->N_Elements(); --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; iNParam( 2);//, "STRPOS"); -- -- bool reverseOffset = e->KeywordSet(0); // REVERSE_OFFSET -- bool reverseSearch = e->KeywordSet(1); // REVERSE_SEARCH -- -- DStringGDL* p0S = e->GetParAs( 0); -- -- DString searchString; -- // e->AssureScalarPar( 1, searchString); -- DStringGDL* sStr = e->GetParAs( 1); -- if( !sStr->Scalar( searchString)) -- e->Throw( "Search string must be a scalar or one element array: "+ -- e->GetParString( 1)); -- -- unsigned long pos = string::npos; -- if( nParam > 2) --{ -- BaseGDL* p2 = e->GetParDefined(2); --// if( p2 != NULL) //e->AssureLongScalarPar( 2,posDLong); --// { -- const SizeT pIx = 2; -- BaseGDL* p = e->GetParDefined( pIx); -- DLongGDL* lp = static_cast(p->Convert2( GDL_LONG, BaseGDL::COPY)); -- auto_ptr guard_lp( lp); -- DLong scalar; -- if( !lp->Scalar( scalar)) -- throw GDLException("Parameter must be a scalar in this context: "+ -- e->GetParString(pIx)); -- pos = scalar; -- } -- -- DLongGDL* res = new DLongGDL( p0S->Dim(), BaseGDL::NOZERO); -- -- SizeT nSrcStr = p0S->N_Elements(); --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if ((nSrcStr*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nSrcStr*10))) --{ --#pragma omp for -- for( long i=0; iNParam( 2);//, "STRMID"); -- -- bool reverse = e->KeywordSet(0); -- -- DStringGDL* p0S = e->GetParAs( 0); -- DLongGDL* p1L = e->GetParAs( 1); -- -- BaseGDL* p2 = e->GetPar( 2); -- DLongGDL* p2L = NULL; -- if( p2 != NULL) p2L = e->GetParAs( 2); -- -- DLong scVal1; -- bool sc1 = p1L->Scalar( scVal1); -- -- DLong scVal2 = numeric_limits::max(); -- bool sc2 = true; -- if( p2L != NULL) -- { -- DLong scalar; -- sc2 = p2L->Scalar( scalar); -- scVal2 = scalar; -- } -- -- DLong stride; -- if( !sc1 && !sc2) -- { -- stride = p1L->Dim( 0); -- if( stride != p2L->Dim( 0)) -- e->Throw( -- "Starting offset and length arguments " -- "have incompatible first dimension."); -- } -- else -- { -- // at least one scalar, p2L possibly NULL -- if( p2L == NULL) -- stride = p1L->Dim( 0); -- else -- stride = max( p1L->Dim( 0), p2L->Dim( 0)); -- -- stride = (stride > 0)? stride : 1; -- } -- -- dimension resDim( p0S->Dim()); -- if( stride > 1) -- resDim >> stride; -- -- DStringGDL* res = new DStringGDL( resDim, BaseGDL::NOZERO); -- -- SizeT nEl1 = p1L->N_Elements(); -- SizeT nEl2 = (sc2)? 1 : p2L->N_Elements(); -- -- SizeT nSrcStr = p0S->N_Elements(); --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if ((nSrcStr*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nSrcStr*10))) default( shared) --{ --#pragma omp for -- for( long i=0; iN_Elements() > 0); -- --// e->NParam( 1);//, "STRLOWCASE"); -- --// DStringGDL* p0S = e->GetParAs( 0); -- DStringGDL* p0S; -- DStringGDL* res; --// auto_ptr guard; -- -- if( p0->Type() == GDL_STRING) -- { -- p0S = static_cast( p0); -- if( !isReference) -- res = p0S; -- else -- res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -- } -- else -- { -- p0S = static_cast( p0->Convert2( GDL_STRING, BaseGDL::COPY)); -- res = p0S; --// guard.reset( p0S); -- } -- --// DStringGDL* res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -- -- SizeT nEl = p0S->N_Elements(); -- -- if( res == p0S) -- { --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; iN_Elements() > 0); -- --// e->NParam( 1);//, "STRLOWCASE"); -- --// DStringGDL* p0S = e->GetParAs( 0); -- DStringGDL* p0S; -- DStringGDL* res; --// auto_ptr guard; -- -- if( p0->Type() == GDL_STRING) -- { -- p0S = static_cast( p0); -- if( !isReference) -- res = p0S; -- else -- res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -- } -- else -- { -- p0S = static_cast( p0->Convert2( GDL_STRING, BaseGDL::COPY)); -- res = p0S; --// guard.reset( p0S); -- } -- --// DStringGDL* res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -- -- SizeT nEl = p0S->N_Elements(); -- -- if( res == p0S) -- { --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) --{ --#pragma omp for -- for( int i=0; iN_Elements() > 0); -- --// e->NParam( 1);//, "STRLEN"); -- -- DStringGDL* p0S; -- auto_ptr guard; -- -- if( p0->Type() == GDL_STRING) -- p0S = static_cast( p0); -- else -- { -- p0S = static_cast( p0->Convert2( GDL_STRING, BaseGDL::COPY)); -- guard.reset( p0S); -- } -- -- DLongGDL* res = new DLongGDL( p0S->Dim(), BaseGDL::NOZERO); -- -- SizeT nEl = p0S->N_Elements(); --// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) --{ --// #pragma omp for -- for( SizeT i=0; iNParam( 1); -- -- DStringGDL* p0S = e->GetParAs( 0); -- SizeT nEl = p0S->N_Elements(); -- -- DString delim = ""; -- if( nParam > 1) -- e->AssureStringScalarPar( 1, delim); -- -- bool single = e->KeywordSet( 0); // SINGLE -- -- if( single) -- { -- DStringGDL* res = new DStringGDL( (*p0S)[0]); -- DString& scl = (*res)[0]; -- -- for( SizeT i=1; iDim()); -- resDim.Purge(); -- -- SizeT stride = resDim.Stride( 1); -- -- resDim.Remove( 0); -- -- DStringGDL* res = new DStringGDL( resDim, BaseGDL::NOZERO); -- for( SizeT src=0, dst=0; srcNParam( 1);//, "WHERE"); -- -- BaseGDL* p0 = e->GetParDefined( 0);//, "WHERE"); -- -- SizeT nEl = p0->N_Elements(); -- -- SizeT count; -- -- static int nullIx = e->KeywordIx("NULL"); -- bool nullKW = e->KeywordSet(nullIx); -- -- DLong* ixList = p0->Where( e->KeywordPresent( 0), count); -- ArrayGuard guard( ixList); -- SizeT nCount = nEl - count; -- -- if( e->KeywordPresent( 0)) // COMPLEMENT -- { -- if( nCount == 0) -- { -- if( nullKW) -- e->SetKW( 0, NullGDL::GetSingleInstance()); -- else -- e->SetKW( 0, new DLongGDL( -1)); -- } -- else -- { -- DLongGDL* cIxList = new DLongGDL( dimension( &nCount, 1), -- BaseGDL::NOZERO); -- -- SizeT cIx = nEl - 1; --// #pragma omp parallel if (nCount >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nCount)) --{ --// #pragma omp for -- for( SizeT i=0; iSetKW( 0, cIxList); -- } -- } -- -- if( e->KeywordPresent( 1)) // NCOMPLEMENT -- { -- e->SetKW( 1, new DLongGDL( nCount)); -- } -- -- if( nParam == 2) -- { -- e->SetPar( 1, new DLongGDL( count)); -- } -- -- if( count == 0) -- { -- if( nullKW) -- return NullGDL::GetSingleInstance(); -- return new DLongGDL( -1); -- } -- -- return new DLongGDL( ixList, count); -- -- // DLongGDL* res = new DLongGDL( dimension( &count, 1), -- // BaseGDL::NOZERO); -- // for( SizeT i=0; i(e->Caller()); -- if( caller == NULL) return new DLongGDL( 0); -- DLong nP = caller->NParam(); -- if( caller->IsObject()) -- return new DLongGDL( nP-1); // "self" is not counted -- return new DLongGDL( nP); -- } -- -- BaseGDL* keyword_set( EnvT* e) -- { -- e->NParam( 1);//, "KEYWORD_SET"); -- -- BaseGDL* p0 = e->GetPar( 0); -- if( p0 == NULL) return new DIntGDL( 0); -- if( !p0->Scalar()) return new DIntGDL( 1); -- if( p0->Type() == GDL_STRUCT) return new DIntGDL( 1); -- if( p0->LogTrue()) return new DIntGDL( 1); -- return new DIntGDL( 0); -- } -- -- // passing 2nd argument by value is slightly better for float and double, -- // but incur some overhead for the complex class. -- template inline void AddOmitNaN(T& dest, T value) --{ -- if (isfinite(value)) --{ --// #pragma omp atomic -- dest += value; --} --} -- template inline void AddOmitNaNCpx(T& dest, T value) -- { --// #pragma omp atomic -- dest += T(isfinite(value.real())? value.real() : 0, -- isfinite(value.imag())? value.imag() : 0); -- } -- template<> inline void AddOmitNaN(DComplex& dest, DComplex value) -- { AddOmitNaNCpx(dest, value); } -- template<> inline void AddOmitNaN(DComplexDbl& dest, DComplexDbl value) -- { AddOmitNaNCpx(dest, value); } -- -- template inline void NaN2Zero(T& value) -- { if (!isfinite(value)) value = 0; } -- template inline void NaN2ZeroCpx(T& value) -- { -- value = T(isfinite(value.real())? value.real() : 0, -- isfinite(value.imag())? value.imag() : 0); -- } -- template<> inline void NaN2Zero(DComplex& value) -- { NaN2ZeroCpx< DComplex>(value); } -- template<> inline void NaN2Zero(DComplexDbl& value) -- { NaN2ZeroCpx< DComplexDbl>(value); } -- -- // total over all elements -- template -- BaseGDL* total_template( T* src, bool omitNaN) -- { -- if (!omitNaN) return new T(src->Sum()); -- typename T::Ty sum = 0; -- SizeT nEl = src->N_Elements(); --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(sum) --{ --#pragma omp for -- for ( int i=0; i -- BaseGDL* total_cu_template( T* res, bool omitNaN) -- { -- SizeT nEl = res->N_Elements(); -- if (omitNaN) -- { --// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) --{ --// #pragma omp for -- for( SizeT i=0; i -- BaseGDL* total_over_dim_template( T* src, -- const dimension& srcDim, -- SizeT sumDimIx, -- bool omitNaN) -- { -- SizeT nEl = src->N_Elements(); -- -- // get dest dim and number of summations -- dimension destDim = srcDim; -- SizeT nSum = destDim.Remove( sumDimIx); -- -- T* res = new T( destDim); // zero fields -- -- // sumStride is also the number of linear src indexing -- SizeT sumStride = srcDim.Stride( sumDimIx); -- SizeT outerStride = srcDim.Stride( sumDimIx + 1); -- SizeT sumLimit = nSum * sumStride; -- SizeT rIx=0; -- for( SizeT o=0; o < nEl; o += outerStride) -- for( SizeT i=0; i < sumStride; ++i) -- { -- SizeT oi = o+i; -- SizeT oiLimit = sumLimit + oi; -- if( omitNaN) -- { -- for( SizeT s=oi; s -- BaseGDL* total_over_dim_cu_template( T* res, -- SizeT sumDimIx, -- bool omitNaN) -- { -- SizeT nEl = res->N_Elements(); -- const dimension& resDim = res->Dim(); -- if (omitNaN) -- { -- for( SizeT i=0; iNParam( 1);//, "TOTAL"); -- -- BaseGDL* p0 = e->GetParDefined( 0);//, "TOTAL"); -- -- SizeT nEl = p0->N_Elements(); -- if( nEl == 0) -- e->Throw( "Variable is undefined: "+e->GetParString(0)); -- -- if( p0->Type() == GDL_STRING) -- e->Throw( "String expression not allowed " -- "in this context: "+e->GetParString(0)); -- -- static int cumIx = e->KeywordIx( "CUMULATIVE"); -- static int intIx = e->KeywordIx("INTEGER"); -- static int doubleIx = e->KeywordIx( "DOUBLE"); -- static int nanIx = e->KeywordIx( "NAN"); -- static int preserveIx = e->KeywordIx( "PRESERVE_TYPE"); -- -- bool cumulative = e->KeywordSet( cumIx); -- bool intRes = e->KeywordSet( intIx); -- bool doubleRes = e->KeywordSet( doubleIx); -- bool nan = e->KeywordSet( nanIx); -- bool preserve = e->KeywordSet( preserveIx); -- -- DLong sumDim = 0; -- if( nParam == 2) -- e->AssureLongScalarPar( 1, sumDim); -- -- if( sumDim == 0) -- { -- if( !cumulative) -- { -- if (preserve) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return total_template(static_cast(p0), false); -- case GDL_INT: return total_template(static_cast(p0), false); -- case GDL_UINT: return total_template(static_cast(p0), false); -- case GDL_LONG: return total_template(static_cast(p0), false); -- case GDL_ULONG: return total_template(static_cast(p0), false); -- case GDL_LONG64: return total_template(static_cast(p0), false); -- case GDL_ULONG64: return total_template(static_cast(p0), false); -- case GDL_FLOAT: return total_template(static_cast(p0), nan); -- case GDL_DOUBLE: return total_template(static_cast(p0), nan); -- case GDL_COMPLEX: return total_template(static_cast(p0), nan); -- case GDL_COMPLEXDBL: return total_template(static_cast(p0), nan); -- default: assert(false); -- } -- } -- -- // Integer parts by Erin Sheldon -- // In IDL total(), the INTEGER keyword takes precedence -- if( intRes ) -- { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ( p0->Type() == GDL_LONG64 ) -- { -- return total_template -- ( static_cast(p0), nan ); -- } -- if ( p0->Type() == GDL_ULONG64 ) -- { -- return total_template -- ( static_cast(p0), nan ); -- } -- -- // Conver to Long64 -- DLong64GDL* p0L64 = static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -- auto_ptr guard( p0L64); -- return total_template( p0L64, nan); -- -- } // integer results -- -- -- if( p0->Type() == GDL_DOUBLE) -- { -- return total_template -- ( static_cast(p0), nan); -- } -- if( p0->Type() == GDL_COMPLEXDBL) -- { -- return total_template -- ( static_cast(p0), nan); -- } -- -- if( !doubleRes) -- { -- if( p0->Type() == GDL_FLOAT) -- { -- return total_template -- ( static_cast(p0), nan); -- } -- if( p0->Type() == GDL_COMPLEX) -- { -- return total_template -- ( static_cast(p0), nan); -- } -- DFloatGDL* p0F = static_cast -- (p0->Convert2( GDL_FLOAT,BaseGDL::COPY)); -- auto_ptr guard( p0F); -- return total_template( p0F, false); -- } -- if( p0->Type() == GDL_COMPLEX) -- { -- DComplexDblGDL* p0D = static_cast -- (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- return total_template( p0D, nan); -- } -- -- DDoubleGDL* p0D = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- return total_template( p0D, nan); -- } -- else // cumulative -- { -- if (preserve) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return total_cu_template(static_cast(p0)->Dup(), false); -- case GDL_INT: return total_cu_template(static_cast(p0)->Dup(), false); -- case GDL_UINT: return total_cu_template(static_cast(p0)->Dup(), false); -- case GDL_LONG: return total_cu_template(static_cast(p0)->Dup(), false); -- case GDL_ULONG: return total_cu_template(static_cast(p0)->Dup(), false); -- case GDL_LONG64: return total_cu_template(static_cast(p0)->Dup(), false); -- case GDL_ULONG64: return total_cu_template(static_cast(p0)->Dup(), false); -- case GDL_FLOAT: return total_cu_template(static_cast(p0)->Dup(), nan); -- case GDL_DOUBLE: return total_cu_template(static_cast(p0)->Dup(), nan); -- case GDL_COMPLEX: return total_cu_template(static_cast(p0)->Dup(), nan); -- case GDL_COMPLEXDBL: return total_cu_template(static_cast(p0)->Dup(), nan); -- default: assert(false); -- } -- } -- -- // INTEGER keyword takes precedence -- if( intRes ) -- { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ( p0->Type() == GDL_LONG64 ) -- { -- return total_cu_template -- ( static_cast(p0)->Dup(), nan ); -- } -- if ( p0->Type() == GDL_ULONG64 ) -- { -- return total_cu_template -- ( static_cast(p0)->Dup(), nan ); -- } -- -- // Convert to Long64 -- return total_cu_template -- ( static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)), nan); -- -- } // integer results -- -- -- // special case as GDL_DOUBLE type overrides /GDL_DOUBLE -- if( p0->Type() == GDL_DOUBLE) -- { -- return total_cu_template< DDoubleGDL> -- ( static_cast(p0)->Dup(), nan); -- } -- if( p0->Type() == GDL_COMPLEXDBL) -- { -- return total_cu_template< DComplexDblGDL> -- ( static_cast(p0)->Dup(), nan); -- } -- -- -- -- if( !doubleRes) -- { -- // special case for GDL_FLOAT has no advantage here -- if( p0->Type() == GDL_COMPLEX) -- { -- return total_cu_template< DComplexGDL> -- ( static_cast(p0)->Dup(), nan); -- } -- return total_cu_template< DFloatGDL> -- ( static_cast( p0->Convert2(GDL_FLOAT, -- BaseGDL::COPY)), nan); -- } -- if( p0->Type() == GDL_COMPLEX) -- { -- return total_cu_template< DComplexDblGDL> -- ( static_cast(p0->Convert2( GDL_COMPLEXDBL, -- BaseGDL::COPY)), nan); -- } -- return total_cu_template< DDoubleGDL> -- ( static_cast(p0->Convert2( GDL_DOUBLE, -- BaseGDL::COPY)), nan); -- } -- } -- -- // total over sumDim -- dimension srcDim = p0->Dim(); -- SizeT srcRank = srcDim.Rank(); -- -- if( sumDim < 1 || sumDim > srcRank) -- e->Throw( -- "Array must have "+i2s(sumDim)+ -- " dimensions: "+e->GetParString(0)); -- -- if( !cumulative) -- { -- if (preserve) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -- case GDL_INT: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -- case GDL_UINT: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -- case GDL_LONG: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -- case GDL_ULONG: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -- case GDL_LONG64: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -- case GDL_ULONG64: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -- case GDL_FLOAT: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -- case GDL_DOUBLE: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -- case GDL_COMPLEX: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -- case GDL_COMPLEXDBL: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -- default: assert(false); -- } -- } -- -- // INTEGER keyword takes precedence -- if( intRes ) -- { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ( p0->Type() == GDL_LONG64 ) -- { -- return total_over_dim_template -- ( static_cast(p0), srcDim, sumDim-1, nan ); -- } -- if ( p0->Type() == GDL_ULONG64 ) -- { -- return total_over_dim_template -- ( static_cast(p0), srcDim, sumDim-1, nan ); -- } -- -- // Conver to Long64 -- DLong64GDL* p0L64 = static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -- -- auto_ptr p0L64_guard( p0L64); -- return total_over_dim_template -- ( p0L64, srcDim, sumDim-1, nan); -- -- } // integer results -- -- -- if( p0->Type() == GDL_DOUBLE) -- { -- return total_over_dim_template< DDoubleGDL> -- ( static_cast(p0), srcDim, sumDim-1, nan); -- } -- if( p0->Type() == GDL_COMPLEXDBL) -- { -- return total_over_dim_template< DComplexDblGDL> -- ( static_cast(p0), srcDim, sumDim-1, nan); -- } -- if( !doubleRes) -- { -- if( p0->Type() == GDL_FLOAT) -- { -- return total_over_dim_template< DFloatGDL> -- ( static_cast(p0), srcDim, sumDim-1, nan); -- } -- if( p0->Type() == GDL_COMPLEX) -- { -- return total_over_dim_template< DComplexGDL> -- ( static_cast(p0), srcDim, sumDim-1, nan); -- } -- // default for NOT /GDL_DOUBLE -- DFloatGDL* p0F = static_cast -- (p0->Convert2( GDL_FLOAT,BaseGDL::COPY)); -- auto_ptr p0F_guard( p0F); -- // p0F_guard.reset( p0F); -- return total_over_dim_template< DFloatGDL> -- ( p0F, srcDim, sumDim-1, false); -- } -- if( p0->Type() == GDL_COMPLEX) -- { -- DComplexDblGDL* p0D = static_cast -- (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- // p0D_guard.reset( p0D); -- return total_over_dim_template< DComplexDblGDL> -- ( p0D, srcDim, sumDim-1, nan); -- } -- // default for /GDL_DOUBLE -- DDoubleGDL* p0D = static_cast -- (p0->Convert2( GDL_DOUBLE,BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- //p0D_guard.reset( p0D); -- return total_over_dim_template< DDoubleGDL>( p0D, srcDim, sumDim-1,nan); -- } -- else // cumulative -- { -- if (preserve) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -- case GDL_INT: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -- case GDL_UINT: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -- case GDL_LONG: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -- case GDL_ULONG: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -- case GDL_LONG64: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -- case GDL_ULONG64: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -- case GDL_FLOAT: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -- case GDL_DOUBLE: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -- case GDL_COMPLEX: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -- case GDL_COMPLEXDBL: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -- default: assert(false); -- } -- } -- -- // INTEGER keyword takes precedence -- if( intRes ) -- { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ( p0->Type() == GDL_LONG64 ) -- { -- return total_over_dim_cu_template -- ( static_cast(p0)->Dup(), sumDim-1, nan ); -- } -- if ( p0->Type() == GDL_ULONG64 ) -- { -- return total_over_dim_cu_template -- ( static_cast(p0)->Dup(), sumDim-1, nan ); -- } -- -- // Convert to Long64 -- return total_over_dim_cu_template -- ( static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)), sumDim-1, nan); -- -- } // integer results -- -- -- if( p0->Type() == GDL_DOUBLE) -- { -- return total_over_dim_cu_template< DDoubleGDL> -- ( static_cast(p0)->Dup(), sumDim-1, nan); -- } -- if( p0->Type() == GDL_COMPLEXDBL) -- { -- return total_over_dim_cu_template< DComplexDblGDL> -- ( static_cast(p0)->Dup(), sumDim-1, nan); -- } -- if( !doubleRes) -- { -- // special case for GDL_FLOAT has no advantage here -- if( p0->Type() == GDL_COMPLEX) -- { -- return total_over_dim_cu_template< DComplexGDL> -- ( static_cast(p0)->Dup(), sumDim-1, nan); -- } -- // default for NOT /GDL_DOUBLE -- return total_over_dim_cu_template< DFloatGDL> -- ( static_cast( p0->Convert2( GDL_FLOAT, -- BaseGDL::COPY)), sumDim-1, nan); -- } -- if( p0->Type() == GDL_COMPLEX) -- { -- return total_over_dim_cu_template< DComplexDblGDL> -- ( static_cast(p0->Convert2( GDL_COMPLEXDBL, -- BaseGDL::COPY)), sumDim-1, nan); -- } -- // default for /GDL_DOUBLE -- return total_over_dim_cu_template< DDoubleGDL> -- ( static_cast(p0->Convert2( GDL_DOUBLE, -- BaseGDL::COPY)), sumDim-1, nan); -- } -- } -- -- -- // passing 2nd argument by value is slightly better for float and double, -- // but incur some overhead for the complex class. -- template inline void MultOmitNaN(T& dest, T value) -- { -- if (isfinite(value)) -- { --// #pragma omp atomic -- dest *= value; -- } -- } -- template inline void MultOmitNaNCpx(T& dest, T value) -- { -- dest *= T(isfinite(value.real())? value.real() : 1, -- isfinite(value.imag())? value.imag() : 1); -- } -- template<> inline void MultOmitNaN(DComplex& dest, DComplex value) -- { MultOmitNaNCpx(dest, value); } -- template<> inline void MultOmitNaN(DComplexDbl& dest, DComplexDbl value) -- { MultOmitNaNCpx(dest, value); } -- -- template inline void Nan2One(T& value) -- { if (!isfinite(value)) value = 1; } -- template inline void Nan2OneCpx(T& value) -- { -- value = T(isfinite(value.real())? value.real() : 1, -- isfinite(value.imag())? value.imag() : 1); -- } -- template<> inline void Nan2One(DComplex& value) -- { Nan2OneCpx< DComplex>(value); } -- template<> inline void Nan2One(DComplexDbl& value) -- { Nan2OneCpx< DComplexDbl>(value); } -- -- // product over all elements -- template -- BaseGDL* product_template( T* src, bool omitNaN) -- { -- typename T::Ty sum = 1; -- SizeT nEl = src->N_Elements(); -- if( !omitNaN) -- { --TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(sum) --{ --#pragma omp for reduction(*:sum) -- for ( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(sum) --{ --#pragma omp for reduction(*:sum) -- for ( int i=0; i -- BaseGDL* product_template( DComplexGDL* src, bool omitNaN) -- { -- DComplexGDL::Ty sum = 1; -- SizeT nEl = src->N_Elements(); -- if( !omitNaN) -- { -- for ( SizeT i=0; i -- BaseGDL* product_template( DComplexDblGDL* src, bool omitNaN) -- { -- DComplexDblGDL::Ty sum = 1; -- SizeT nEl = src->N_Elements(); -- if( !omitNaN) -- { -- for ( SizeT i=0; i -- BaseGDL* product_cu_template( T* res, bool omitNaN) -- { -- SizeT nEl = res->N_Elements(); -- if( omitNaN) -- { -- for( SizeT i=0; i -- BaseGDL* product_over_dim_template( T* src, -- const dimension& srcDim, -- SizeT sumDimIx, -- bool omitNaN) -- { -- SizeT nEl = src->N_Elements(); -- -- // get dest dim and number of summations -- dimension destDim = srcDim; -- SizeT nSum = destDim.Remove( sumDimIx); -- -- T* res = new T( destDim, BaseGDL::NOZERO); -- -- // sumStride is also the number of linear src indexing -- SizeT sumStride = srcDim.Stride( sumDimIx); -- SizeT outerStride = srcDim.Stride( sumDimIx + 1); -- SizeT sumLimit = nSum * sumStride; -- SizeT rIx=0; -- for( SizeT o=0; o < nEl; o += outerStride) -- for( SizeT i=0; i < sumStride; ++i) -- { -- (*res)[ rIx] = 1; -- SizeT oi = o+i; -- SizeT oiLimit = sumLimit + oi; -- if( omitNaN) -- { -- for( SizeT s=oi; s -- BaseGDL* product_over_dim_cu_template( T* res, -- SizeT sumDimIx, -- bool omitNaN) -- { -- SizeT nEl = res->N_Elements(); -- const dimension& resDim = res->Dim(); -- if (omitNaN) -- { -- for( SizeT i=0; iNParam( 1); -- -- BaseGDL* p0 = e->GetParDefined( 0); -- -- SizeT nEl = p0->N_Elements(); -- if( nEl == 0) -- e->Throw( "Variable is undefined: "+e->GetParString(0)); -- -- if( p0->Type() == GDL_STRING) -- e->Throw( "String expression not allowed " -- "in this context: "+e->GetParString(0)); -- -- static int cumIx = e->KeywordIx( "CUMULATIVE"); -- static int nanIx = e->KeywordIx( "NAN"); -- static int intIx = e->KeywordIx("INTEGER"); -- static int preIx = e->KeywordIx("PRESERVE_TYPE"); -- bool KwCumul = e->KeywordSet( cumIx); -- bool KwNaN = e->KeywordSet( nanIx); -- bool KwInt = e->KeywordSet( intIx); -- bool KwPre = e->KeywordSet( preIx); -- bool nanInt=false; -- -- DLong sumDim = 0; -- if( nParam == 2) -- e->AssureLongScalarPar( 1, sumDim); -- -- if( sumDim == 0) { -- if( !KwCumul) { -- if (KwPre) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return product_template(static_cast(p0), nanInt); -- case GDL_INT: return product_template(static_cast(p0), nanInt); -- case GDL_UINT: return product_template(static_cast(p0), nanInt); -- case GDL_LONG: return product_template(static_cast(p0), nanInt); -- case GDL_ULONG: return product_template(static_cast(p0), nanInt); -- case GDL_LONG64: return product_template(static_cast(p0), nanInt); -- case GDL_ULONG64: return product_template(static_cast(p0), nanInt); -- case GDL_FLOAT: return product_template(static_cast(p0), KwNaN); -- case GDL_DOUBLE: return product_template(static_cast(p0), KwNaN); -- case GDL_COMPLEX: return product_template(static_cast(p0), KwNaN); -- case GDL_COMPLEXDBL: return product_template(static_cast(p0), KwNaN); -- default: assert(false); -- } -- } -- -- // Integer parts derivated from Total code by Erin Sheldon -- // In IDL PRODUCT(), the INTEGER keyword takes precedence -- if (KwInt) { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ((p0->Type() == GDL_LONG64) && (!KwNaN)) { -- return product_template -- ( static_cast(p0), nanInt ); -- } -- if ((p0->Type() == GDL_ULONG64) && (!KwNaN)) { -- return product_template -- (static_cast(p0), nanInt ); -- } -- -- // Convert to Long64 -- DLong64GDL* p0L64 = static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -- auto_ptr guard( p0L64); -- if (KwNaN) { -- DFloatGDL* p0f = static_cast -- (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- auto_ptr guard( p0f); -- for( SizeT i=0; i( p0L64, nanInt); -- } // integer results -- -- if( p0->Type() == GDL_DOUBLE) { -- return product_template -- ( static_cast(p0), KwNaN); -- } -- if( p0->Type() == GDL_COMPLEXDBL) { -- return product_template -- ( static_cast(p0), KwNaN); -- } -- if( p0->Type() == GDL_COMPLEX) { -- DComplexDblGDL* p0D = static_cast -- (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- //p0D_guard.reset( p0D); -- return product_template( p0D, KwNaN); -- } -- -- DDoubleGDL* p0D = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- // p0D_guard.reset( p0D); -- return product_template( p0D, KwNaN); -- } -- else -- { // KwCumul -- -- if (KwPre) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return product_cu_template(static_cast(p0)->Dup(), nanInt); -- case GDL_INT: return product_cu_template(static_cast(p0)->Dup(), nanInt); -- case GDL_UINT: return product_cu_template(static_cast(p0)->Dup(), nanInt); -- case GDL_LONG: return product_cu_template(static_cast(p0)->Dup(), nanInt); -- case GDL_ULONG: return product_cu_template(static_cast(p0)->Dup(), nanInt); -- case GDL_LONG64: return product_cu_template(static_cast(p0)->Dup(), nanInt); -- case GDL_ULONG64: return product_cu_template(static_cast(p0)->Dup(), nanInt); -- case GDL_FLOAT: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -- case GDL_DOUBLE: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -- case GDL_COMPLEX: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -- case GDL_COMPLEXDBL: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -- default: assert(false); -- } -- } -- -- // Integer parts derivated from Total code by Erin Sheldon -- // In IDL PRODUCT(), the INTEGER keyword takes precedence -- if (KwInt) { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ((p0->Type() == GDL_LONG64) && (!KwNaN)) { -- return product_cu_template -- ( static_cast(p0)->Dup(), nanInt); -- } -- if ((p0->Type() == GDL_ULONG64) && (!KwNaN)) { -- return product_cu_template -- ( static_cast(p0)->Dup(), nanInt); -- } -- // Convert to Long64 -- DLong64GDL* p0L64 = static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -- auto_ptr guard( p0L64); -- if (KwNaN) { -- DFloatGDL* p0f = static_cast -- (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- auto_ptr guard( p0f); -- for( SizeT i=0; i -- ((p0L64)->Dup(), nanInt); -- } // integer results -- -- // special case as GDL_DOUBLE type overrides /GDL_DOUBLE -- if (p0->Type() == GDL_DOUBLE) { -- return product_cu_template< DDoubleGDL> -- ( static_cast(p0)->Dup(), KwNaN); -- } -- if (p0->Type() == GDL_COMPLEXDBL) { -- return product_cu_template< DComplexDblGDL> -- ( static_cast(p0)->Dup(), KwNaN); -- } -- if (p0->Type() == GDL_COMPLEX) { -- return product_cu_template< DComplexDblGDL> -- ( static_cast -- (p0->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY)), KwNaN); -- } -- return product_cu_template< DDoubleGDL> -- ( static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)), KwNaN); -- } -- } -- -- // product over sumDim -- dimension srcDim = p0->Dim(); -- SizeT srcRank = srcDim.Rank(); -- -- if( sumDim < 1 || sumDim > srcRank) -- e->Throw( "Array must have "+i2s(sumDim)+ -- " dimensions: "+e->GetParString(0)); -- -- if (!KwCumul) { -- -- if (KwPre) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -- case GDL_INT: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -- case GDL_UINT: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -- case GDL_LONG: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -- case GDL_ULONG: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -- case GDL_LONG64: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -- case GDL_ULONG64: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -- case GDL_FLOAT: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -- case GDL_DOUBLE: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -- case GDL_COMPLEX: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -- case GDL_COMPLEXDBL: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -- default: assert(false); -- } -- } -- -- // Integer parts derivated from Total code by Erin Sheldon -- // In IDL PRODUCT(), the INTEGER keyword takes precedence -- if (KwInt) { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ((p0->Type() == GDL_LONG64 ) && (!KwNaN)) { -- return product_over_dim_template -- ( static_cast(p0), srcDim, sumDim-1, nanInt); -- } -- if ((p0->Type() == GDL_ULONG64) && (!KwNaN)) { -- return product_over_dim_template -- ( static_cast(p0), srcDim, sumDim-1, nanInt); -- } -- -- // Conver to Long64 -- DLong64GDL* p0L64 = static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -- auto_ptr guard( p0L64); -- if (KwNaN) { -- DFloatGDL* p0f = static_cast -- (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- auto_ptr guard( p0f); -- for( SizeT i=0; i -- ( p0L64, srcDim, sumDim-1, nanInt); -- } // integer results -- -- if( p0->Type() == GDL_DOUBLE) { -- return product_over_dim_template< DDoubleGDL> -- ( static_cast(p0), srcDim, sumDim-1, KwNaN); -- } -- if( p0->Type() == GDL_COMPLEXDBL) { -- return product_over_dim_template< DComplexDblGDL> -- ( static_cast(p0), srcDim, sumDim-1, KwNaN); -- } -- if( p0->Type() == GDL_COMPLEX) { -- DComplexDblGDL* p0D = static_cast -- (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- // p0D_guard.reset( p0D); -- return product_over_dim_template< DComplexDblGDL> -- ( p0D, srcDim, sumDim-1, KwNaN); -- } -- -- DDoubleGDL* p0D = static_cast -- (p0->Convert2( GDL_DOUBLE,BaseGDL::COPY)); -- auto_ptr p0D_guard( p0D); -- //p0D_guard.reset( p0D); -- return product_over_dim_template< DDoubleGDL> -- ( p0D, srcDim, sumDim-1,KwNaN); -- } -- else -- { // KwCumul -- -- if (KwPre) -- { -- switch (p0->Type()) -- { -- case GDL_BYTE: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -- case GDL_INT: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -- case GDL_UINT: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -- case GDL_LONG: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -- case GDL_ULONG: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -- case GDL_LONG64: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -- case GDL_ULONG64: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -- case GDL_FLOAT: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -- case GDL_DOUBLE: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -- case GDL_COMPLEX: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -- case GDL_COMPLEXDBL: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -- default: assert(false); -- } -- } -- -- // Integer parts derivated from Total code by Erin Sheldon -- // In IDL PRODUCT(), the INTEGER keyword takes precedence -- if (KwInt) { -- // We use GDL_LONG64 unless the input is GDL_ULONG64 -- if ((p0->Type() == GDL_LONG64) && (!KwNaN)) { -- return product_over_dim_cu_template -- ( static_cast(p0)->Dup(), sumDim-1, nanInt); -- } -- if ((p0->Type() == GDL_ULONG64 ) && (!KwNaN)) { -- return product_over_dim_cu_template -- ( static_cast(p0)->Dup(), sumDim-1, nanInt); -- } -- -- // Convert to Long64 -- if (KwNaN) { -- DFloatGDL* p0f = static_cast -- (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- auto_ptr guard( p0f); -- for( SizeT i=0; i -- ( static_cast -- (p0f->Convert2( GDL_LONG64, BaseGDL::COPY)), sumDim-1, nanInt); -- } else { -- return product_over_dim_cu_template -- ( static_cast -- (p0->Convert2( GDL_LONG64, BaseGDL::COPY)), sumDim-1, nanInt); -- } -- } // integer results -- -- if( p0->Type() == GDL_DOUBLE) { -- return product_over_dim_cu_template< DDoubleGDL> -- ( static_cast(p0)->Dup(), sumDim-1, KwNaN); -- } -- if( p0->Type() == GDL_COMPLEXDBL) { -- return product_over_dim_cu_template< DComplexDblGDL> -- ( static_cast(p0)->Dup(), sumDim-1, KwNaN); -- } -- if( p0->Type() == GDL_COMPLEX) { -- return product_over_dim_cu_template< DComplexDblGDL> -- ( static_cast -- (p0->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY)), sumDim-1, KwNaN); -- } -- -- return product_over_dim_cu_template< DDoubleGDL> -- ( static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)), sumDim-1, KwNaN); -- } -- } -- -- BaseGDL* array_equal( EnvT* e) -- { -- e->NParam( 2);//, "ARRAY_EQUAL"); -- -- BaseGDL* p0 = e->GetParDefined( 0);//, "ARRAY_EQUAL"); -- BaseGDL* p1 = e->GetParDefined( 1);//, "ARRAY_EQUAL"); -- -- if( p0 == p1) return new DByteGDL( 1); -- -- SizeT nEl0 = p0->N_Elements(); -- SizeT nEl1 = p1->N_Elements(); -- if( nEl0 != nEl1 && nEl0 != 1 && nEl1 != 1) -- return new DByteGDL( 0); -- -- auto_ptr p0_guard; -- auto_ptr p1_guard; -- if( p0->Type() != p1->Type()) -- { -- if( e->KeywordSet( 0)) // NO_TYPECONV -- return new DByteGDL( 0); -- else -- { -- DType aTy=p0->Type(); -- DType bTy=p1->Type(); -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -- { -- p1 = p1->Convert2( aTy, BaseGDL::COPY); -- p1_guard.reset( p1); -- } -- else -- { -- p0 = p0->Convert2( bTy, BaseGDL::COPY); -- p0_guard.reset( p0); -- } -- } -- } -- -- if( p0->ArrayEqual( p1)) return new DByteGDL( 1); -- -- return new DByteGDL( 0); -- } -- -- BaseGDL* min_fun( EnvT* e) -- { -- SizeT nParam = e->NParam( 1); -- BaseGDL* searchArr = e->GetParDefined( 0); -- -- bool omitNaN = e->KeywordSet( "NAN"); -- -- static int subIx = e->KeywordIx("SUBSCRIPT_MAX"); -- bool subMax = e->KeywordPresent(subIx); -- -- static int dimIx = e->KeywordIx("DIMENSION"); -- bool dimSet = e->KeywordSet(dimIx); -- -- static int maxIx = e->KeywordIx("MAX"); -- bool maxSet = e->KeywordPresent(maxIx); -- -- DLong searchDim; -- if (dimSet) { -- e->AssureLongScalarKW(dimIx, searchDim); -- if (searchDim < 0 || searchDim > searchArr->Rank()) -- e->Throw("Illegal keyword value for DIMENSION"); -- } -- -- if (dimSet && searchArr->Rank() > 1) -- { -- searchDim -= 1; // user-supplied dimensions start with 1! -- -- // here destDim is in fact the srcDim... -- dimension destDim = searchArr->Dim(); -- SizeT searchStride = destDim.Stride(searchDim); -- SizeT outerStride = destDim.Stride(searchDim + 1); -- // ... and now becomes the destDim -- SizeT nSearch = destDim.Remove(searchDim); -- SizeT searchLimit = nSearch * searchStride; -- SizeT nEl = searchArr->N_Elements(); -- -- // memory allocation -- BaseGDL *maxVal, *resArr = searchArr->New(destDim, BaseGDL::NOZERO); -- DLongGDL *minElArr, *maxElArr; -- -- if (maxSet) -- { -- e->AssureGlobalKW(maxIx); // instead of using a guard pointer -- maxVal = searchArr->New(destDim, BaseGDL::NOZERO); -- } -- -- if (subMax) -- { -- e->AssureGlobalKW(subIx); // instead of using a guard pointer -- maxElArr = new DLongGDL(destDim); -- } -- -- if (nParam == 2) -- { -- e->AssureGlobalPar(1); // instead of using a guard pointer -- minElArr = new DLongGDL(destDim); -- } -- -- SizeT rIx = 0; -- for (SizeT o = 0; o < nEl; o += outerStride) for (SizeT i = 0; i < searchStride; ++i) -- { -- searchArr->MinMax( -- (nParam == 2 ? &((*minElArr)[rIx]) : NULL), -- (subMax ? &((*maxElArr)[rIx]) : NULL), -- &resArr, -- (maxSet ? &maxVal : NULL), -- omitNaN, o + i, searchLimit + o + i, searchStride, rIx -- ); -- rIx++; -- } -- -- if (nParam == 2) e->SetPar(1, minElArr); -- if (subMax) e->SetKW(subIx, maxElArr); -- if (maxSet) e->SetKW(maxIx, maxVal); -- -- return resArr; -- } -- else -- { -- DLong minEl; -- BaseGDL* res; -- -- if (maxSet) // MAX keyword given -- { -- e->AssureGlobalKW( 0); -- GDLDelete(e->GetKW( 0)); -- DLong maxEl; -- searchArr->MinMax( &minEl, &maxEl, &res, &e->GetKW( 0), omitNaN); -- if (subMax) e->SetKW(subIx, new DLongGDL(maxEl)); -- } -- else // no MAX keyword -- { -- if (subMax) -- { -- DLong maxEl; -- searchArr->MinMax( &minEl, &maxEl, &res, NULL, omitNaN); -- e->SetKW(subIx, new DLongGDL(maxEl)); -- } -- else searchArr->MinMax(&minEl, NULL, &res, NULL, omitNaN); -- } -- -- // handle index -- if (nParam == 2) e->SetPar(1, new DLongGDL( minEl)); -- else SysVar::SetC( minEl); -- return res; -- } -- } -- -- BaseGDL* max_fun( EnvT* e) -- { -- SizeT nParam = e->NParam( 1); -- BaseGDL* searchArr = e->GetParDefined( 0); -- -- bool omitNaN = e->KeywordSet( "NAN"); -- -- static int subIx = e->KeywordIx("SUBSCRIPT_MIN"); -- bool subMin = e->KeywordPresent(subIx); -- -- static int dimIx = e->KeywordIx("DIMENSION"); -- bool dimSet = e->KeywordSet(dimIx); -- -- static int minIx = e->KeywordIx("MIN"); -- bool minSet = e->KeywordPresent(minIx); -- -- DLong searchDim; -- if (dimSet) -- { -- e->AssureLongScalarKW(dimIx, searchDim); -- if (searchDim < 0 || searchDim > searchArr->Rank()) -- e->Throw("Illegal keyword value for DIMENSION"); -- } -- -- if (dimSet && searchArr->Rank() > 1) -- { -- searchDim -= 1; // user-supplied dimensions start with 1! -- -- // here destDim is in fact the srcDim... -- dimension destDim = searchArr->Dim(); -- SizeT searchStride = destDim.Stride(searchDim); -- SizeT outerStride = destDim.Stride(searchDim + 1); -- // ... and now becomes the destDim -- SizeT nSearch = destDim.Remove(searchDim); -- SizeT searchLimit = nSearch * searchStride; -- SizeT nEl = searchArr->N_Elements(); -- -- // memory allocation -- BaseGDL *minVal, *resArr = searchArr->New(destDim, BaseGDL::NOZERO); -- DLongGDL *minElArr, *maxElArr; -- -- if (minSet) -- { -- e->AssureGlobalKW(minIx); // instead of using a guard pointer -- minVal = searchArr->New(destDim, BaseGDL::NOZERO); -- } -- -- if (subMin) -- { -- e->AssureGlobalKW(subIx); // instead of using a guard pointer -- minElArr = new DLongGDL(destDim); -- } -- -- if (nParam == 2) -- { -- e->AssureGlobalPar(1); // instead of using a guard pointer -- maxElArr = new DLongGDL(destDim); -- } -- -- SizeT rIx = 0; -- for (SizeT o = 0; o < nEl; o += outerStride) for (SizeT i = 0; i < searchStride; ++i) -- { -- searchArr->MinMax( -- (subMin ? &((*minElArr)[rIx]) : NULL), -- (nParam == 2 ? &((*maxElArr)[rIx]) : NULL), -- (minSet ? &minVal : NULL), -- &resArr, -- omitNaN, o + i, searchLimit + o + i, searchStride, rIx -- ); -- rIx++; -- } -- -- if (nParam == 2) e->SetPar(1, maxElArr); -- if (subMin) e->SetKW(subIx, minElArr); -- if (minSet) e->SetKW(minIx, minVal); -- -- return resArr; -- } -- else -- { -- DLong maxEl; -- BaseGDL* res; -- -- if (minSet) // MIN keyword given -- { -- e->AssureGlobalKW( 0); -- GDLDelete(e->GetKW( 0)); -- DLong minEl; -- searchArr->MinMax( &minEl, &maxEl, &e->GetKW( 0), &res, omitNaN); -- if (subMin) e->SetKW(subIx, new DLongGDL(minEl)); -- } -- else // no MIN keyword -- { -- if (subMin) -- { -- DLong minEl; -- searchArr->MinMax( &minEl, &maxEl, NULL, &res, omitNaN); -- e->SetKW(subIx, new DLongGDL(minEl)); -- } -- else searchArr->MinMax(NULL, &maxEl, NULL, &res, omitNaN); -- } -- -- // handle index -- if (nParam == 2) e->SetPar(1, new DLongGDL( maxEl)); -- else SysVar::SetC(maxEl); -- return res; -- } -- } -- --BaseGDL* transpose( EnvT* e) -- { -- SizeT nParam=e->NParam( 1); -- -- BaseGDL* p0 = e->GetParDefined( 0); -- if( p0->Type() == GDL_STRUCT) -- e->Throw("Struct expression not allowed in this context: "+ -- e->GetParString(0)); -- -- SizeT rank = p0->Rank(); -- if( rank == 0) -- e->Throw( "Expression must be an array " -- "in this context: "+ e->GetParString(0)); -- -- if( nParam == 2) -- { -- -- BaseGDL* p1 = e->GetParDefined( 1); -- if( p1->N_Elements() != rank) -- e->Throw("Incorrect number of elements in permutation."); -- -- DUInt* perm = new DUInt[rank]; -- auto_ptr perm_guard( perm); -- -- DUIntGDL* p1L = static_cast -- (p1->Convert2( GDL_UINT, BaseGDL::COPY)); -- for( SizeT i=0; iThrow( "Incorrect permutation vector."); -- } -- return p0->Transpose( perm); -- } -- -- return p0->Transpose( NULL); -- } -- -- --// BaseGDL* matrix_multiply( EnvT* e) --// { --// SizeT nParam=e->NParam( 2); --// --// BaseGDL* a = e->GetNumericArrayParDefined( 0); --// BaseGDL* b = e->GetNumericArrayParDefined( 1); --// --// static int aTIx = e->KeywordIx("ATRANSPOSE"); --// bool aT = e->KeywordPresent(aTIx); --// static int bTIx = e->KeywordIx("BTRANSPOSE"); --// bool bT = e->KeywordPresent(bTIx); --// --// static int strassenIx = e->KeywordIx("STRASSEN_ALGORITHM"); --// bool strassen = e->KeywordPresent(strassenIx); --// --// --// if( p1->N_Elements() != rank) --// e->Throw("Incorrect number of elements in permutation."); --// --// DUInt* perm = new DUInt[rank]; --// auto_ptr perm_guard( perm); --// --// DUIntGDL* p1L = static_cast --// (p1->Convert2( GDL_UINT, BaseGDL::COPY)); --// for( SizeT i=0; iThrow( "Incorrect permutation vector."); --// } --// return p0->Transpose( perm); --// } --// --// return a->Transpose( NULL); --// } -- -- // helper function for sort_fun, recursive -- // optimized version -- template< typename IndexT> -- void MergeSortOpt( BaseGDL* p0, IndexT* hhS, IndexT* h1, IndexT* h2, -- SizeT len) -- { -- if( len <= 1) return; -- -- SizeT h1N = len / 2; -- SizeT h2N = len - h1N; -- -- // 1st half -- MergeSortOpt(p0, hhS, h1, h2, h1N); -- -- // 2nd half -- IndexT* hhM = &hhS[h1N]; -- MergeSortOpt(p0, hhM, h1, h2, h2N); -- -- SizeT i; -- for(i=0; iGreater( h1[h1Ix], h2[h2Ix])) -- hhS[ i] = h2[ h2Ix++]; -- else -- hhS[ i] = h1[ h1Ix++]; -- } -- for(; h1Ix < h1N; ++i) hhS[ i] = h1[ h1Ix++]; -- for(; h2Ix < h2N; ++i) hhS[ i] = h2[ h2Ix++]; -- } -- -- // helper function for sort_fun, recursive -- void MergeSort( BaseGDL* p0, SizeT* hh, SizeT* h1, SizeT* h2, -- SizeT start, SizeT end) -- { -- if( start+1 >= end) return; -- -- SizeT middle = (start+end) / 2; -- -- MergeSort(p0, hh, h1, h2, start, middle); -- MergeSort(p0, hh, h1, h2, middle, end); -- -- SizeT h1N = middle - start; -- SizeT h2N = end - middle; -- -- SizeT* hhS = &hh[start]; -- -- SizeT i; -- for(i=0; iGreater( h1[h1Ix], h2[h2Ix])) -- hhS[ i] = h2[ h2Ix++]; -- else -- hhS[ i] = h1[ h1Ix++]; -- } -- for(; h1Ix < h1N; ++i) hhS[ i] = h1[ h1Ix++]; -- for(; h2Ix < h2N; ++i) hhS[ i] = h2[ h2Ix++]; -- } -- -- // sort function uses MergeSort -- BaseGDL* sort_fun( EnvT* e) -- { -- e->NParam( 1); -- -- BaseGDL* p0 = e->GetParDefined( 0); -- -- if( p0->Type() == GDL_STRUCT) -- e->Throw( "Struct expression not allowed in this context: "+ -- e->GetParString(0)); -- -- static int l64Ix = e->KeywordIx( "L64"); -- bool l64 = e->KeywordSet( l64Ix); -- -- SizeT nEl = p0->N_Elements(); -- -- // helper arrays -- DLongGDL* res = new DLongGDL( dimension( nEl), BaseGDL::INDGEN); -- -- DLong nanIx = nEl; -- if( p0->Type() == GDL_FLOAT) -- { -- DFloatGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) -- { -- if( isnan((*p0F)[ i]) )//|| !isfinite((*p0F)[ i])) -- { -- --nanIx; -- (*res)[i] = (*res)[nanIx]; -- (*res)[ nanIx] = i; -- --// cout << "swap " << i << " with " << nanIx << endl; --// cout << "now: "; --// for( DLong ii=0; ii < nEl; ++ii) --// { --// cout << (*res)[ii] << " "; --// } --// cout << endl; -- } -- } -- } -- else if( p0->Type() == GDL_DOUBLE) -- { -- DDoubleGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) -- { -- if( isnan((*p0F)[ i]))// || !isfinite((*p0F)[ i])) -- { -- --nanIx; -- (*res)[i] = (*res)[nanIx]; -- (*res)[ nanIx] = i; -- } -- } -- } -- else if( p0->Type() == GDL_COMPLEX) -- { -- DComplexGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) -- { -- if( isnan((*p0F)[ i].real()) || //!isfinite((*p0F)[ i].real()) || -- isnan((*p0F)[ i].imag()))// || !isfinite((*p0F)[ i].imag()) ) -- { -- --nanIx; -- (*res)[i] = (*res)[nanIx]; -- (*res)[ nanIx] = i; -- } -- } -- } -- else if( p0->Type() == GDL_COMPLEXDBL) -- { -- DComplexDblGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) -- { -- if( isnan((*p0F)[ i].real()) || //!isfinite((*p0F)[ i].real()) || -- isnan((*p0F)[ i].imag()))// || !isfinite((*p0F)[ i].imag()) ) -- { -- --nanIx; -- (*res)[i] = (*res)[nanIx]; -- (*res)[ nanIx] = i; -- } -- } -- } -- --// cout << "nEl " << nEl << " nanIx " << nanIx << endl; -- nEl = nanIx; --// cout << "sorting: "; --// for( DLong ii=0; ii < nEl; ++ii) --// { --// cout << (*res)[ii] << " "; --// } --// cout << endl; -- -- DLong *hh = static_cast(res->DataAddr()); -- -- DLong* h1 = new DLong[ nEl/2]; -- DLong* h2 = new DLong[ (nEl+1)/2]; -- // call the sort routine -- MergeSortOpt( p0, hh, h1, h2, nEl); -- delete[] h1; -- delete[] h2; -- -- if( l64) -- { -- // leave it this way, as sorting of more than 2^31 -- // items seems not feasible in the future we might -- // use MergeSortOpt(...) for this -- return res->Convert2( GDL_LONG64); -- } -- -- return res; -- } -- -- // uses MergeSort -- // 2 parts in the code: without "width" or with "width" (limited to 1D and 2D) -- BaseGDL* median( EnvT* e) { -- -- BaseGDL* p0 = e->GetParDefined( 0); -- -- if( p0->Type() == GDL_PTR) -- e->Throw( "Pointer expression not allowed in this context: "+ e->GetParString(0)); -- if( p0->Type() == GDL_OBJ) -- e->Throw( "Object expression not allowed in this context: "+ e->GetParString(0)); -- if( p0->Type() == GDL_STRUCT) -- e->Throw( "Struct expression not allowed in this context: "+ e->GetParString(0)); -- -- if( p0->Rank() == 0) -- e->Throw( "Expression must be an array in this context: "+ e->GetParString(0)); -- -- SizeT nParam = e->NParam( 1); -- SizeT nEl = p0->N_Elements(); -- -- // "f_nan" and "d_nan" used by both parts ... -- static DStructGDL *Values = SysVar::Values(); -- DFloat f_nan=(*static_cast(Values->GetTag(Values->Desc()->TagIndex("F_NAN"), 0)))[0]; -- DDouble d_nan=(*static_cast(Values->GetTag(Values->Desc()->TagIndex("D_NAN"), 0)))[0]; -- -- // -------------------------------------------------------- -- // begin of the part 1: without "width" param -- if( nParam == 1) { -- -- static int evenIx = e->KeywordIx( "EVEN"); -- -- // TYPE -- bool dbl = -- p0->Type() == GDL_DOUBLE || -- p0->Type() == GDL_COMPLEXDBL || -- e->KeywordSet(e->KeywordIx("DOUBLE")); -- DType type = dbl ? GDL_DOUBLE : GDL_FLOAT; -- bool noconv = (dbl && p0->Type() == GDL_DOUBLE) || -- (!dbl && p0->Type() == GDL_FLOAT); -- -- // DIMENSION keyword -- DLong dim = 0; -- DLong nmed = 1; -- BaseGDL *res; -- e->AssureLongScalarKWIfPresent( "DIMENSION", dim); -- -- // cout << "dim : "<< dim << endl; -- -- if (dim > p0->Rank()) -- e->Throw( "Illegal keyword value for DIMENSION."); -- -- if (dim > 0) { -- DLong dims[8]; -- DLong k = 0; -- for (SizeT i=0; iRank(); ++i) -- if (i != (dim-1)) { -- nmed *= p0->Dim(i); -- dims[k++] = p0->Dim(i); -- } -- dimension dimRes((DLong *) dims, p0->Rank()-1); -- res = dbl -- ? static_cast(new DDoubleGDL(dimRes, BaseGDL::NOZERO)) -- : static_cast(new DFloatGDL(dimRes, BaseGDL::NOZERO)); -- } else { -- res = dbl -- ? static_cast(new DDoubleGDL(1)) -- : static_cast(new DFloatGDL(1)); -- } -- -- // conversion of Complex types -- if (p0->Type() == GDL_COMPLEX) p0 = p0->Convert2(GDL_FLOAT, BaseGDL::COPY); -- if (p0->Type() == GDL_COMPLEXDBL) p0 = p0->Convert2(GDL_DOUBLE, BaseGDL::COPY); -- -- // helper arrays -- if (nmed > 1) nEl = p0->N_Elements() / nmed; -- -- // cout << "hello2" << endl; -- -- DLong *hh = new DLong[ nEl]; -- DLong* h1 = new DLong[ nEl/2]; -- DLong* h2 = new DLong[ (nEl+1)/2]; -- -- DLong accumStride = 1; -- if (nmed > 1) -- for( DLong i=0; iDim(i); -- -- BaseGDL *op1, *op2, *op3; -- if (dbl) op3 = new DDoubleGDL(2); -- else op3 = new DFloatGDL(2); -- -- // nEl_extern is used to store "nEl" initial value -- DLong nanIx, nEl_extern; -- nEl_extern=nEl; -- // if (nmed > 1) nEl_extern = p0->N_Elements() / nmed; -- //else nEl_extern = p0->N_Elements(); -- -- // cout << "hello type" << p0->Type() << endl; -- -- // Loop over all subarray medians -- for (SizeT k=0; kType() == GDL_DOUBLE) { -- DDoubleGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) { -- if( isnan((*p0F)[i])) { -- --nanIx; -- hh[i] = hh[nanIx]; -- hh[ nanIx] = i; -- } -- } -- } -- -- if (p0->Type() == GDL_FLOAT) { -- DFloatGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) { -- if( isnan((*p0F)[i])) { -- --nanIx; -- hh[i] = hh[nanIx]; -- hh[ nanIx] = i; -- } -- } -- } -- -- //cout << "nEl " << nEl << " nanIx " << nanIx << endl; -- nEl = nanIx; -- } -- else -- { -- nanIx = nEl; -- nEl=nEl_extern; -- -- // DLong nanIx = nEl; -- // Starting Element -- DLong start = accumStride * p0->Dim(dim-1) * (k / accumStride) + -- (k % accumStride); -- for( DLong i=0; iType() == GDL_FLOAT) { -- DFloatGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) { -- jj=start + i * accumStride; -- if( isnan((*p0F)[ jj]) ) { -- --nanIx; -- hh[i] = hh[nanIx]; -- hh[ nanIx] = i; -- } -- } -- nEl = nanIx; -- } -- -- if (p0->Type() == GDL_DOUBLE) { -- DDoubleGDL* p0F = static_cast(p0); -- for( DLong i=nEl-1; i >= 0; --i) { -- jj=start + i * accumStride; -- if( isnan((*p0F)[ jj]) ) { -- --nanIx; -- hh[i] = hh[nanIx]; -- hh[ nanIx] = i; -- } -- } -- //cout << "nanIx :" << nanIx << "nEl :" << nEl << endl; -- nEl = nanIx; -- } -- } -- DLong medEl, medEl_1; -- -- // call the sort routine -- if (nEl > 1) { -- MergeSortOpt( p0, hh, h1, h2, nEl); -- medEl = hh[ nEl/2]; -- medEl_1 = hh[ nEl/2 - 1]; -- } else { -- if (nEl == 1) { -- medEl = hh[0]; -- medEl_1 = hh[0]; -- } else -- { // normal case, more than one element, nothing to do -- //cout << "gasp : no result ! " << endl; -- } -- } -- -- if (nEl <= 0) { // we have a NaN -- if (dbl) (*static_cast(res))[k] = d_nan; -- else (*static_cast(res))[k] = f_nan; -- } else { -- //cout << k << "" << (*static_cast(p0))[medEl] << " " -- // << (*static_cast(p0))[medEl_1] << endl; -- //cout << "k :" << k << endl; -- if( (nEl % 2) == 1 || !e->KeywordSet( evenIx)) { -- if (nmed == 1) -- res = p0->NewIx(medEl)->Convert2(type, BaseGDL::CONVERT); -- else { -- if (noconv) -- { -- if (dbl) (*static_cast(res))[k] = (*static_cast(p0))[medEl]; -- else (*static_cast(res))[k] = (*static_cast(p0))[medEl]; -- } -- else -- { -- op1 = p0->NewIx(medEl)->Convert2(type, BaseGDL::CONVERT); -- if (dbl) (*static_cast(res))[k] = (*static_cast(op1))[0]; -- else (*static_cast(res))[k] = (*static_cast(op1))[0]; -- delete(op1); -- } -- } -- } else { -- if (noconv) -- { -- if (dbl) (*static_cast(res))[k] = .5 * ( -- (*static_cast(p0))[medEl] + -- (*static_cast(p0))[medEl_1] -- ); -- else (*static_cast(res))[k] = .5 * ( -- (*static_cast(p0))[medEl] + -- (*static_cast(p0))[medEl_1] -- ); -- } -- else -- { -- op1 = p0->NewIx(medEl)->Convert2(type, BaseGDL::CONVERT); -- op2 = p0->NewIx(medEl_1)->Convert2(type, BaseGDL::CONVERT); -- if (nmed == 1) res = op2->Add(op1)->Div(op3); // TODO: leak with res? -- else -- { -- if (dbl) (*static_cast(res))[k] = -- (*static_cast((op2->Add(op1)->Div(op3))))[0]; -- else (*static_cast(res))[k] = -- (*static_cast((op2->Add(op1)->Div(op3))))[0]; -- delete(op2); -- } -- delete(op1); -- } -- } -- } -- } -- delete(op3); -- delete[] h1; -- delete[] h2; -- delete[] hh; -- -- return res; -- } -- -- // begin of the part 2: with "width" param -- if( nParam == 2) { -- // with parameter Width : median filtering with no optimisation, -- // such as histogram algorithms. -- // Copyright: (C) 2008 by Nicolas Galmiche -- -- // basic checks on "vector/array" input -- DDoubleGDL* p0 = e->GetParAs( 0); -- -- if( p0->Rank() > 2) -- e->Throw( "Only 1 or 2 dimensions allowed: "+ e->GetParString(0)); -- -- // basic checks on "width" input -- DDoubleGDL* p1d = e->GetParAs(1); -- -- if (p1d->N_Elements() > 1 || (*p1d)[0] <=0 ) -- e->Throw( "Width must be a positive scalar or 1 (positive) element array in this context: "+ e->GetParString(0)); -- DLong MaxAllowedWidth=0; -- if (p0->Rank() == 1) MaxAllowedWidth=p0->N_Elements(); -- if (p0->Rank() == 2) { -- MaxAllowedWidth=p0->Dim(0); -- if (p0->Dim(1) < MaxAllowedWidth) MaxAllowedWidth=p0->Dim(1); -- } -- const int debug =0; -- if (debug == 1) { -- cout << "X dim " << p0->Dim(0) <Dim(1) <Throw("Width must be > 1, and < dimension of array (NaN or Inf)"); -- -- DLongGDL* p1 = e->GetParAs(1); -- -- DDoubleGDL *tamp = new DDoubleGDL(p0->Dim(),BaseGDL::NOZERO); -- DDouble min=((*p0)[0]); -- DDouble max=min; -- -- for (SizeT ii=0 ; iiN_Elements() ; ++ii) -- {(*tamp)[ii]=(*p0)[ii]; -- if ( (*p0)[ii] < min ) min = ((*p0)[ii]); -- if ( (*p0)[ii] > max ) max = ((*p0)[ii]); -- } -- -- //---------------------------- END d'acquisistion des paramètres ------------------------------------- -- -- -- static int evenIx = e->KeywordIx( "EVEN"); -- static int doubleIx = e->KeywordIx( "DOUBLE"); -- static DStructGDL *Values = SysVar::Values(); -- DDouble d_nan=(*static_cast(Values->GetTag(Values->Desc()->TagIndex("D_NAN"), 0)))[0]; -- DDouble d_infinity= (*static_cast(Values->GetTag(Values->Desc()->TagIndex("D_INFINITY"), 0)))[0]; -- -- //------------------------------ Init variables and allocation --------------------------------------- -- SizeT width=(*p1)[0]; -- SizeT N_MaskElem= width*width; -- SizeT larg = p0->Stride(1); -- SizeT haut = p0->Stride(2)/larg; -- SizeT lim= static_cast(round(width/2)); -- SizeT init=(lim*larg+lim); -- -- // we don't go further if dimension(s) versus not width OK -- -- if (debug == 1) {cout << "ici" <Rank() == 1) { -- if (larg < width || width==1 ) e->Throw( "Width must be > 1, and < width of vector"); -- } -- if ( p0->Rank() == 2) { -- if (larg < width || haut < width || width==1) e->Throw("Width must be > 1, and < dimension of array"); -- } -- -- // for 2D arrays, we use the algorithm described in paper -- // from T. Huang, G. Yang, and G. Tang, “A Fast Two-Dimensional Median -- // Filtering Algorithm,†IEEE Trans. Acoust., Speech, Signal Processing, -- // vol. 27, no. 1, pp. 13–18, 1979. -- -- if ( (e->GetParDefined( 0)->Type() == GDL_BYTE || -- e->GetParDefined( 0)->Type() == GDL_INT || -- e->GetParDefined( 0)->Type() == GDL_UINT || -- e->GetParDefined( 0)->Type() == GDL_LONG || -- e->GetParDefined( 0)->Type() == GDL_ULONG || -- e->GetParDefined( 0)->Type() == GDL_LONG64 || -- e->GetParDefined( 0)->Type() == GDL_ULONG64) && -- (haut>1)) -- { -- SizeT taille=static_cast(abs(max)-min+1); -- DDoubleGDL* Histo = new DDoubleGDL(taille,BaseGDL::NOZERO); -- if (width % 2 ==0) -- { -- for(SizeT i=0 ; i((*p0)[ii+yy*larg]-min)]++; -- } -- -- while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -- { -- ltmed+= static_cast((*Histo)[med]); -- ++med; -- } -- if (e->KeywordSet( evenIx)) -- { -- -- SizeT EvenMed=med; -- //if ((*Histo)[EvenMed]==1 || (ltmed!=0 && ltmed !=(N_MaskElem /2) -1)) -- if ((*Histo)[EvenMed]==1 || (ltmed!=0 && N_MaskElem /2- ltmed!=1) ) -- { -- while ((*Histo)[EvenMed-1]==0) -- { EvenMed--;} -- (*tamp)[init+i*larg]=((med+min)+(EvenMed-1+min))/2; -- } -- else -- (*tamp)[init+i*larg]=med+min; -- } -- else -- {(*tamp)[init+i*larg]=med+min; } -- -- for(SizeT j=init+i*larg +1; j((*p0)[initMask-1+k*larg]-min)]--; -- if ((*p0)[initMask-1+k*larg]-min((*p0)[initMask+k*larg+2*lim-1]-min)]++; -- if ((*p0)[initMask+k*larg+2*lim-1]-minN_MaskElem /2) -- { -- while(ltmed>N_MaskElem /2) -- { -- --med; -- ltmed-=static_cast((*Histo)[med]); -- } -- } -- else -- { -- while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -- { -- ltmed+= static_cast((*Histo)[med]); -- ++med; -- } -- } -- -- if (e->KeywordSet( evenIx)) -- { -- SizeT EvenMed=med; -- if ((*Histo)[EvenMed]==1 || (ltmed!=0 &&N_MaskElem /2- ltmed!=1 )) -- { -- while ((*Histo)[EvenMed-1]==0) -- { EvenMed--;} -- (*tamp)[j]=((med+min)+(EvenMed-1+min))/2; -- } -- else -- {(*tamp)[j]=med+min; } -- } -- else -- {(*tamp)[j]=med+min; } -- } -- } -- } -- else -- { -- for(SizeT i=0 ; i((*p0)[ii+yy*larg]-min)]++; -- } -- -- while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -- { -- ltmed+= static_cast((*Histo)[med]); -- ++med; -- } -- (*tamp)[init+i*larg]=med+min; -- -- for(SizeT j=init+i*larg +1; j((*p0)[initMask-1+k*larg]-min)]--; -- if ((*p0)[initMask-1+k*larg]-min((*p0)[initMask+k*larg+2*lim]-min)]++; -- if ((*p0)[initMask+k*larg+2*lim]-minN_MaskElem /2) -- { -- while(ltmed>N_MaskElem /2) -- { -- --med; -- ltmed-=static_cast((*Histo)[med]); -- } -- } -- else -- { -- while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -- { -- ltmed+= static_cast((*Histo)[med]); -- ++med; -- } -- } -- -- (*tamp)[j]=med+min; -- -- } -- } -- } -- -- } -- else -- { -- DLong* hh; -- DLong* h1; -- DLong* h2; -- DDoubleGDL* Mask,*Mask1D; -- if ( p0->Rank() != 1 ) -- { -- hh = new DLong[ N_MaskElem]; -- h1 = new DLong[ N_MaskElem/2]; -- h2= new DLong[ (N_MaskElem+1)/2]; -- Mask = new DDoubleGDL(N_MaskElem,BaseGDL::NOZERO); -- -- for( DLong i=0; iRank() == 1 )//------------------------ For a vector with even width ------------------- -- { -- for (SizeT col= lim ; col(Mask1Dbis); -- MergeSortOpt( besort, hhbis, h1bis, h2bis,(width - ctl_NaN)); -- if (e->KeywordSet( evenIx)&& (width - ctl_NaN) % 2 == 0) -- (*tamp)[col]=((*Mask1Dbis)[hhbis[ (width-ctl_NaN)/2]]+(*Mask1Dbis -- )[hhbis [ (width - ctl_NaN-1)/2]])/2; -- else -- (*tamp)[col]=(*Mask1Dbis)[hhbis[ (width- ctl_NaN)/2]]; -- delete[]hhbis; -- delete[]h2bis; -- delete[]h1bis; -- } -- } -- else -- { -- BaseGDL* besort=static_cast(Mask1D); -- MergeSortOpt( besort, hh, h1, h2,width ); // call the sort routine -- -- if (e->KeywordSet( evenIx)) -- -- (*tamp)[col]=((*Mask1D)[hh[ width/2]]+(*Mask1D)[hh[ (width-1)/2]])/2; -- else -- (*tamp)[col]=(*Mask1D)[hh[ width/2]];// replace value by Mask median -- } -- } -- -- } -- else//------------------------ For an array with even width ------------------- -- { -- SizeT jj; -- for(SizeT i=0 ; i(Maskb); -- MergeSortOpt( besort, hhb, h1b, h2b,(N_MaskElem - ctl_NaN)); -- if ((N_MaskElem - ctl_NaN) % 2 == 0 && e->KeywordSet( evenIx)) -- (*tamp)[j]=((*Maskb)[hhb[ (N_MaskElem-ctl_NaN)/2]]+(*Maskb)[hhb -- [ (N_MaskElem - -- ctl_NaN-1)/2]])/2; -- else -- (*tamp)[j]=(*Maskb)[hhb[ (N_MaskElem- ctl_NaN)/2]]; -- delete[]hhb; -- delete[]h2b; -- delete[]h1b; -- } -- } -- else -- { -- BaseGDL* besort=static_cast(Mask); -- MergeSortOpt( besort, hh, h1, h2, N_MaskElem); // call the sort routine -- if (e->KeywordSet( evenIx)) -- (*tamp)[j]=((*Mask)[hh[ N_MaskElem/2]]+(*Mask)[hh[ (N_MaskElem-1)/2]])/2; -- else -- (*tamp)[j]=(*Mask)[hh[ N_MaskElem/2]];// replace value by median Mask one -- } -- } -- } -- } -- } -- -- else -- { -- if ( p0->Rank() == 1 )//------------------------ For a vector with odd width ------------------- -- -- { -- for (SizeT col= lim ; col(Mask1Dbis); -- MergeSortOpt( besort, hhbis, h1bis, h2bis,(width - ctl_NaN)); -- if (e->KeywordSet( evenIx)&& (width - ctl_NaN) % 2 == 0) -- (*tamp)[col]=((*Mask1Dbis)[hhbis[ (width-ctl_NaN)/2]]+(*Mask1Dbis -- )[hhbis [ (width - ctl_NaN-1)/2]])/2; -- else(*tamp)[col]=(*Mask1Dbis)[hhbis[ (width- ctl_NaN)/2]]; -- delete[]hhbis; -- delete[]h2bis; -- delete[]h1bis; -- } -- } -- else -- { -- BaseGDL* besort=static_cast(Mask1D); -- MergeSortOpt( besort, hh, h1, h2,width ); // call the sort routine -- (*tamp)[col]=(*Mask1D)[hh[ (width)/2]]; // replace value by Mask median -- } -- } -- -- } -- -- else //----------------------------- For an array with odd width --------------------------------- -- { -- SizeT jj; -- for(SizeT i=0 ; i(Maskb); -- MergeSortOpt( besort, hhb, h1b, h2b,(N_MaskElem - ctl_NaN)); -- if ((N_MaskElem - ctl_NaN) % 2 == 0 && e->KeywordSet( evenIx)) -- (*tamp)[j]=((*Maskb)[hhb[ (N_MaskElem-ctl_NaN)/2]]+(*Maskb)[hhb -- [ (N_MaskElem - -- ctl_NaN-1)/2]])/2; -- else(*tamp)[j]=(*Maskb)[hhb[(N_MaskElem- ctl_NaN)/2]]; -- delete[]hhb; -- delete[]h2b; -- delete[]h1b; -- } -- } -- else -- { -- BaseGDL* besort=static_cast(Mask); -- MergeSortOpt( besort, hh, h1, h2, N_MaskElem); // call the sort routine -- (*tamp)[j]=(*Mask)[hh[ (N_MaskElem)/2]]; // replace value by Mask median -- } -- } -- } -- } -- } -- -- //--------------------------- END OF MEDIAN FILTER ALOGORITHMS ----------------------------------- -- -- delete[] h1; -- delete[] h2; -- delete[] hh; -- } -- if ( e->GetParDefined( 0)->Type() == GDL_DOUBLE || p0->Type() == GDL_COMPLEXDBL ||e->KeywordSet( doubleIx) ) -- return tamp; -- else if (e->GetParDefined( 0)->Type() == GDL_BYTE) -- return tamp->Convert2(GDL_BYTE,BaseGDL::CONVERT); -- -- return tamp->Convert2(GDL_FLOAT,BaseGDL::CONVERT); -- -- }// end if -- -- }// end of median -- -- BaseGDL* shift_fun( EnvT* e) -- { -- SizeT nParam = e->NParam( 2); -- -- BaseGDL* p0 = e->GetParDefined( 0); -- -- SizeT nShift = nParam - 1; -- if( nShift == 1) -- { -- DLong s1; -- e->AssureLongScalarPar( 1, s1); -- -- // IncRef[Obj] done for GDL_PTR and GDL_OBJ -- return p0->CShift( s1); -- } -- -- if( p0->Rank() != nShift) -- e->Throw( "Incorrect number of arguments."); -- -- DLong sIx[ MAXRANK]; -- for( SizeT i=0; i< nShift; i++) -- e->AssureLongScalarPar( i+1, sIx[ i]); -- -- if( p0->Type() == GDL_OBJ) -- GDLInterpreter::IncRefObj( static_cast(p0)); -- else if( p0->Type() == GDL_PTR) -- GDLInterpreter::IncRef( static_cast(p0)); -- -- return p0->CShift( sIx); -- } -- -- BaseGDL* arg_present( EnvT* e) -- { -- e->NParam( 1); -- -- if( !e->GlobalPar( 0)) -- return new DIntGDL( 0); -- -- EnvBaseT* caller = e->Caller(); -- if( caller == NULL) -- return new DIntGDL( 0); -- -- BaseGDL** pp0 = &e->GetPar( 0); -- -- int ix = caller->FindGlobalKW( pp0); -- if( ix == -1) -- return new DIntGDL( 0); -- -- return new DIntGDL( 1); -- } -- -- BaseGDL* eof_fun( EnvT* e) -- { -- e->NParam( 1); -- -- DLong lun; -- e->AssureLongScalarPar( 0, lun); -- -- bool stdLun = check_lun( e, lun); -- if( stdLun) -- return new DIntGDL( 0); -- -- // nicer error message (Disregard if socket) -- if ( fileUnits[ lun-1].SockNum() == -1) { -- if( !fileUnits[ lun-1].IsOpen()) -- throw GDLIOException( e->CallingNode(), "File unit is not open: "+i2s( lun)+"."); -- -- if( fileUnits[ lun-1].Eof()) -- return new DIntGDL( 1); -- } else { -- // Socket -- string *recvBuf = &fileUnits[ lun-1].RecvBuf(); -- if (recvBuf->size() == 0) -- return new DIntGDL( 1); -- } -- return new DIntGDL( 0); -- } -- -- BaseGDL* convol( EnvT* e) -- { -- SizeT nParam=e->NParam( 2); -- -- BaseGDL* p0 = e->GetNumericParDefined( 0); -- if( p0->Rank() == 0) -- e->Throw( "Expression must be an array in this context: "+ -- e->GetParString(0)); -- -- BaseGDL* p1 = e->GetNumericParDefined( 1); -- if( p1->Rank() == 0) -- e->Throw( "Expression must be an array in this context: "+ -- e->GetParString(1)); -- -- if( p0->N_Elements() <= p1->N_Elements()) -- e->Throw( "Incompatible dimensions for Array and Kernel."); -- -- // rank 1 for kernel works always -- if( p1->Rank() != 1) -- { -- SizeT rank = p0->Rank(); -- if( rank != p1->Rank()) -- e->Throw( "Incompatible dimensions for Array and Kernel."); -- -- for( SizeT r=0; rDim( r) <= p1->Dim( r)) -- e->Throw( "Incompatible dimensions for Array and Kernel."); -- } -- -- // convert kernel to array type -- auto_ptr p1Guard; -- if( p0->Type() == GDL_BYTE) -- { -- if( p1->Type() != GDL_INT) -- { -- p1 = p1->Convert2( GDL_INT, BaseGDL::COPY); -- p1Guard.reset( p1); -- } -- } -- else if( p0->Type() != p1->Type()) -- { -- p1 = p1->Convert2( p0->Type(), BaseGDL::COPY); -- p1Guard.reset( p1); -- } -- -- BaseGDL* scale; -- auto_ptr scaleGuard; -- if( nParam > 2) -- { -- scale = e->GetParDefined( 2); -- if( scale->Rank() > 0) -- e->Throw( "Expression must be a scalar in this context: "+ -- e->GetParString(2)); -- -- // p1 here handles GDL_BYTE case also -- if( p1->Type() != scale->Type()) -- { -- scale = scale->Convert2( p1->Type(),BaseGDL::COPY); -- scaleGuard.reset( scale); -- } -- } -- else -- { -- scale = p1->New( dimension(), BaseGDL::ZERO); -- } -- -- bool center = true; -- static int centerIx = e->KeywordIx( "CENTER"); -- if( e->KeywordPresent( centerIx)) -- { -- DLong c; -- e->AssureLongScalarKW( centerIx, c); -- center = (c != 0); -- } -- -- // overrides EDGE_TRUNCATE -- static int edge_wrapIx = e->KeywordIx( "EDGE_WRAP"); -- bool edge_wrap = e->KeywordSet( edge_wrapIx); -- static int edge_truncateIx = e->KeywordIx( "EDGE_TRUNCATE"); -- bool edge_truncate = e->KeywordSet( edge_truncateIx); -- -- int edgeMode = 0; -- if( edge_wrap) -- edgeMode = 1; -- else if( edge_truncate) -- edgeMode = 2; -- -- // p0, p1 and scale have same type -- // p1 has rank of 1 or same rank as p0 with each dimension smaller than p0 -- // scale is a scalar -- return p0->Convol( p1, scale, center, edgeMode); -- } -- -- BaseGDL* rebin_fun( EnvT* e) -- { -- SizeT nParam = e->NParam( 2); -- -- BaseGDL* p0 = e->GetNumericParDefined( 0); -- -- SizeT rank = p0->Rank(); -- -- if( rank == 0) -- e->Throw( "Expression must be an array in this context: "+ -- e->GetParString(0)); -- -- SizeT resDimInit[ MAXRANK]; -- -- DLongGDL* p1 = e->GetParAs(1); -- if (p1->Rank() > 0 && nParam > 2) -- e->Throw("The new dimensions must either be specified as an array or as a set of scalars."); -- SizeT np = p1->Rank() == 0 ? nParam : p1->N_Elements() + 1; -- -- for( SizeT p=1; pRank() == 0) e->AssureLongScalarPar( p, newDim); -- else newDim = (*p1)[p - 1]; -- -- if( newDim <= 0) -- e->Throw( "Array dimensions must be greater than 0."); -- -- if( rank >= p) -- { -- SizeT oldDim = p0->Dim( p-1); -- -- if( newDim > oldDim) -- { -- if( (newDim % oldDim) != 0) -- e->Throw( "Result dimensions must be integer factor " -- "of original dimensions."); -- } -- else -- { -- if( (oldDim % newDim) != 0) -- e->Throw( "Result dimensions must be integer factor " -- "of original dimensions."); -- } -- } -- -- resDimInit[ p-1] = newDim; -- } -- -- dimension resDim( resDimInit, np-1); -- -- static int sampleIx = e->KeywordIx( "SAMPLE"); -- bool sample = e->KeywordSet( sampleIx); -- -- return p0->Rebin( resDim, sample); -- } -- -- BaseGDL* obj_class( EnvT* e) -- { -- SizeT nParam = e->NParam(); -- -- static int countIx = e->KeywordIx( "COUNT"); -- static int superIx = e->KeywordIx( "SUPERCLASS"); -- -- bool super = e->KeywordSet( superIx); -- -- bool count = e->KeywordPresent( countIx); -- if( count) -- e->AssureGlobalKW( countIx); -- -- if( nParam > 0) -- { -- BaseGDL* p0 = e->GetParDefined( 0); -- -- if( p0->Type() != GDL_STRING && p0->Type() != GDL_OBJ) -- e->Throw( "Argument must be a scalar object reference or string: "+ -- e->GetParString(0)); -- -- if( !p0->Scalar()) -- e->Throw( "Expression must be a scalar or 1 element " -- "array in this context: "+e->GetParString(0)); -- -- DStructDesc* objDesc; -- -- if( p0->Type() == GDL_STRING) -- { -- DString objName; -- e->AssureScalarPar( 0, objName); -- objName = StrUpCase( objName); -- -- objDesc = FindInStructList( structList, objName); -- if( objDesc == NULL) -- { -- if( count) -- e->SetKW( countIx, new DLongGDL( 0)); -- return new DStringGDL( ""); -- } -- } -- else // GDL_OBJ -- { -- DObj objRef; -- e->AssureScalarPar( 0, objRef); -- -- if( objRef == 0) -- { -- if( count) -- e->SetKW( countIx, new DLongGDL( 0)); -- return new DStringGDL( ""); -- } -- -- DStructGDL* oStruct; -- try { -- oStruct = e->GetObjHeap( objRef); -- } -- catch ( GDLInterpreter::HeapException) -- { // non valid object -- if( count) -- e->SetKW( countIx, new DLongGDL( 0)); -- return new DStringGDL( ""); -- } -- -- objDesc = oStruct->Desc(); // cannot be NULL -- } -- -- if( !super) -- { -- if( count) -- e->SetKW( countIx, new DLongGDL( 1)); -- return new DStringGDL( objDesc->Name()); -- } -- -- deque< string> pNames; -- objDesc->GetParentNames( pNames); -- -- SizeT nNames = pNames.size(); -- -- if( count) -- e->SetKW( countIx, new DLongGDL( nNames)); -- -- if( nNames == 0) -- { -- return new DStringGDL( ""); -- } -- -- DStringGDL* res = new DStringGDL( dimension( nNames), -- BaseGDL::NOZERO); -- -- for( SizeT i=0; iThrow( "Conflicting keywords."); -- -- SizeT nObj = structList.size(); -- -- DStringGDL* res = new DStringGDL( dimension( nObj), -- BaseGDL::NOZERO); -- -- for( SizeT i=0; iName(); -- } -- -- return res; -- } -- -- BaseGDL* obj_isa( EnvT* e) -- { -- SizeT nParam = e->NParam( 2); -- -- BaseGDL* p0 = e->GetPar( 0); -- if( p0 == NULL || p0->Type() != GDL_OBJ) -- e->Throw( "Object reference type required in this context: "+ -- e->GetParString(0)); -- -- DString className; -- e->AssureScalarPar( 1, className); -- className = StrUpCase( className); -- -- DObjGDL* pObj = static_cast( p0); -- -- DByteGDL* res = new DByteGDL( pObj->Dim()); // zero -- -- GDLInterpreter* interpreter = e->Interpreter(); -- -- SizeT nElem = pObj->N_Elements(); -- for( SizeT i=0; iObjValid( (*pObj)[ i])) -- { -- DStructGDL* oStruct = e->GetObjHeap( (*pObj)[i]); -- if( oStruct->Desc()->IsParent( className)) -- (*res)[i] = 1; -- } -- } -- -- return res; -- } -- -- BaseGDL* n_tags( EnvT* e) -- { -- e->NParam( 1); -- -- BaseGDL* p0 = e->GetPar( 0); -- if( p0 == NULL) -- return new DLongGDL( 0); -- -- if( p0->Type() != GDL_STRUCT) -- return new DLongGDL( 0); -- -- DStructGDL* s = static_cast( p0); -- -- //static int lengthIx = e->KeywordIx( "DATA_LENGTH"); -- //bool length = e->KeywordSet( lengthIx); -- -- // we don't know now how to distinghuis the 2 following cases -- if(e->KeywordSet("DATA_LENGTH")) -- return new DLongGDL( s->Sizeof()); -- -- if(e->KeywordSet("LENGTH")) -- return new DLongGDL( s->Sizeof()); -- -- return new DLongGDL( s->Desc()->NTags()); -- } -- -- BaseGDL* bytscl( EnvT* e) -- { -- SizeT nParam = e->NParam( 1); -- -- BaseGDL* p0=e->GetNumericParDefined( 0); -- -- static int minIx = e->KeywordIx( "MIN"); -- static int maxIx = e->KeywordIx( "MAX"); -- static int topIx = e->KeywordIx( "TOP"); -- bool omitNaN = e->KeywordPresent( 3); -- -- DLong topL=255; -- if( e->GetKW( topIx) != NULL) -- e->AssureLongScalarKW( topIx, topL); -- DByte top = static_cast(topL); -- DDouble dTop = static_cast(top); -- -- DDouble min; -- bool minSet = false; -- // SA: handling 3 parameters to emulate undocumented IDL behaviour -- // of translating second and third arguments to MIN and MAX, respectively -- // (parameters have precedence over keywords) -- if (nParam >= 2) -- { -- e->AssureDoubleScalarPar(1, min); -- minSet = true; -- } -- else if (e->GetKW(minIx) != NULL) -- { -- e->AssureDoubleScalarKW(minIx, min); -- minSet = true; -- } -- -- DDouble max; -- bool maxSet = false; -- if (nParam == 3) -- { -- e->AssureDoubleScalarPar(2, max); -- maxSet = true; -- } -- else if (e->GetKW(maxIx) != NULL) -- { -- e->AssureDoubleScalarKW(maxIx, max); -- maxSet = true; -- } -- -- DDoubleGDL* dRes = -- static_cast(p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- -- DLong maxEl, minEl; -- if( !maxSet || !minSet) -- dRes->MinMax( &minEl, &maxEl, NULL, NULL, omitNaN); -- if( !minSet) -- min = (*dRes)[ minEl]; -- if( !maxSet) -- max = (*dRes)[ maxEl]; -- -- SizeT nEl = dRes->N_Elements(); -- for( SizeT i=0; i= max) (*dRes)[ i] = dTop; -- else -- { -- // SA: floor is used for integer types to simulate manipulation on input data types -- if (IntType(p0->Type())) (*dRes)[ i] = floor(((dTop + 1.)*(d - min) - 1.) / (max-min)); -- // SA (?): here floor is used (instead of round) to simulate IDL behaviour -- else (*dRes)[ i] = floor((d - min) / (max-min) * (dTop + .9999)); -- } -- } -- -- return dRes->Convert2( GDL_BYTE); -- } -- -- BaseGDL* strtok_fun( EnvT* e) -- { -- SizeT nParam=e->NParam( 1); -- -- DString stringIn; -- e->AssureStringScalarPar( 0, stringIn); -- -- DString pattern = " \t"; -- if(nParam > 1) { -- e->AssureStringScalarPar( 1, pattern); -- } -- -- static int extractIx = e->KeywordIx( "EXTRACT"); -- bool extract = e->KeywordSet( extractIx); -- -- static int lengthIx = e->KeywordIx( "LENGTH"); -- bool lengthPresent = e->KeywordPresent( lengthIx); -- -- if( extract && lengthPresent) -- e->Throw( "Conflicting keywords."); -- -- static int pre0Ix = e->KeywordIx( "PRESERVE_NULL"); -- bool pre0 = e->KeywordSet( pre0Ix); -- -- static int regexIx = e->KeywordIx( "REGEX"); -- bool regex = e->KeywordPresent( regexIx); -- char err_msg[MAX_REGEXPERR_LENGTH]; -- regex_t regexp; -- -- deque tokenStart; -- deque tokenLen; -- -- int strLen = stringIn.length(); -- -- DString escape = ""; -- e->AssureStringScalarKWIfPresent( "ESCAPE", escape); -- deque escList; -- long pos = 0; -- while(pos != string::npos) -- { -- pos = stringIn.find_first_of( escape, pos); -- if( pos != string::npos) -- { -- escList.push_back( pos+1); // remember escaped char -- pos += 2; // skip escaped char -- } -- } -- deque::iterator escBeg = escList.begin(); -- deque::iterator escEnd = escList.end(); -- -- long tokB = 0; -- long tokE; -- long nextE = 0; -- long actLen; -- -- // If regex then compile regex -- if( regex) { -- if (pattern == " \t") pattern = " "; // regcomp doesn't like "\t" JMG -- int compRes = regcomp( ®exp, pattern.c_str(), REG_EXTENDED); -- if (compRes) { -- regerror(compRes, ®exp, err_msg, MAX_REGEXPERR_LENGTH); -- e->Throw( "Error processing regular expression: "+ -- pattern+"\n "+string(err_msg)+"."); -- } -- } -- -- for(;;) -- { -- regmatch_t pmatch[1]; -- if( regex) { -- int matchres = regexec( ®exp, stringIn.c_str()+nextE, 1, pmatch, 0); -- tokE = matchres? -1:pmatch[0].rm_so; -- } else { -- tokE = stringIn.find_first_of( pattern, nextE); -- } -- -- if( tokE == string::npos) -- { -- actLen = strLen - tokB; -- if( actLen > 0 || pre0) -- { -- tokenStart.push_back( tokB); -- tokenLen.push_back( actLen); -- } -- break; -- } -- -- if( find( escBeg, escEnd, tokE) == escEnd) -- { -- if (regex) actLen = tokE; else actLen = tokE - tokB; -- if( actLen > 0 || pre0) -- { -- tokenStart.push_back( tokB); -- tokenLen.push_back( actLen); -- } -- if (regex) tokB += pmatch[0].rm_eo; else tokB = tokE + 1; -- } -- if (regex) nextE += pmatch[0].rm_eo; else nextE = tokE + 1; -- } // for(;;) -- -- if (regex) regfree( ®exp); -- -- SizeT nTok = tokenStart.size(); -- -- if( !extract) -- { -- if( lengthPresent) -- { -- e->AssureGlobalKW( lengthIx); -- -- if( nTok > 0) -- { -- dimension dim(nTok); -- DLongGDL* len = new DLongGDL(dim); -- for(int i=0; i < nTok; i++) -- (*len)[i] = tokenLen[i]; -- -- e->SetKW( lengthIx, len); -- } -- else -- { -- e->SetKW( lengthIx, new DLongGDL( 0)); -- } -- } -- -- if( nTok == 0) return new DLongGDL( 0); -- -- dimension dim(nTok); -- DLongGDL* d = new DLongGDL(dim); -- for(int i=0; i < nTok; i++) -- (*d)[i] = tokenStart[i]; -- return d; -- } -- -- // EXTRACT -- if( nTok == 0) return new DStringGDL( ""); -- -- dimension dim(nTok); -- DStringGDL *d = new DStringGDL(dim); -- for(int i=0; i < nTok; i++) -- { -- (*d)[i] = stringIn.substr(tokenStart[i], tokenLen[i]); -- -- // remove escape -- DString& act = (*d)[i]; -- long escPos = act.find_first_of( escape, 0); -- while( escPos != string::npos) -- { -- act = act.substr( 0, escPos)+act.substr( escPos+1); -- escPos = act.find_first_of( escape, escPos+1); -- } -- } -- return d; -- } -- -- BaseGDL* getenv_fun( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- -- static int environmentIx = e->KeywordIx( "ENVIRONMENT" ); -- bool environment = e->KeywordSet( environmentIx ); -- -- SizeT nEnv; -- DStringGDL* env; -- -- if( environment) { -- -- if(nParam != 0) -- e->Throw( "Incorrect number of arguments."); -- -- // determine number of environment entries -- for(nEnv = 0; environ[nEnv] != NULL ; ++nEnv); -- -- dimension dim( nEnv ); -- env = new DStringGDL(dim); -- -- // copy stuff into local string array -- for(SizeT i=0; i < nEnv ; ++i) -- (*env)[i] = environ[i]; -- -- } else { -- -- if(nParam != 1) -- e->Throw( "Incorrect number of arguments."); -- -- DStringGDL* name = e->GetParAs(0); -- nEnv = name->N_Elements(); -- -- env = new DStringGDL( name->Dim()); -- -- // copy the stuff into local string only if param found -- char *resPtr; -- for(SizeT i=0; i < nEnv ; ++i) -- { -- // handle special environment variables -- // GDL_TMPDIR, IDL_TMPDIR -- if( (*name)[i] == "GDL_TMPDIR" || (*name)[i] == "IDL_TMPDIR") -- { -- resPtr = getenv((*name)[i].c_str()); -- -- if( resPtr != NULL) -- (*env)[i] = resPtr; -- else -- (*env)[i] = SysVar::Dir(); -- -- AppendIfNeeded( (*env)[i], "/"); -- } -- else // normal environment variables -- if( (resPtr = getenv((*name)[i].c_str())) ) -- (*env)[i] = resPtr; -- } -- } -- -- return env; -- } -- -- BaseGDL* tag_names_fun( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- DStructGDL* struc= e->GetParAs(0); -- -- static int structureNameIx = e->KeywordIx( "STRUCTURE_NAME" ); -- bool structureName = e->KeywordSet( structureNameIx ); -- -- DStringGDL* tagNames; -- -- if(structureName){ -- -- if ((*struc).Desc()->Name() != "$truct") -- tagNames = new DStringGDL((*struc).Desc()->Name()); -- else -- tagNames = new DStringGDL(""); -- -- } else { -- SizeT nTags = (*struc).Desc()->NTags(); -- -- tagNames = new DStringGDL(dimension(nTags)); -- for(int i=0; i < nTags; ++i) -- (*tagNames)[i] = (*struc).Desc()->TagName(i); -- } -- -- return tagNames; -- } -- --// AC 12-Oc-2011: better version for: len=len, /Extract and /Sub --// but it is still not perfect -- -- BaseGDL* stregex_fun( EnvT* e) -- { -- SizeT nParam=e->NParam( 2); -- -- DStringGDL* stringExpr= e->GetParAs(0); -- dimension dim = stringExpr->Dim(); -- -- DString pattern; -- e->AssureStringScalarPar(1, pattern); -- if (pattern.size() <= 0) -- { -- e->Throw( "Error processing regular expression: "+pattern+ -- "\n empty (sub)expression"); -- } -- -- static int booleanIx = e->KeywordIx( "BOOLEAN" ); -- bool booleanKW = e->KeywordSet( booleanIx ); -- -- static int extractIx = e->KeywordIx( "EXTRACT" ); -- bool extractKW = e->KeywordSet( extractIx ); -- -- static int foldCaseIx = e->KeywordIx( "FOLD_CASE" ); -- bool foldCaseKW = e->KeywordSet( foldCaseIx ); -- -- //XXXpch: this is wrong, should check arg_present -- static int lengthIx = e->KeywordIx( "LENGTH" ); -- bool lengthKW = e->KeywordPresent( lengthIx ); -- -- static int subexprIx = e->KeywordIx( "SUBEXPR" ); -- bool subexprKW = e->KeywordSet( subexprIx ); -- -- if( booleanKW && (subexprKW || extractKW || lengthKW)) -- e->Throw( "Conflicting keywords."); -- -- char err_msg[MAX_REGEXPERR_LENGTH]; -- -- // set the compile flags -- int cflags = REG_EXTENDED; -- if (foldCaseKW) -- cflags |= REG_ICASE; -- if (booleanKW) -- cflags |= REG_NOSUB; -- -- // compile the regular expression -- regex_t regexp; -- int compRes = regcomp( ®exp, pattern.c_str(), cflags); -- SizeT nSubExpr = regexp.re_nsub + 1; -- -- // cout << regexp.re_nsub << endl; -- -- if (compRes) { -- regerror(compRes, ®exp, err_msg, MAX_REGEXPERR_LENGTH); -- e->Throw( "Error processing regular expression: "+ -- pattern+"\n "+string(err_msg)+"."); -- } -- -- BaseGDL* result; -- -- if( booleanKW) -- result = new DByteGDL(dim); -- else if( extractKW && !subexprKW) -- { -- // cout << "my pb ! ? dim= " << dim << endl; -- result = new DStringGDL(dim); -- } -- else if( subexprKW) -- { -- // cout << "my pb 2 ? dim= " << dim << endl; -- dimension subExprDim = dim; -- subExprDim >> nSubExpr; // m_schellens: commented in, needed -- if( extractKW) -- result = new DStringGDL(subExprDim); -- else -- result = new DLongGDL(subExprDim); -- } -- else -- result = new DLongGDL(dim); -- -- DLongGDL* len = NULL; -- if( lengthKW) { -- e->AssureGlobalKW( lengthIx); -- if( subexprKW) -- { -- dimension subExprDim = dim; -- subExprDim >> nSubExpr; // m_schellens: commented in, needed -- len = new DLongGDL(subExprDim); -- } -- else -- { -- len = new DLongGDL(dim); -- } -- for( SizeT i=0; iN_Elements(); ++i) -- (*len)[i]= -1; -- } -- -- int nmatch = 1; -- if( subexprKW) nmatch = nSubExpr; -- -- regmatch_t* pmatch = new regmatch_t[nSubExpr]; -- ArrayGuard pmatchGuard( pmatch); -- -- // cout << "dim " << dim.NDimElements() << endl; -- for( SizeT s=0; s(result))[i+s*nSubExpr] = -- (*stringExpr)[s].substr( pmatch[i].rm_so, pmatch[i].rm_eo - pmatch[i].rm_so); --// (*stringExpr)[i+s*nSubExpr].substr( pmatch[i].rm_so, pmatch[i].rm_eo - pmatch[i].rm_so); -- if( lengthKW) -- (*len)[i+s*nSubExpr] = pmatch[i].rm_so != -1 ? pmatch[i].rm_eo - pmatch[i].rm_so : -1; --// (*len)[i+s*nSubExpr] = pmatch[i].rm_eo - pmatch[i].rm_so; -- } -- } -- else if ( subexprKW) -- { -- // cout << "je ne comprends pas v2: "<< nSubExpr << endl; -- -- // Loop through subexpressions & fill output array -- for( SizeT i = 0; i(result))[i+s*nSubExpr] = pmatch[i].rm_so; -- if( lengthKW) -- (*len)[i+s*nSubExpr] = pmatch[i].rm_so != -1 ? pmatch[i].rm_eo - pmatch[i].rm_so : -1; -- } -- } -- else -- { -- if( booleanKW) -- (* static_cast(result))[s] = (matchres == 0); -- else if ( extractKW) // !subExprKW -- { -- if( matchres == 0) -- (* static_cast(result))[s] = -- (*stringExpr)[s].substr( pmatch[0].rm_so, -- pmatch[0].rm_eo - pmatch[0].rm_so); -- } -- else -- (*static_cast(result))[s] = matchres ? -1 : pmatch[0].rm_so; -- } -- -- if( lengthKW && !subexprKW) -- (*len)[s] = pmatch[0].rm_eo - pmatch[0].rm_so; -- } -- -- regfree( ®exp); -- -- if( lengthKW) -- e->SetKW( lengthIx, len); -- -- return result; -- } -- -- BaseGDL* routine_info( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- -- static int functionsIx = e->KeywordIx( "FUNCTIONS" ); -- bool functionsKW = e->KeywordSet( functionsIx ); -- static int systemIx = e->KeywordIx( "SYSTEM" ); -- bool systemKW = e->KeywordSet( systemIx ); -- static int disabledIx = e->KeywordIx( "DISABLED" ); -- bool disabledKW = e->KeywordSet( disabledIx ); -- static int parametersIx = e->KeywordIx( "PARAMETERS" ); -- bool parametersKW = e->KeywordSet( parametersIx ); -- -- if (parametersKW) -- { -- // sanity checks -- if (systemKW || disabledKW) e->Throw("Conflicting keywords."); -- if (nParam != 1) e->Throw("Incorrect number of arguments."); -- -- // getting the routine name from the first parameter -- DString name; -- e->AssureScalarPar(0, name); -- name = StrUpCase(name); -- -- DSubUD* routine = functionsKW -- ? static_cast(funList[GDLInterpreter::GetFunIx(name)]) -- : static_cast(proList[GDLInterpreter::GetProIx(name)]); -- SizeT np = routine->NPar(), nk = routine->NKey(); -- -- // creating the output anonymous structure -- DStructDesc* stru_desc = new DStructDesc("$truct"); -- SpDLong aLong; -- stru_desc->AddTag("NUM_ARGS", &aLong); -- stru_desc->AddTag("NUM_KW_ARGS", &aLong); -- if (np > 0) -- { -- SpDString aStringArr(dimension((int)np)); -- stru_desc->AddTag("ARGS", &aStringArr); -- } -- if (nk > 0) -- { -- SpDString aStringArr(dimension((int)nk)); -- stru_desc->AddTag("KW_ARGS", &aStringArr); -- } -- DStructGDL* stru = new DStructGDL(stru_desc, dimension()); -- -- // filling the structure with information about the routine -- stru->InitTag("NUM_ARGS", DLongGDL(np)); -- stru->InitTag("NUM_KW_ARGS", DLongGDL(nk)); -- if (np > 0) -- { -- DStringGDL *pnames = new DStringGDL(dimension(np)); -- for (SizeT p = 0; p < np; ++p) (*pnames)[p] = routine->GetVarName(nk + p); -- stru->InitTag("ARGS", *pnames); -- GDLDelete(pnames); -- } -- if (nk > 0) -- { -- DStringGDL *knames = new DStringGDL(dimension(nk)); -- for (SizeT k = 0; k < nk; ++k) (*knames)[k] = routine->GetKWName(k); -- stru->InitTag("KW_ARGS", *knames); -- GDLDelete(knames); -- } -- -- // returning -- return stru; -- } -- -- // GDL does not have disabled routines -- if( disabledKW) return new DStringGDL(""); -- -- // if( functionsKW || systemKW || nParam == 0) -- // { -- deque subList; -- -- if( functionsKW) -- { -- if( systemKW) -- { -- SizeT n = libFunList.size(); -- if( n == 0) return new DStringGDL(""); -- -- DStringGDL* res = new DStringGDL( dimension( n), BaseGDL::NOZERO); -- for( SizeT i = 0; iObjectName(); -- -- return res; -- } -- else -- { -- SizeT n = funList.size(); -- if( n == 0) return new DStringGDL(""); -- subList.resize( n); -- -- for( SizeT i = 0; iObjectName()); -- } -- } -- else -- { -- if( systemKW) -- { -- SizeT n = libProList.size(); -- if( n == 0) return new DStringGDL(""); -- -- DStringGDL* res = new DStringGDL( dimension( n), BaseGDL::NOZERO); -- for( SizeT i = 0; iObjectName(); -- -- return res; -- } -- else -- { -- SizeT n = proList.size(); -- if( n == 0) return new DStringGDL(""); -- subList.resize( n); -- -- for( SizeT i = 0; iObjectName()); -- } -- } -- -- sort( subList.begin(), subList.end()); -- SizeT nS = subList.size(); -- -- DStringGDL* res = new DStringGDL( dimension( nS), BaseGDL::NOZERO); -- for( SizeT s=0; s -- rl_prep_terminal (0); --#endif -- -- SizeT nParam=e->NParam(); -- -- bool doWait = true; -- if( nParam > 0) -- { -- doWait = false; -- DLong waitArg = 0; -- e->AssureLongScalarPar( 0, waitArg); -- if( waitArg != 0) -- { -- doWait = true; -- } -- } -- -- // https://sourceforge.net/forum/forum.php?thread_id=3292183&forum_id=338691 -- // DONE: Implement proper SCALAR parameter handling (doWait variable) -- // which is/was not blocking in the original program. -- // note: multi-byte input is not supported here. -- -- char c='\0'; //initialize is never a bad idea... -- -- int fd=fileno(stdin); --#ifndef _MSC_VER -- struct termios orig, get; --#endif -- // Get terminal setup to revert to it at end. --#ifndef _MSC_VER -- (void)tcgetattr(fd, &orig); -- // New terminal setup, non-canonical. -- get.c_lflag = ISIG; --#endif -- if (doWait) -- { -- // will wait for a character --#ifndef _MSC_VER -- get.c_cc[VTIME]=0; -- get.c_cc[VMIN]=1; -- (void)tcsetattr(fd, TCSANOW, &get); --#endif -- cin.get(c); -- } -- else -- { -- // will not wait, but return EOF or next character in terminal buffer if present --#ifndef _MSC_VER -- get.c_cc[VTIME]=0; -- get.c_cc[VMIN]=0; -- (void)tcsetattr(fd, TCSANOW, &get); --#endif -- //the trick is *not to use C++ functions here. cin.get would wait.* -- c=std::fgetc(stdin); -- //and to convert EOF to null (otherwise GDL may exit if not compiled with -- //[lib][n]curses) -- if(c==EOF) c='\0'; -- } -- -- // Restore original terminal settings. --#ifndef _MSC_VER -- (void)tcsetattr(fd, TCSANOW, &orig); --#endif --#if defined(HAVE_LIBREADLINE) -- rl_deprep_terminal (); --#endif -- -- DStringGDL* res = new DStringGDL( DString( i2s( c))); -- -- return res; -- -- } -- -- -- BaseGDL* temporary( EnvT* e) -- { -- SizeT nParam=e->NParam(1); -- -- BaseGDL** p0 = &e->GetParDefined( 0); -- -- BaseGDL* ret = *p0; -- -- *p0 = NULL; // make parameter undefined -- return ret; -- } -- -- BaseGDL* memory( EnvT* e) -- { -- SizeT nParam=e->NParam( 0); -- -- BaseGDL* ret; -- bool kw_l64 = e->KeywordSet(e->KeywordIx("L64")); -- // TODO: IDL-doc mentions about automatically switching to L64 if needed -- -- if (e->KeywordSet(e->KeywordIx("STRUCTURE"))) -- { -- // returning structure -- if (kw_l64) -- { -- ret = new DStructGDL("IDL_MEMORY64"); -- DStructGDL* retStru = static_cast(ret); -- (retStru->GetTag(retStru->Desc()->TagIndex("CURRENT")))->InitFrom( DLong64GDL(MemStats::GetCurrent())); -- (retStru->GetTag(retStru->Desc()->TagIndex("NUM_ALLOC")))->InitFrom( DLong64GDL(MemStats::GetNumAlloc())); -- (retStru->GetTag(retStru->Desc()->TagIndex("NUM_FREE")))->InitFrom( DLong64GDL(MemStats::GetNumFree())); -- (retStru->GetTag(retStru->Desc()->TagIndex("HIGHWATER")))->InitFrom( DLong64GDL(MemStats::GetHighWater())); -- } -- else -- { -- ret = new DStructGDL("IDL_MEMORY"); -- DStructGDL* retStru = static_cast(ret); -- (retStru->GetTag(retStru->Desc()->TagIndex("CURRENT")))->InitFrom( DLongGDL(MemStats::GetCurrent())); -- (retStru->GetTag(retStru->Desc()->TagIndex("NUM_ALLOC")))->InitFrom( DLongGDL(MemStats::GetNumAlloc())); -- (retStru->GetTag(retStru->Desc()->TagIndex("NUM_FREE")))->InitFrom( DLongGDL(MemStats::GetNumFree())); -- (retStru->GetTag(retStru->Desc()->TagIndex("HIGHWATER")))->InitFrom( DLongGDL(MemStats::GetHighWater())); -- } -- } -- else -- { -- bool kw_current = e->KeywordSet(e->KeywordIx("CURRENT")); -- bool kw_num_alloc = e->KeywordSet(e->KeywordIx("NUM_ALLOC")); -- bool kw_num_free = e->KeywordSet(e->KeywordIx("NUM_FREE")); -- bool kw_highwater = e->KeywordSet(e->KeywordIx("HIGHWATER")); -- -- // Following the IDL documentation: mutually exclusive keywords -- // IDL behaves different, incl. segfaults with selected kw combinations -- if (kw_current + kw_num_alloc + kw_num_free + kw_highwater > 1) -- e->Throw("CURRENT, NUM_ALLOC, NUM_FREE & HIGHWATER keywords" -- " are mutually exclusive"); -- -- if (kw_current) -- { -- if (kw_l64) ret = new DLong64GDL(MemStats::GetCurrent()); -- else ret = new DLongGDL(MemStats::GetCurrent()); -- } -- else if (kw_num_alloc) -- { -- if (kw_l64) ret = new DLong64GDL(MemStats::GetNumAlloc()); -- else ret = new DLongGDL(MemStats::GetNumAlloc()); -- } -- else if (kw_num_free) -- { -- if (kw_l64) ret = new DLong64GDL(MemStats::GetNumFree()); -- else ret = new DLongGDL(MemStats::GetNumFree()); -- } -- else if (kw_highwater) -- { -- if (kw_l64) ret = new DLong64GDL(MemStats::GetHighWater()); -- else ret = new DLongGDL(MemStats::GetHighWater()); -- } -- else -- { -- // returning 4-element array -- if (kw_l64) -- { -- ret = new DLong64GDL(dimension(4)); -- (*static_cast(ret))[0] = MemStats::GetCurrent(); -- (*static_cast(ret))[1] = MemStats::GetNumAlloc(); -- (*static_cast(ret))[2] = MemStats::GetNumFree(); -- (*static_cast(ret))[3] = MemStats::GetHighWater(); -- } -- else -- { -- ret = new DLongGDL(dimension(4)); -- (*static_cast(ret))[0] = MemStats::GetCurrent(); -- (*static_cast(ret))[1] = MemStats::GetNumAlloc(); -- (*static_cast(ret))[2] = MemStats::GetNumFree(); -- (*static_cast(ret))[3] = MemStats::GetHighWater(); -- } -- } -- } -- -- return ret; -- } -- -- inline DByte StrCmp( const string& s1, const string& s2, DLong n) -- { -- if( n <= 0) return 1; -- if( s1.substr(0,n) == s2.substr(0,n)) return 1; -- return 0; -- } -- inline DByte StrCmp( const string& s1, const string& s2) -- { -- if( s1 == s2) return 1; -- return 0; -- } -- inline DByte StrCmpFold( const string& s1, const string& s2, DLong n) -- { -- if( n <= 0) return 1; -- if( StrUpCase( s1.substr(0,n)) == StrUpCase(s2.substr(0,n))) return 1; -- return 0; -- } -- inline DByte StrCmpFold( const string& s1, const string& s2) -- { -- if( StrUpCase( s1) == StrUpCase(s2)) return 1; -- return 0; -- } -- -- BaseGDL* strcmp_fun( EnvT* e) -- { -- SizeT nParam=e->NParam(2); -- -- DStringGDL* s0 = static_cast( e->GetParAs< DStringGDL>( 0)); -- DStringGDL* s1 = static_cast( e->GetParAs< DStringGDL>( 1)); -- -- DLongGDL* l2 = NULL; -- if( nParam > 2) -- { -- l2 = static_cast( e->GetParAs< DLongGDL>( 2)); -- } -- -- static int foldIx = e->KeywordIx( "FOLD_CASE"); -- bool fold = e->KeywordSet( foldIx ); -- -- if( s0->Scalar() && s1->Scalar()) -- { -- if( l2 == NULL) -- { -- if( fold) -- return new DByteGDL( StrCmpFold( (*s0)[0], (*s1)[0])); -- else -- return new DByteGDL( StrCmp( (*s0)[0], (*s1)[0])); -- } -- else -- { -- DByteGDL* res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -- SizeT nEl = l2->N_Elements(); -- if( fold) -- for( SizeT i=0; iScalar()) -- { -- DByteGDL* res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -- SizeT nEl = s1->N_Elements(); -- if( fold) -- for( SizeT i=0; iScalar()) -- { -- DByteGDL* res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -- SizeT nEl = s0->N_Elements(); -- if( fold) -- for( SizeT i=0; iN_Elements() <= s1->N_Elements()) -- { -- res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -- nEl = s0->N_Elements(); -- } -- else -- { -- res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -- nEl = s1->N_Elements(); -- } -- if( fold) -- for( SizeT i=0; iScalar(); -- if( s0->Scalar()) -- { -- if( l2Scalar || s1->N_Elements() <= l2->N_Elements()) -- { -- res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -- nEl = s1->N_Elements(); -- } -- else -- { -- res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -- nEl = l2->N_Elements(); -- } -- if( fold) -- for( SizeT i=0; iScalar()) -- { -- if( l2Scalar || s0->N_Elements() <= l2->N_Elements()) -- { -- res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -- nEl = s0->N_Elements(); -- } -- else -- { -- res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -- nEl = l2->N_Elements(); -- } -- if( fold) -- for( SizeT i=0; iN_Elements() <= s1->N_Elements()) -- { -- res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -- nEl = s0->N_Elements(); -- } -- else -- { -- res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -- nEl = s1->N_Elements(); -- } -- else -- { -- if( s0->N_Elements() <= s1->N_Elements()) -- if( s0->N_Elements() <= l2->N_Elements()) -- { -- res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -- nEl = s0->N_Elements(); -- } -- else -- { -- res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -- nEl = l2->N_Elements(); -- } -- else -- if( s1->N_Elements() <= l2->N_Elements()) -- { -- res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -- nEl = s1->N_Elements(); -- } -- else -- { -- res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -- nEl = l2->N_Elements(); -- } -- } -- if( fold) -- for( SizeT i=0; i 'Z')) -- e->Throw( "Illegal tag name: "+name+"."); -- for( SizeT i=1; i 'Z') && -- (n[i] < '0' || n[i] > '9')) -- e->Throw( "Illegal tag name: "+name+"."); -- } -- return n; -- } -- -- BaseGDL* create_struct( EnvT* e) -- { -- static int nameIx = e->KeywordIx( "NAME" ); -- DString name = "$truct"; -- if( e->KeywordPresent( nameIx)) { -- // Check if name exists, if not then treat as unnamed -- if (e->GetKW( nameIx) != NULL) -- e->AssureStringScalarKW( nameIx, name); -- } -- -- if( name != "$truct") // named struct -- { -- name = StrUpCase( name); -- -- SizeT nParam=e->NParam(); -- -- if( nParam == 0) -- { -- DStructDesc* desc = -- e->Interpreter()->GetStruct( name, e->CallingNode()); -- -- dimension dim( 1); -- return new DStructGDL( desc, dim); -- } -- -- DStructDesc* nStructDesc; -- auto_ptr nStructDescGuard; -- -- DStructDesc* oStructDesc= -- FindInStructList( structList, name); -- -- if( oStructDesc == NULL || oStructDesc->NTags() > 0) -- { -- // not defined at all yet (-> define now) -- // or completely defined (-> define now and check equality) -- nStructDesc= new DStructDesc( name); -- -- // guard it -- nStructDescGuard.reset( nStructDesc); -- } -- else -- { -- // NTags() == 0 -- // not completely defined (only name in list) -- nStructDesc= oStructDesc; -- } -- -- // the instance variable -- // dimension dim( 1); -- // DStructGDL* instance = new DStructGDL( nStructDesc, dim); -- DStructGDL* instance = new DStructGDL( nStructDesc); -- auto_ptr instance_guard(instance); -- -- for( SizeT p=0; pGetParDefined( p); -- DStructGDL* parStruct = dynamic_cast( par); -- if( parStruct != NULL) -- { -- // add struct -- if( !parStruct->Scalar()) -- e->Throw("Expression must be a scalar in this context: "+ -- e->GetParString( p)); -- -- DStructDesc* desc = parStruct->Desc(); -- for( SizeT t=0; t< desc->NTags(); ++t) -- { -- instance->NewTag( desc->TagName( t), -- parStruct->GetTag( t)->Dup()); -- } -- } -- else -- { -- // add tag value pair -- DStringGDL* tagNames = e->GetParAs( p); -- SizeT nTags = tagNames->N_Elements(); -- -- SizeT tagStart = p+1; -- SizeT tagEnd = p+nTags; -- if( tagEnd >= nParam) -- e->Throw( "Incorrect number of arguments."); -- -- do{ -- ++p; -- BaseGDL* value = e->GetParDefined( p); -- -- // add -- instance->NewTag( TagName( e, (*tagNames)[ p-tagStart]), -- value->Dup()); -- } -- while( pAssureIdentical(nStructDesc); -- instance->DStructGDL::SetDesc(oStructDesc); -- //delete nStructDesc; // auto_ptr -- } -- } -- else -- { -- // release from guard (if not NULL) -- nStructDescGuard.release(); -- // insert into struct list -- structList.push_back(nStructDesc); -- } -- -- instance_guard.release(); -- return instance; -- } -- else -- { // unnamed struc -- -- // Handle case of single structure parameter -- SizeT nParam; -- nParam = e->NParam(1); -- BaseGDL* par = e->GetParDefined( 0); -- DStructGDL* parStruct = dynamic_cast( par); -- if (nParam != 1 || parStruct == NULL) -- nParam=e->NParam(2); -- -- DStructDesc* nStructDesc = new DStructDesc( "$truct"); -- // instance takes care of nStructDesc since it is unnamed -- // dimension dim( 1); -- // DStructGDL* instance = new DStructGDL( nStructDesc, dim); -- DStructGDL* instance = new DStructGDL( nStructDesc); -- auto_ptr instance_guard(instance); -- -- for( SizeT p=0; pGetParDefined( p); -- DStructGDL* parStruct = dynamic_cast( par); -- if( parStruct != NULL) -- { -- // add struct -- if( !parStruct->Scalar()) -- e->Throw("Expression must be a scalar in this context: "+ -- e->GetParString( p)); -- -- DStructDesc* desc = parStruct->Desc(); -- for( SizeT t=0; t< desc->NTags(); ++t) -- { -- instance->NewTag( desc->TagName( t), -- parStruct->GetTag( t)->Dup()); -- } -- ++p; -- } -- else -- { -- // add tag value pair -- DStringGDL* tagNames = e->GetParAs( p); -- SizeT nTags = tagNames->N_Elements(); -- -- SizeT tagStart = p+1; -- SizeT tagEnd = p+nTags; -- if( tagEnd >= nParam) -- e->Throw( "Incorrect number of arguments."); -- -- for(++p; p<=tagEnd; ++p) -- { -- BaseGDL* value = e->GetParDefined( p); -- -- // add -- instance->NewTag( TagName( e, (*tagNames)[ p-tagStart]), -- value->Dup()); -- } -- } -- } -- -- instance_guard.release(); -- return instance; -- } -- } -- -- BaseGDL* rotate( EnvT* e) -- { -- e->NParam(2); -- BaseGDL* p0 = e->GetParDefined( 0); -- -- if( p0->Rank() == 0) -- e->Throw( "Expression must be an array in this context: " + e->GetParString( 0)); -- -- if( p0->Rank() != 1 && p0->Rank() != 2) -- e->Throw( "Only 1 or 2 dimensions allowed: " + e->GetParString( 0)); -- -- if( p0->Type() == GDL_STRUCT) -- e->Throw( "STRUCT expression not allowed in this context: "+ -- e->GetParString( 0)); -- -- DLong dir; -- e->AssureLongScalarPar( 1, dir); -- -- return p0->Rotate( dir); -- } -- -- // SA: based on the code of rotate() (above) -- BaseGDL* reverse( EnvT* e) -- { -- e->NParam(1); -- BaseGDL* p0 = e->GetParDefined(0); -- if (p0->Rank() == 0) return p0->Dup(); -- -- DLong dim = 1; -- if (e->GetPar(1) != NULL) -- e->AssureLongScalarPar(1, dim); -- if (p0->Rank() != 0 && (dim > p0->Rank() || dim < 1)) -- e->Throw("Subscript_index must be positive and less than or equal to number of dimensions."); -- -- BaseGDL* ret; -- // IDL doc states that OVERWRITE is ignored for one- or two-dim. arrays -- // but it seems to behave differently -- // if (p0->Rank() > 2 && e->KeywordSet("OVERWRITE") && e->GlobalPar(0)) -- if (e->KeywordSet("OVERWRITE")) -- { -- p0->Reverse(dim-1); -- bool stolen = e->StealLocalPar( 0); -- if( !stolen) e->GetPar(0) = NULL; -- return p0; -- } -- else ret = p0->DupReverse(dim - 1); -- return ret; -- } -- -- // SA: parse_url based on the PHP parse_url() function code -- // by Jim Winstead / The PHP Group (PHP license v. 3.01) -- // (http://svn.php.net/viewvc/php/php-src/trunk/ext/standard/url.c) -- // PHP is free software available at http://www.php.net/software/ -- // -- // notes: -- // - IDL does not support IPv6 URLs, GDL does -- // - IDL includes characters after '#' in the QUERY part, GDL -- // just skips them and issues a warning (perhaps not needed) -- // - IDL preserves controll characters in URLs, GDL preserves -- // them as well but a warning is issued -- // - IDL sets 80 as a default value for PORT, even if the url has -- // an ftp:// schema indicated - GDL does not have any default value -- // - IDL excludes the leading "/" from the path, GDL preserves it -- // ... these differences seem just rational for me but please do change -- // it if IDL-compatibility would be beneficial for any reason here -- -- BaseGDL* parse_url(EnvT* env) -- { -- // sanity check for number of parameters -- SizeT nParam = env->NParam(); -- -- // 1-nd argument : the url string -- DString url; -- env->AssureScalarPar(0, url); -- -- // sanity check for controll characters -- string::iterator it; -- for (it = url.begin(); it < url.end(); it++) if (iscntrl(*it)) -- { -- Warning("PARSE_URL: URL contains a control character"); -- break; -- } -- -- // creating the output anonymous structure -- DStructDesc* urlstru_desc = new DStructDesc("$truct"); -- SpDString aString; -- urlstru_desc->AddTag("SCHEME", &aString); -- static size_t ixSCHEME = 0; -- urlstru_desc->AddTag("USERNAME", &aString); -- urlstru_desc->AddTag("PASSWORD", &aString); -- urlstru_desc->AddTag("HOST", &aString); -- urlstru_desc->AddTag("PORT", &aString); -- static size_t ixPORT = 4; -- urlstru_desc->AddTag("PATH", &aString); -- urlstru_desc->AddTag("QUERY", &aString); -- DStructGDL* urlstru = new DStructGDL(urlstru_desc, dimension()); -- auto_ptr urlstru_guard(urlstru); -- -- // parsing the URL -- char const *str = url.c_str(); -- size_t length = url.length(); -- char port_buf[6]; -- char const *s, *e, *p, *pp, *ue; -- -- s = str; -- ue = s + length; -- -- // parsing scheme -- if ((e = (const char*)memchr(s, ':', length)) && (e - s)) -- { -- // validating scheme -- p = s; -- while (p < e) -- { -- // scheme = 1*[ lowalpha | digit | "+" | "-" | "." ] -- if (!isalpha(*p) && !isdigit(*p) && *p != '+' && *p != '.' && *p != '-') -- { -- if (e + 1 < ue) goto parse_port; -- else goto just_path; -- } -- p++; -- } -- if (*(e + 1) == '\0') -- { -- // only scheme is available -- urlstru->InitTag("SCHEME", DStringGDL(string(s, (e - s)))); -- goto end; -- } -- // schemas without '/' (like mailto: and zlib:) -- if (*(e+1) != '/') -- { -- // check if the data we get is a port this allows us to correctly parse things like a.com:80 -- p = e + 1; -- while (isdigit(*p)) p++; -- if ((*p == '\0' || *p == '/') && (p - e) < 7) goto parse_port; -- urlstru->InitTag("SCHEME", DStringGDL(string(s, (e - s)))); -- length -= ++e - s; -- s = e; -- goto just_path; -- } -- else -- { -- urlstru->InitTag("SCHEME", DStringGDL(string(s, (e - s)))); -- if (*(e+2) == '/') -- { -- s = e + 3; -- if (!strncasecmp("file", -- (*static_cast(urlstru->GetTag(ixSCHEME)))[0].c_str(), -- sizeof("file") -- )) -- { -- if (*(e + 3) == '/') -- { -- // support windows drive letters as in: file:///c:/somedir/file.txt -- if (*(e + 5) == ':') s = e + 4; -- goto nohost; -- } -- } -- } -- else -- { -- if (!strncasecmp("file", -- (*static_cast(urlstru->GetTag(ixSCHEME)))[0].c_str(), -- sizeof("file")) -- ) -- { -- s = e + 1; -- goto nohost; -- } -- else -- { -- length -= ++e - s; -- s = e; -- goto just_path; -- } -- } -- } -- } -- else if (e) -- { -- // no scheme, look for port -- parse_port: -- p = e + 1; -- pp = p; -- while (pp-p < 6 && isdigit(*pp)) pp++; -- if (pp-p < 6 && (*pp == '/' || *pp == '\0')) -- { -- memcpy(port_buf, p, (pp-p)); -- port_buf[pp-p] = '\0'; -- urlstru->InitTag("PORT", DStringGDL(port_buf)); -- } -- else goto just_path; -- } -- else -- { -- just_path: -- ue = s + length; -- goto nohost; -- } -- e = ue; -- if (!(p = (const char*)memchr(s, '/', (ue - s)))) -- { -- if ((p = (const char*)memchr(s, '?', (ue - s)))) e = p; -- else if ((p = (const char*)memchr(s, '#', (ue - s)))) e = p; -- } -- else e = p; -- // check for login and password -- { -- size_t pos; -- if ((pos = string(s, e - s).find_last_of("@")) != string::npos) -- { -- p = s + pos; -- if ((pp = (const char*)memchr(s, ':', (p-s)))) -- { -- if ((pp-s) > 0) urlstru->InitTag("USERNAME", DStringGDL(string(s, (pp - s)))); -- pp++; -- if (p-pp > 0) urlstru->InitTag("PASSWORD", DStringGDL(string(pp, (p - pp)))); -- } -- else urlstru->InitTag("USERNAME", DStringGDL(string(s, (p - s)))); -- s = p + 1; -- } -- } -- // check for port -- if (*s == '[' && *(e-1) == ']') p = s; // IPv6 embedded address -- else for(p = e; *p != ':' && p >= s; p--); // memrchr is a GNU extension -- if (p >= s && *p == ':') -- { -- if ((*static_cast(urlstru->GetTag(ixPORT)))[0].length() == 0) -- { -- p++; -- if (e-p > 5) env->Throw("port cannot be longer then 5 characters"); -- else if (e - p > 0) -- { -- memcpy(port_buf, p, (e-p)); -- port_buf[e-p] = '\0'; -- urlstru->InitTag("PORT", DStringGDL(port_buf)); -- } -- p--; -- } -- } -- else p = e; -- // check if we have a valid host, if we don't reject the string as url -- if ((p-s) < 1) env->Throw("invalid host"); -- urlstru->InitTag("HOST", DStringGDL(string(s, (p - s)))); -- if (e == ue) goto end; -- s = e; -- nohost: -- if ((p = (const char*)memchr(s, '?', (ue - s)))) -- { -- pp = strchr(s, '#'); -- if (pp && pp < p) -- { -- p = pp; -- pp = strchr(pp+2, '#'); -- } -- if (p - s) urlstru->InitTag("PATH", DStringGDL(string(s, (p - s)))); -- if (pp) -- { -- if (pp - ++p) urlstru->InitTag("QUERY", DStringGDL(string(p, (pp - p)))); -- p = pp; -- goto label_parse; -- } -- else if (++p - ue) urlstru->InitTag("QUERY", DStringGDL(string(p, (ue - p)))); -- } -- else if ((p = (const char*)memchr(s, '#', (ue - s)))) -- { -- if (p - s) urlstru->InitTag("PATH", DStringGDL(string(s, (p - s)))); -- label_parse: -- p++; -- if (ue - p) Warning("PARSE_URL: URL fragment left out: #" + string(p, (ue-p))); -- } -- else urlstru->InitTag("PATH", DStringGDL(string(s, (ue - s)))); -- end: -- -- // returning the result -- urlstru_guard.release(); -- return urlstru; -- } -- -- BaseGDL* locale_get(EnvT* e) -- { --#ifdef HAVE_LOCALE_H -- -- // make GDL inherit the calling process locale -- setlocale(LC_ALL, ""); -- // note doen the inherited locale -- DStringGDL *locale = new DStringGDL(setlocale(LC_CTYPE, NULL)); -- // return to the C locale -- setlocale(LC_ALL, "C"); -- -- return locale; --#else -- e->Throw("OS does not provide locale information"); --#endif -- } -- -- // SA: relies on the contents of the lib::command_line_args vector -- // defined and filled with data (pointers) in gdl.cpp -- BaseGDL* command_line_args_fun(EnvT* e) -- { --#ifdef PYTHON_MODULE -- e->Throw("no command line arguments available (GDL built as a Python module)"); --#else -- static int countIx = e->KeywordIx("COUNT"); -- extern std::vector command_line_args; -- -- // setting the COUNT keyword value -- if (e->KeywordPresent(countIx)) -- { -- e->AssureGlobalKW(countIx); -- e->SetKW(countIx, new DLongGDL(command_line_args.size())); -- } -- -- // returning empty string or an array of arguments -- if (command_line_args.empty()) return new DStringGDL(""); -- else -- { -- BaseGDL* ret = new DStringGDL(dimension(command_line_args.size())); -- for (size_t i = 0; i < command_line_args.size(); i++) -- (*static_cast(ret))[i] = command_line_args[i]; -- return ret; -- } --#endif -- } -- -- // SA: relies in the uname() from libc (must be there if POSIX) -- BaseGDL* get_login_info( EnvT* e) -- { -- // getting the info --#ifdef _MSC_VER -- #define MAX_TCHAR_BUF 256 -- -- char login[MAX_TCHAR_BUF]; -- char info[MAX_TCHAR_BUF]; -- -- DWORD N_TCHAR = MAX_TCHAR_BUF; -- -- #ifdef _UNICODE -- TCHAR t_buf[MAX_TCHAR_BUF]; -- GetUserName(t_buf, &N_TCHAR); -- WideCharToMultiByte(CP_ACP, 0, t_buf, N_TCHAR, login, N_TCHAR, NULL, NULL); -- GetComputerName( t_buf, &N_TCHAR ); -- WideCharToMultiByte(CP_ACP, 0, t_buf, N_TCHAR, info, N_TCHAR, NULL, NULL); -- #else -- GetUserName(login, &N_TCHAR); -- GetComputerName(info, &N_TCHAR); -- #endif --#else -- char* login = getlogin(); -- if (login == NULL) e->Throw("Failed to get user name from the OS"); -- struct utsname info; -- if (0 != uname(&info)) e->Throw("Failed to get machine name from the OS"); --#endif -- // creating the output anonymous structure -- DStructDesc* stru_desc = new DStructDesc("$truct"); -- SpDString aString; -- stru_desc->AddTag("MACHINE_NAME", &aString); -- stru_desc->AddTag("USER_NAME", &aString); -- DStructGDL* stru = new DStructGDL(stru_desc, dimension()); -- -- // returning the info -- stru->InitTag("USER_NAME", DStringGDL(login)); --#ifdef _MSC_VER -- stru->InitTag("MACHINE_NAME", DStringGDL(info)); --#else -- stru->InitTag("MACHINE_NAME", DStringGDL(info.nodename)); --#endif -- return stru; -- } -- -- // SA: base64 logic in base64.hpp, based on code by Bob Withers (consult base64.hpp) -- BaseGDL* idl_base64(EnvT* e) -- { -- BaseGDL* p0 = e->GetPar(0); -- if (p0 != NULL) -- { -- if (p0->Rank() == 0 && p0->Type() == GDL_STRING) -- { -- // decoding -- string* str = &((*static_cast(p0))[0]); -- if (str->length() == 0) return new DByteGDL(0); -- if (str->length() % 4 != 0) -- e->Throw("Input string length must be a multiple of 4"); -- unsigned int retlen = base64::decodeSize(*str); -- if (retlen == 0 || retlen > str->length()) e->Throw("No data in the input string"); -- DByteGDL* ret = new DByteGDL(dimension(retlen)); -- if (!base64::decode(*str, (char*)&((*ret)[0]), ret->N_Elements())) -- e->Throw("Base64 decoder failed"); -- return ret; -- } -- if (p0->Rank() >= 1 && p0->Type() == GDL_BYTE) -- { -- // encoding -- return new DStringGDL( -- base64::encode((char*)&(*static_cast(p0))[0], p0->N_Elements()) -- ); -- } -- } -- e->Throw("Expecting string or byte array as a first parameter"); -- } -- -- BaseGDL* get_drive_list(EnvT* e) -- { -- if (e->KeywordPresent(0)) e->SetKW(0, new DLongGDL(0)); -- return new DStringGDL(""); -- } -- -- // note: changes here MUST be reflected in scope_varfetch_reference() as well -- // because DLibFun of this function is used for scope_varfetch_reference() the keyword -- // indices must match -- BaseGDL* scope_varfetch_value( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- -- EnvStackT& callStack = e->Interpreter()->CallStack(); --// DLong curlevnum = callStack.size()-1; --// 'e' is not on the stack -- DLong curlevnum = callStack.size(); -- --// static int variablesIx = e->KeywordIx( "VARIABLES" ); -- static int levelIx = e->KeywordIx( "LEVEL" ); -- -- DLongGDL* level = e->IfDefGetKWAs( levelIx); -- -- DLong desiredlevnum = 0; -- -- if (level != NULL) -- desiredlevnum = (*level)[0]; -- -- if (desiredlevnum <= 0) desiredlevnum += curlevnum; -- if (desiredlevnum < 1) desiredlevnum = 1; -- else if (desiredlevnum > curlevnum) desiredlevnum = curlevnum; -- -- DSubUD* pro = static_cast(callStack[desiredlevnum-1]->GetPro()); -- -- SizeT nVar = pro->Size(); // # var in GDL for desired level -- int nKey = pro->NKey(); -- -- DString varName; -- -- e->AssureScalarPar( 0, varName); -- varName = StrUpCase( varName); -- -- int xI = pro->FindVar( varName); -- if (xI != -1) -- { --// BaseGDL*& par = ((EnvT*)(callStack[desiredlevnum-1]))->GetPar( xI); -- BaseGDL*& par = callStack[desiredlevnum-1]->GetKW( xI); -- -- if( par == NULL) -- e->Throw( "Variable is undefined: " + varName); -- -- return par->Dup(); -- } -- -- e->Throw( "Variable not found: " + varName); -- return new DLongGDL(0); // compiler shut-up -- } -- -- // this routine is special, only called as an l-function (from FCALL_LIB::LEval()) -- // it MUST use an EnvT set up for scope_varfetch_value -- BaseGDL** scope_varfetch_reference( EnvT* e) -- { -- SizeT nParam=e->NParam(); -- -- EnvStackT& callStack = e->Interpreter()->CallStack(); --// DLong curlevnum = callStack.size()-1; --// 'e' is not on the stack -- DLong curlevnum = callStack.size(); -- --// static int variablesIx = e->KeywordIx( "VARIABLES" ); -- static int levelIx = e->KeywordIx( "LEVEL" ); -- -- DLongGDL* level = e->IfDefGetKWAs( levelIx); -- -- DLong desiredlevnum = 0; -- -- if (level != NULL) -- desiredlevnum = (*level)[0]; -- -- if (desiredlevnum <= 0) desiredlevnum += curlevnum; -- if (desiredlevnum < 1) desiredlevnum = 1; -- else if (desiredlevnum > curlevnum) desiredlevnum = curlevnum; -- -- DSubUD* pro = static_cast(callStack[desiredlevnum-1]->GetPro()); -- -- SizeT nVar = pro->Size(); // # var in GDL for desired level -- int nKey = pro->NKey(); -- -- DString varName; -- -- e->AssureScalarPar( 0, varName); -- varName = StrUpCase( varName); -- int xI = pro->FindVar( varName); -- if (xI != -1) -- { --// BaseGDL*& par = ((EnvT*)(callStack[desiredlevnum-1]))->GetPar( xI); -- BaseGDL*& par = callStack[desiredlevnum-1]->GetKW( xI); -- --// if( par == NULL) --// e->Throw( "Variable is undefined: " + varName); -- -- return ∥ -- } -- -- e->Throw( "LVariable not found: " + varName); -- return NULL; // compiler shut-up -- } -- -- --} // namespace -- -+/*************************************************************************** -+ basic_fun.cpp - basic GDL library function -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002 by Marc Schellens (exceptions see below) -+ email : m_schellens@users.sf.net -+ -+ strtok_fun, getenv_fun, tag_names_fun, stregex_fun: -+ (C) 2004 by Peter Messmer -+ -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#include "includefirst.hpp" -+ -+// get_kbrd patch -+// http://sourceforge.net/forum/forum.php?thread_id=3292183&forum_id=338691 -+#ifndef _MSC_VER -+#include -+#include -+#endif -+#include -+#include -+#include -+//#include -+#include // stregex -+ -+#ifdef __APPLE__ -+# include -+# define environ (*_NSGetEnviron()) -+#endif -+ -+#if defined(__FreeBSD__) || defined(__sun__) || defined(__OpenBSD__) -+extern "C" char **environ; -+#endif -+ -+#include "nullgdl.hpp" -+#include "datatypes.hpp" -+#include "envt.hpp" -+#include "dpro.hpp" -+#include "dinterpreter.hpp" -+#include "basic_pro.hpp" -+#include "terminfo.hpp" -+#include "typedefs.hpp" -+#include "base64.hpp" -+ -+#ifdef HAVE_LOCALE_H -+# include -+#endif -+ -+/* max regexp error message length */ -+#define MAX_REGEXPERR_LENGTH 80 -+ -+#ifdef _MSC_VER -+#define isfinite _finite -+#define isnan _isnan -+#define round(f) floor(f+0.5) -+int strncasecmp(const char *s1, const char *s2, size_t n) -+{ -+ if (n == 0) -+ return 0; -+ while (n-- != 0 && tolower(*s1) == tolower(*s2)) -+ { -+ if (n == 0 || *s1 == '\0' || *s2 == '\0') -+ break; -+ s1++; -+ s2++; -+ } -+ -+ return tolower(*(unsigned char *) s1) - tolower(*(unsigned char *) s2); -+} -+#else -+#include -+#endif -+ -+namespace lib { -+ -+// using namespace std; -+ using std::isnan; -+ using namespace antlr; -+ -+ -+ -+ // assumes all parameters from pOffs till end are dim -+ void arr( EnvT* e, dimension& dim, SizeT pOffs=0) -+ { -+ -+ int nParam=e->NParam()-pOffs; -+ -+ if( nParam <= 0) -+ e->Throw( "Incorrect number of arguments."); -+ -+ const string BadDims="Array dimensions must be greater than 0."; -+ -+ -+ if( nParam == 1 ) { -+ -+ BaseGDL* par = e->GetParDefined( pOffs); -+ -+ SizeT newDim; -+ int ret = par->Scalar2Index( newDim); -+ -+ if (ret < 0) throw GDLException(BadDims); -+ -+ if( ret > 0) { // single argument -+ if (newDim < 1) throw GDLException(BadDims); -+ dim << newDim; -+ return; -+ } -+ if( ret == 0) { // array argument -+ DLongGDL* ind = -+ static_cast(par->Convert2(GDL_LONG, BaseGDL::COPY)); -+ Guard ind_guard( ind); -+ //e->Guard( ind); -+ -+ for(SizeT i =0; i < par->N_Elements(); ++i){ -+ if ((*ind)[i] < 1) throw GDLException(BadDims); -+ dim << (*ind)[i]; -+ } -+ return; -+ } -+ e->Throw( "arr: should never arrive here."); -+ return; -+ } -+ -+ // max number checked in interpreter -+ SizeT endIx=nParam+pOffs; -+ for( SizeT i=pOffs; iGetParDefined( i); -+ -+ SizeT newDim; -+ int ret=par->Scalar2Index( newDim); -+ if( ret < 1 || newDim == 0) throw GDLException(BadDims); -+ dim << newDim; -+ } -+ } -+ -+ BaseGDL* bytarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DByteGDL(dim, BaseGDL::NOZERO); -+ return new DByteGDL(dim); -+ // } -+ // catch( GDLException& ex) -+ // { -+// e->Throw( ex.getMessage()); -+// } -+ } -+ BaseGDL* intarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DIntGDL(dim, BaseGDL::NOZERO); -+ return new DIntGDL(dim); -+// } -+// catch( GDLException& ex) -+// { -+// e->Throw( "INTARR: "+ex.getMessage()); -+// } -+ } -+ BaseGDL* uintarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DUIntGDL(dim, BaseGDL::NOZERO); -+ return new DUIntGDL(dim); -+// } -+// catch( GDLException& ex) -+// { -+// e->Throw( "UINTARR: "+ex.getMessage()); -+// } -+ } -+ BaseGDL* lonarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DLongGDL(dim, BaseGDL::NOZERO); -+ return new DLongGDL(dim); -+/* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "LONARR: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* ulonarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DULongGDL(dim, BaseGDL::NOZERO); -+ return new DULongGDL(dim); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "ULONARR: "+ex.getMessage()); -+ } -+ */ -+} -+ BaseGDL* lon64arr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DLong64GDL(dim, BaseGDL::NOZERO); -+ return new DLong64GDL(dim); -+/* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "LON64ARR: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* ulon64arr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DULong64GDL(dim, BaseGDL::NOZERO); -+ return new DULong64GDL(dim); -+/* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "ULON64ARR: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* fltarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DFloatGDL(dim, BaseGDL::NOZERO); -+ return new DFloatGDL(dim); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "FLTARR: "+ex.getMessage()); -+ } -+ */} -+ BaseGDL* dblarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DDoubleGDL(dim, BaseGDL::NOZERO); -+ return new DDoubleGDL(dim); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "DBLARR: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* strarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) -+ e->Throw( "Keyword parameters not allowed in call."); -+ return new DStringGDL(dim); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "STRARR: "+ex.getMessage()); -+ } -+ */ } -+ BaseGDL* complexarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ if( e->KeywordSet(0)) return new DComplexGDL(dim, BaseGDL::NOZERO); -+ return new DComplexGDL(dim); -+ /*} -+ catch( GDLException& ex) -+ { -+ e->Throw( "COMPLEXARR: "+ex.getMessage()); -+ } -+ */ } -+ BaseGDL* dcomplexarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ -+ if( e->KeywordSet(0)) return new DComplexDblGDL(dim, BaseGDL::NOZERO); -+ return new DComplexDblGDL(dim); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "DCOMPLEXARR: "+ex.getMessage()); -+ } -+ */ } -+ BaseGDL* ptrarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ DPtrGDL* ret; -+ -+// if( e->KeywordSet(0)) -+// ret= new DPtrGDL(dim);//, BaseGDL::NOZERO); -+// else -+// if( e->KeywordSet(1)) -+// ret= new DPtrGDL(dim, BaseGDL::NOZERO); -+// else -+// return new DPtrGDL(dim); -+ if( !e->KeywordSet(1)) -+ return new DPtrGDL(dim); -+ -+ ret= new DPtrGDL(dim, BaseGDL::NOZERO); -+ -+ SizeT nEl=ret->N_Elements(); -+ SizeT sIx=e->NewHeap(nEl); -+// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iThrow( "PTRARR: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* objarr( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+// reference counting if( e->KeywordSet(0)) return new DObjGDL(dim, BaseGDL::NOZERO); -+ return new DObjGDL(dim); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "OBJARR: "+ex.getMessage()); -+ } -+ */ } -+ -+ BaseGDL* ptr_new( EnvT* e) -+ { -+ int nParam=e->NParam(); -+ -+ if( nParam > 0) -+ { -+ // new ptr from undefined variable is allowed as well -+ BaseGDL* p= e->GetPar( 0); -+ if( p == NULL) -+ { -+ DPtr heapID= e->NewHeap(); -+ return new DPtrGDL( heapID); -+ } -+ -+ if( e->KeywordSet(0)) // NO_COPY -+ { -+ BaseGDL** p= &e->GetPar( 0); -+ // if( *p == NULL) -+ // e->Throw( "Parameter undefined: "+ -+ // e->GetParString(0)); -+ -+ DPtr heapID= e->NewHeap( 1, *p); -+ *p=NULL; -+ return new DPtrGDL( heapID); -+ } -+ else -+ { -+ BaseGDL* p= e->GetParDefined( 0); -+ -+ DPtr heapID= e->NewHeap( 1, p->Dup()); -+ return new DPtrGDL( heapID); -+ } -+ } -+ else -+ { -+ if( e->KeywordSet(1)) // ALLOCATE_HEAP -+ { -+ DPtr heapID= e->NewHeap(); -+ return new DPtrGDL( heapID); -+ } -+ else -+ { -+ return new DPtrGDL( 0); // null ptr -+ } -+ } -+ } -+ -+ BaseGDL* ptr_valid( EnvT* e) -+ { -+ int nParam=e->NParam(); -+ -+ if( e->KeywordPresent( 1)) // COUNT -+ { -+ e->SetKW( 1, new DLongGDL( e->Interpreter()->HeapSize())); -+ } -+ -+ if( nParam == 0) -+ { -+ return e->Interpreter()->GetAllHeap(); -+ } -+ -+ BaseGDL* p = e->GetPar( 0); -+ if( p == NULL) -+ { -+ return new DByteGDL( 0); -+ } -+ -+ DType pType = p->Type(); -+ if( e->KeywordSet( 0)) // CAST -+ { -+ DLongGDL* pL;// = dynamic_cast( p); -+ Guard pL_guard; -+// if( pL == NULL) -+ if( pType != GDL_LONG) -+ { -+ pL = static_cast(p->Convert2(GDL_LONG,BaseGDL::COPY)); -+ pL_guard.Init( pL); -+ } -+ else -+ { -+ pL = static_cast(p); -+ } -+ SizeT nEl = pL->N_Elements(); -+ DPtrGDL* ret = new DPtrGDL( pL->Dim()); // zero -+ GDLInterpreter* interpreter = e->Interpreter(); -+ for( SizeT i=0; iPtrValid( (*pL)[ i])) -+ (*ret)[ i] = (*pL)[ i]; -+ } -+ return ret; -+ } -+ -+// DPtrGDL* pPtr = dynamic_cast( p); -+// if( pPtr == NULL) -+ if( pType != GDL_PTR) -+ { -+ return new DByteGDL( p->Dim()); // zero -+ } -+ -+ DPtrGDL* pPtr = static_cast( p); -+ -+ SizeT nEl = pPtr->N_Elements(); -+ DByteGDL* ret = new DByteGDL( pPtr->Dim()); // zero -+ GDLInterpreter* interpreter = e->Interpreter(); -+ for( SizeT i=0; iPtrValid( (*pPtr)[ i])) -+ (*ret)[ i] = 1; -+ } -+ return ret; -+ } -+ -+ BaseGDL* obj_valid( EnvT* e) -+ { -+ int nParam=e->NParam(); -+ -+ if( e->KeywordPresent( 1)) // COUNT -+ { -+ e->SetKW( 1, new DLongGDL( e->Interpreter()->ObjHeapSize())); -+ } -+ -+ if( nParam == 0) -+ { -+ return e->Interpreter()->GetAllObjHeap(); -+ } -+ -+ BaseGDL* p = e->GetPar( 0); -+ if( p == NULL) -+ { -+ return new DByteGDL( 0); -+ } -+ -+ DType pType = p->Type(); -+ if( e->KeywordSet( 0)) // CAST -+ { -+ DLongGDL* pL;// = dynamic_cast( p); -+ Guard pL_guard; -+// if( pL == NULL) -+ if( pType != GDL_LONG) -+ { -+ pL = static_cast(p->Convert2(GDL_LONG,BaseGDL::COPY)); -+ pL_guard.Init( pL); -+ // e->Guard( pL); -+ } -+ else -+ { -+ pL = static_cast( p); -+ } -+ SizeT nEl = pL->N_Elements(); -+ DObjGDL* ret = new DObjGDL( pL->Dim()); // zero -+ GDLInterpreter* interpreter = e->Interpreter(); -+ for( SizeT i=0; iObjValid( (*pL)[ i])) -+ (*ret)[ i] = (*pL)[ i]; -+ } -+ return ret; -+ } -+ -+// DObjGDL* pObj = dynamic_cast( p); -+// if( pObj == NULL) -+ if( pType != GDL_OBJ) -+ { -+ return new DByteGDL( p->Dim()); // zero -+ } -+ DObjGDL* pObj = static_cast( p); -+ -+ SizeT nEl = pObj->N_Elements(); -+ DByteGDL* ret = new DByteGDL( pObj->Dim()); // zero -+ GDLInterpreter* interpreter = e->Interpreter(); -+ for( SizeT i=0; iObjValid( (*pObj)[ i])) -+ (*ret)[ i] = 1; -+ } -+ return ret; -+ } -+ -+ BaseGDL* obj_new( EnvT* e) -+ { -+ StackGuard guard( e->Interpreter()->CallStack()); -+ -+ int nParam=e->NParam(); -+ -+ if( nParam == 0) -+ { -+ return new DObjGDL( 0); -+ } -+ -+ DString objName; -+ e->AssureScalarPar( 0, objName); -+ -+ // this is a struct name -> convert to UPPERCASE -+ objName=StrUpCase(objName); -+ if( objName == "IDL_OBJECT") -+ objName = GDL_OBJECT_NAME; // replacement also done in GDLParser -+ -+ DStructDesc* objDesc=e->Interpreter()->GetStruct( objName, e->CallingNode()); -+ -+ DStructGDL* objStruct= new DStructGDL( objDesc, dimension()); -+ -+ DObj objID= e->NewObjHeap( 1, objStruct); // owns objStruct -+ -+ DObjGDL* newObj = new DObjGDL( objID); // the object -+ -+ try { -+ // call INIT function -+ DFun* objINIT= objDesc->GetFun( "INIT"); -+ if( objINIT != NULL) -+ { -+ // morph to obj environment and push it onto the stack again -+ e->PushNewEnvUD( objINIT, 1, &newObj); -+ -+ BaseGDL* res=e->Interpreter()->call_fun( objINIT->GetTree()); -+ -+ if( res == NULL || (!res->Scalar()) || res->False()) -+ { -+ GDLDelete(res); -+ return new DObjGDL( 0); -+ } -+ GDLDelete(res); -+ } -+ } catch(...) { -+ e->FreeObjHeap( objID); // newObj might be changed -+ GDLDelete(newObj); -+ throw; -+ } -+ -+ return newObj; -+ } -+ -+ BaseGDL* bindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DByteGDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "BINDGEN: "+ex.getMessage()); -+ } -+ */ } -+ // keywords not supported yet -+ BaseGDL* indgen( EnvT* e) -+ { -+ dimension dim; -+ -+ // Defaulting to GDL_INT -+ DType type = GDL_INT; -+ -+ static int kwIx1 = e->KeywordIx("BYTE"); -+ if (e->KeywordSet(kwIx1)){ type = GDL_BYTE; } -+ -+ static int kwIx2 = e->KeywordIx("COMPLEX"); -+ if (e->KeywordSet(kwIx2)){ type = GDL_COMPLEX; } -+ -+ static int kwIx3 = e->KeywordIx("DCOMPLEX"); -+ if (e->KeywordSet(kwIx3)){ type = GDL_COMPLEXDBL; } -+ -+ static int kwIx4 = e->KeywordIx("DOUBLE"); -+ if (e->KeywordSet(kwIx4)){ type = GDL_DOUBLE; } -+ -+ static int kwIx5 = e->KeywordIx("FLOAT"); -+ if (e->KeywordSet(kwIx5)){ type = GDL_FLOAT; } -+ -+ static int kwIx6 = e->KeywordIx("L64"); -+ if (e->KeywordSet(kwIx6)){ type = GDL_LONG64; } -+ -+ static int kwIx7 = e->KeywordIx("LONG"); -+ if (e->KeywordSet(kwIx7)){ type = GDL_LONG; } -+ -+ static int kwIx8 = e->KeywordIx("STRING"); -+ if (e->KeywordSet(kwIx8)){ type = GDL_STRING; } -+ -+ static int kwIx9 = e->KeywordIx("UINT"); -+ if (e->KeywordSet(kwIx9)){ type = GDL_UINT; } -+ -+ static int kwIx10 = e->KeywordIx("UL64"); -+ if (e->KeywordSet(kwIx10)){ type = GDL_ULONG64; } -+ -+ static int kwIx11 = e->KeywordIx("ULONG"); -+ if (e->KeywordSet(kwIx11)){ type = GDL_ULONG; } -+ -+ /*try -+ {*/ -+ // Seeing if the user passed in a TYPE code -+ static int kwIx12 = e->KeywordIx("TYPE"); -+ if ( e->KeywordPresent(kwIx12)){ -+ DLong temp_long; -+ e->AssureLongScalarKW(kwIx12, temp_long); -+ type = static_cast(temp_long); -+ } -+ -+ arr(e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ switch(type) -+ { -+ case GDL_INT: return new DIntGDL(dim, BaseGDL::INDGEN); -+ case GDL_BYTE: return new DByteGDL(dim, BaseGDL::INDGEN); -+ case GDL_COMPLEX: return new DComplexGDL(dim, BaseGDL::INDGEN); -+ case GDL_COMPLEXDBL: return new DComplexDblGDL(dim, BaseGDL::INDGEN); -+ case GDL_DOUBLE: return new DDoubleGDL(dim, BaseGDL::INDGEN); -+ case GDL_FLOAT: return new DFloatGDL(dim, BaseGDL::INDGEN); -+ case GDL_LONG64: return new DLong64GDL(dim, BaseGDL::INDGEN); -+ case GDL_LONG: return new DLongGDL(dim, BaseGDL::INDGEN); -+ case GDL_STRING: { -+ DULongGDL* iGen = new DULongGDL(dim, BaseGDL::INDGEN); -+ return iGen->Convert2(GDL_STRING); -+ } -+ case GDL_UINT: return new DUIntGDL(dim, BaseGDL::INDGEN); -+ case GDL_ULONG64: return new DULong64GDL(dim, BaseGDL::INDGEN); -+ case GDL_ULONG: return new DULongGDL(dim, BaseGDL::INDGEN); -+ default: -+ e->Throw( "Invalid type code specified."); -+ break; -+ } -+/* } -+ catch( GDLException& ex) -+ { -+ e->Throw( ex.getMessage()); -+ }*/ -+ } -+ -+ BaseGDL* uindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DUIntGDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "UINDGEN: "+ex.getMessage()); -+ } -+ */ } -+ BaseGDL* sindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ DULongGDL* iGen = new DULongGDL(dim, BaseGDL::INDGEN); -+ return iGen->Convert2( GDL_STRING); -+/* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "SINDGEN: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* lindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ return new DLongGDL(dim, BaseGDL::INDGEN); -+/* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "LINDGEN: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* ulindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DULongGDL(dim, BaseGDL::INDGEN); -+/* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "ULINDGEN: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* l64indgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DLong64GDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "L64INDGEN: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* ul64indgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DULong64GDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "UL64INDGEN: "+ex.getMessage()); -+ } -+ */ } -+ BaseGDL* findgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DFloatGDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "FINDGEN: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* dindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DDoubleGDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "DINDGEN: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* cindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DComplexGDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "CINDGEN: "+ex.getMessage()); -+ }*/ -+ } -+ BaseGDL* dcindgen( EnvT* e) -+ { -+ dimension dim; -+// try{ -+ arr( e, dim); -+ if (dim[0] == 0) -+ throw GDLException( "Array dimensions must be greater than 0"); -+ -+ return new DComplexDblGDL(dim, BaseGDL::INDGEN); -+ /* } -+ catch( GDLException& ex) -+ { -+ e->Throw( "DCINDGEN: "+ex.getMessage()); -+ } -+ */ } -+ -+ // only called from CALL_FUNCTION -+ // otherwise done directly in FCALL_LIB_N_ELEMENTSNode::Eval(); -+ // (but must be defined anyway for LibInit() for correct parametrization) -+ // N_ELEMENTS is special because on error it just returns 0L -+ // (the error is just caught and dropped) -+ BaseGDL* n_elements( EnvT* e) -+ { -+ SizeT nParam=e->NParam(1); -+ -+ BaseGDL* p0=e->GetPar( 0); -+ -+ if( p0 == NULL) return new DLongGDL( 0); -+ return new DLongGDL( p0->N_Elements()); -+ -+// assert( 0); -+// e->Throw("Internal error: lib::n_elements called."); -+// return NULL; // get rid of compiler warning -+ } -+ -+ template< typename ComplexGDL, typename Complex, typename Float> -+ BaseGDL* complex_fun_template( EnvT* e) -+ { -+ SizeT nParam=e->NParam( 1); -+ if( nParam <= 2) -+ { -+ if( nParam == 2) -+ { -+ BaseGDL* p0=e->GetParDefined( 0); -+ BaseGDL* p1=e->GetParDefined( 1); -+ -+ Float* p0Float = static_cast -+ (p0->Convert2( Float::t,BaseGDL::COPY)); -+ Guard p0FloatGuard(p0Float); -+ Float* p1Float = static_cast -+ (p1->Convert2( Float::t,BaseGDL::COPY)); -+ Guard p1FloatGuard(p1Float); -+ if( p0Float->Rank() == 0) -+ { -+ ComplexGDL* res = new ComplexGDL( p1Float->Dim(), -+ BaseGDL::NOZERO); -+ -+ SizeT nE=p1Float->N_Elements(); -+// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iRank() == 0) -+ { -+ ComplexGDL* res = new ComplexGDL( p0Float->Dim(), -+ BaseGDL::NOZERO); -+ -+ SizeT nE=p0Float->N_Elements(); -+// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iN_Elements() >= p1Float->N_Elements()) -+ { -+ ComplexGDL* res = new ComplexGDL( p1Float->Dim(), -+ BaseGDL::NOZERO); -+ -+ SizeT nE=p1Float->N_Elements(); -+// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iDim(), -+ BaseGDL::NOZERO); -+ -+ SizeT nE=p0Float->N_Elements(); -+// #pragma omp parallel if (nE >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nE)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iGetParDefined( 0); -+ if (ComplexGDL::t == p0->Type() && e->GlobalPar(0)) return p0; -+ return p0->Convert2( ComplexGDL::t, BaseGDL::COPY); -+ } -+ } -+ else // COMPLEX( expr, offs, dim1,..,dim8) -+ { -+ BaseGDL* p0 = e->GetParDefined( 0); -+ // *** WRONG: with offs data is converted bytewise -+ Float* p0Float = static_cast(p0->Convert2( Float::t,BaseGDL::COPY)); -+ Guard p0FloatGuard(p0Float); -+ -+ DLong offs; -+ e->AssureLongScalarPar( 1, offs); -+ -+ dimension dim; -+ arr( e, dim, 2); -+ -+ SizeT nElCreate=dim.NDimElements(); -+ -+ SizeT nElSource=p0->N_Elements(); -+ -+ if( (offs+2*nElCreate) > nElSource) -+ e->Throw( "Specified offset to" -+ " array is out of range: "+e->GetParString(0)); -+ -+ ComplexGDL* res=new ComplexGDL( dim, BaseGDL::NOZERO); -+ -+// #pragma omp parallel if (nElCreate >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nElCreate)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iKeywordSet("DOUBLE")) { -+ return complex_fun_template< DComplexDblGDL, DComplexDbl, DDoubleGDL>( e); -+ } else { -+ return complex_fun_template< DComplexGDL, DComplex, DFloatGDL>( e); -+ } -+} -+BaseGDL* dcomplex_fun( EnvT* e) -+{ -+ return complex_fun_template< DComplexDblGDL, DComplexDbl, DDoubleGDL>( e); -+} -+ -+ template< class TargetClass> -+ BaseGDL* type_fun( EnvT* e) -+ { -+ SizeT nParam=e->NParam(1); -+ -+ if( nParam == 1) -+ { -+ BaseGDL* p0=e->GetParDefined( 0); -+ -+ assert( dynamic_cast< EnvUDT*>( e->Caller()) != NULL); -+ -+ // type_fun( expr) just convert -+ if( static_cast< EnvUDT*>( e->Caller())->GetIOError() != NULL) -+ return p0->Convert2( TargetClass::t, -+ BaseGDL::COPY_THROWIOERROR); -+ // SA: see tracker item no. 3151760 -+ else if (TargetClass::t == p0->Type() && e->GlobalPar(0)) -+ return p0; -+ else -+ return p0->Convert2( TargetClass::t, BaseGDL::COPY); -+ } -+ -+ BaseGDL* p0=e->GetNumericParDefined( 0); -+ -+ // GDL_BYTE( expr, offs, dim1,..,dim8) -+ DLong offs; -+ e->AssureLongScalarPar( 1, offs); -+ -+ dimension dim; -+ -+ if( nParam > 2) -+ arr( e, dim, 2); -+ -+ TargetClass* res=new TargetClass( dim, BaseGDL::NOZERO); -+ -+ SizeT nByteCreate=res->NBytes(); // net size of new data -+ -+ SizeT nByteSource=p0->NBytes(); // net size of src -+ -+ if( offs < 0 || (offs+nByteCreate) > nByteSource) -+ { -+ GDLDelete(res); -+ e->Throw( "Specified offset to" -+ " expression is out of range: "+e->GetParString(0)); -+ } -+ -+ //*** POSSIBLE ERROR because of alignment here -+ void* srcAddr = static_cast( static_cast(p0->DataAddr()) + -+ offs); -+ void* dstAddr = static_cast(&(*res)[0]); -+ memcpy( dstAddr, srcAddr, nByteCreate); -+ -+ // char* srcAddr = reinterpret_cast(p0->DataAddr()); -+ // char* dstAddr = reinterpret_cast(&(*res)[0]); -+ // copy( srcAddr, srcAddr+nByteCreate, dstAddr); -+ -+ return res; -+ } -+ -+ BaseGDL* byte_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ BaseGDL* uint_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ BaseGDL* long_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ BaseGDL* ulong_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ BaseGDL* long64_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ BaseGDL* ulong64_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ BaseGDL* float_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ BaseGDL* double_fun( EnvT* e) -+ { -+ return type_fun( e); -+ } -+ // GDL_STRING function behaves different -+ BaseGDL* string_fun( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ -+ if( nParam == 0) -+ e->Throw( "Incorrect number of arguments."); -+ -+ bool printKey = e->KeywordSet( 4); -+ int parOffset = 0; -+ -+ // SA: handling special VMS-compatibility syntax, e.g.: string(1,'$(F)') -+ // (if nor FORMAT neither PRINT defined, >1 parameter, last param is scalar string -+ // which begins with "$(" or "(" but is not "()" then last param [minus "$"] is treated as FORMAT) -+ bool vmshack = false; -+ if (!printKey && (e->GetKW(0) == NULL) && nParam > 1) -+ { -+ vmshack = true; -+ BaseGDL* par = e->GetParDefined(nParam - 1); -+ if (par->Type() == GDL_STRING && par->Scalar()) -+ { -+ int dollar = (*static_cast(par))[0].compare(0,2,"$("); -+ if (dollar == 0 || ((*static_cast(par))[0].compare(0,1,"(") == 0 && (*static_cast(par))[0] != "()")) -+ { -+ e->SetKeyword("FORMAT", new DStringGDL( -+ (*static_cast(par))[0].c_str() + (dollar == 0 ? 1 : 0) -+ )); -+ } -+ } -+ } -+ -+ BaseGDL* format_kw = e->GetKW( 0); -+ bool formatKey = format_kw != NULL; -+ -+ if (formatKey && format_kw->Type() == GDL_STRING && (*static_cast(format_kw))[0] == "") formatKey = false; -+ -+ if( printKey || formatKey) // PRINT or FORMAT -+ { -+ stringstream os; -+ -+ SizeT width = 0; -+ if( printKey) // otherwise: FORMAT -> width is ignored -+ { -+ // for /PRINT always a terminal width of 80 is assumed -+ width = 80;//TermWidth(); -+ } -+ -+ if (vmshack) -+ { -+ parOffset = 1; -+ e->ShiftParNumbering(1); -+ } -+ print_os( &os, e, parOffset, width); -+ if (vmshack) -+ { -+ e->ShiftParNumbering(-1); -+ } -+ -+ vector buf; -+ while( os.good()) -+ { -+ string line; -+ getline( os, line); -+ if( os.good()) buf.push_back( line); -+ } -+ -+ SizeT bufSize = buf.size(); -+ if( bufSize == 0) -+ e->Throw( "Internal error: print buffer empty."); -+ -+ if( bufSize > 1) -+ { -+ DStringGDL* retVal = -+ new DStringGDL( dimension( bufSize), BaseGDL::NOZERO); -+ -+ for( SizeT i=0; i conversion -+ { -+ BaseGDL* p0 = e->GetParDefined( 0); -+ // SA: see tracker item no. 3151760 -+ if (p0->Type() == GDL_STRING && e->GlobalPar(0)) return p0; -+ return p0->Convert2( GDL_STRING, BaseGDL::COPY); -+ } -+ else // concatenation -+ { -+ DString s; -+ for( SizeT i=0; iGetParDefined( i); -+ DStringGDL* sP = static_cast -+ ( p->Convert2(GDL_STRING, -+ BaseGDL::COPY_BYTE_AS_INT)); -+ -+ SizeT nEl = sP->N_Elements(); -+ for( SizeT e=0; eIfDefGetKWAs( 0); -+ if (type != NULL) { -+ int typ = (*type)[0]; -+ if (typ == GDL_BYTE) -+ { -+ // SA: slow yet simple solution using GDL_BYTE->GDL_INT->GDL_BYTE conversion -+ return (e->KeywordSet(1) && e->GetPar(0)->Type() == GDL_STRING) -+ ? type_fun( e)->Convert2(GDL_BYTE, BaseGDL::CONVERT) -+ : type_fun( e); -+ } -+ if (typ == 0 || typ == GDL_INT) return type_fun( e); -+ if (typ == GDL_UINT) return type_fun( e); -+ if (typ == GDL_LONG) return type_fun( e); -+ if (typ == GDL_ULONG) return type_fun( e); -+ if (typ == GDL_LONG64) return type_fun( e); -+ if (typ == GDL_ULONG64) return type_fun( e); -+ if (typ == GDL_FLOAT) return type_fun( e); -+ if (typ == GDL_DOUBLE) return type_fun( e); -+ if (typ == GDL_COMPLEX) return type_fun( e); -+ if (typ == GDL_COMPLEXDBL) return type_fun( e); -+ if (typ == GDL_STRING) -+ { -+ // SA: calling GDL_STRING() with correct parameters -+ static int stringIx = LibFunIx("STRING"); -+ -+ assert( stringIx >= 0); -+ -+ EnvT* newEnv= new EnvT(e, libFunList[stringIx], NULL); -+ -+ Guard guard( newEnv); -+ -+ newEnv->SetNextPar(&e->GetPar(0)); // pass as global -+ if (e->KeywordSet(1) && e->GetPar(0)->Type() == GDL_BYTE) -+ newEnv->SetKeyword("PRINT", new DIntGDL(1)); -+// e->Interpreter()->CallStack().push_back( newEnv); -+ return static_cast(newEnv->GetPro())->Fun()(newEnv); -+ } -+ e->Throw( "Improper TYPE value."); -+ } -+ return type_fun( e); -+ } -+ -+ BaseGDL* call_function( EnvT* e) -+ { -+ int nParam=e->NParam(); -+ if( nParam == 0) -+ e->Throw( "No function specified."); -+ -+ DString callF; -+ e->AssureScalarPar( 0, callF); -+ -+ // this is a function name -> convert to UPPERCASE -+ callF = StrUpCase( callF); -+ -+ // first search library funcedures -+ int funIx=LibFunIx( callF); -+ if( funIx != -1) -+ { -+// e->PushNewEnv( libFunList[ funIx], 1); -+ // make the call -+// EnvT* newEnv = static_cast(e->Interpreter()->CallStack().back()); -+ -+ // handle direct call functions -+ if( libFunList[ funIx]->DirectCall()) -+ { -+ BaseGDL* directCallParameter = e->GetParDefined(1); -+ BaseGDL* res = -+ static_cast(libFunList[ funIx])->FunDirect()(directCallParameter, true /*isReference*/); -+ return res; -+ } -+ else -+ { -+ EnvT* newEnv = e->NewEnv( libFunList[ funIx], 1); -+ Guard guard( newEnv); -+ return static_cast(newEnv->GetPro())->Fun()(newEnv); -+ } -+ } -+ else -+ { -+ // no direct call here -+ -+ StackGuard guard( e->Interpreter()->CallStack()); -+ -+ funIx = GDLInterpreter::GetFunIx( callF); -+ -+ e->PushNewEnvUD( funList[ funIx], 1); -+ -+ // make the call -+ EnvUDT* newEnv = static_cast(e->Interpreter()->CallStack().back()); -+ return e->Interpreter()->call_fun(static_cast(newEnv->GetPro())->GetTree()); -+ } -+ } -+ -+ BaseGDL* call_method_function( EnvT* e) -+ { -+ StackGuard guard( e->Interpreter()->CallStack()); -+ -+ int nParam=e->NParam(); -+ if( nParam < 2) -+ e->Throw( "Name and object reference" -+ " must be specified."); -+ -+ DString callP; -+ e->AssureScalarPar( 0, callP); -+ -+ // this is a procedure name -> convert to UPPERCASE -+ callP = StrUpCase( callP); -+ -+ DStructGDL* oStruct = e->GetObjectPar( 1); -+ -+ DFun* method= oStruct->Desc()->GetFun( callP); -+ -+ if( method == NULL) -+ e->Throw( "Method not found: "+callP); -+// // // /**/ -+ e->PushNewEnvUD( method, 2, (DObjGDL**) &e->GetPar( 1)); -+ -+ // make the call -+ return e->Interpreter()->call_fun( method->GetTree()); -+ } -+ -+ -+ -+ BaseGDL* execute( EnvT* e) -+ { -+ int nParam=e->NParam( 1); -+ -+ bool quietCompile = false; -+ if( nParam == 2) -+ { -+ BaseGDL* p1 = e->GetParDefined( 1); -+ -+ if( !p1->Scalar()) -+ e->Throw( "Expression must be scalar in this context: "+ -+ e->GetParString(1)); -+ -+ quietCompile = p1->True(); -+ } -+ -+ if (e->GetParDefined(0)->Rank() != 0) -+ e->Throw("Expression must be scalar in this context: "+e->GetParString(0)); -+ -+ DString line; -+ e->AssureScalarPar( 0, line); -+ -+ // remove current environment (own one) -+ assert( dynamic_cast(e->Caller()) != NULL); -+ EnvUDT* caller = static_cast(e->Caller()); -+// e->Interpreter()->CallStack().pop_back(); -+ -+// wrong: e is guarded, do not delete it here -+// delete e; -+ -+ istringstream istr(line+"\n"); -+ -+ RefDNode theAST; -+ try { -+ GDLLexer lexer(istr, "", caller->CompileOpt()); -+ GDLParser& parser=lexer.Parser(); -+ -+ parser.interactive(); -+ -+ theAST=parser.getAST(); -+ } -+ catch( GDLException& ex) -+ { -+ if( !quietCompile) GDLInterpreter::ReportCompileError( ex); -+ return new DIntGDL( 0); -+ } -+ catch( ANTLRException ex) -+ { -+ if( !quietCompile) cerr << "EXECUTE: Lexer/Parser exception: " << -+ ex.getMessage() << endl; -+ return new DIntGDL( 0); -+ } -+ -+ if( theAST == NULL) return new DIntGDL( 1); -+ -+ RefDNode trAST; -+ try -+ { -+ GDLTreeParser treeParser( caller); -+ -+ treeParser.interactive(theAST); -+ -+ trAST=treeParser.getAST(); -+ } -+ catch( GDLException& ex) -+ { -+ if( !quietCompile) GDLInterpreter::ReportCompileError( ex); -+ return new DIntGDL( 0); -+ } -+ -+ catch( ANTLRException ex) -+ { -+ if( !quietCompile) cerr << "EXECUTE: Compiler exception: " << -+ ex.getMessage() << endl; -+ return new DIntGDL( 0); -+ } -+ -+ if( trAST == NULL) return new DIntGDL( 1); -+ -+ int nForLoopsIn = caller->NForLoops(); -+ try -+ { -+ ProgNodeP progAST = ProgNode::NewProgNode( trAST); -+ Guard< ProgNode> progAST_guard( progAST); -+ -+ int nForLoops = ProgNode::NumberForLoops( progAST, nForLoopsIn); -+ caller->ResizeForLoops( nForLoops); -+ -+ progAST->setLine( e->GetLineNumber()); -+ -+ RetCode retCode = caller->Interpreter()->execute( progAST); -+ -+ caller->ResizeForLoops( nForLoopsIn); -+ -+ if( retCode == RC_OK) -+ return new DIntGDL( 1); -+ else -+ return new DIntGDL( 0); -+ } -+ catch( GDLException& ex) -+ { -+ caller->ResizeForLoops( nForLoopsIn); -+ // are we throwing to target environment? -+// if( ex.GetTargetEnv() == NULL) -+ if( !quietCompile) cerr << "EXECUTE: " << -+ ex.getMessage() << endl; -+ return new DIntGDL( 0); -+ } -+ catch( ANTLRException ex) -+ { -+ caller->ResizeForLoops( nForLoopsIn); -+ -+ if( !quietCompile) cerr << "EXECUTE: Interpreter exception: " << -+ ex.getMessage() << endl; -+ return new DIntGDL( 0); -+ } -+ -+ return new DIntGDL( 0); // control flow cannot reach here - compiler shut up -+ } -+ -+ BaseGDL* assoc( EnvT* e) -+ { -+ SizeT nParam=e->NParam( 2); -+ -+ DLong lun; -+ e->AssureLongScalarPar( 0, lun); -+ -+ bool stdLun = check_lun( e, lun); -+ if( stdLun) -+ e->Throw( "File unit does not allow" -+ " this operation. Unit: "+i2s( lun)); -+ -+ DLong offset = 0; -+ if( nParam >= 3) e->AssureLongScalarPar( 2, offset); -+ -+ BaseGDL* arr = e->GetParDefined( 1); -+ -+ if( arr->StrictScalar()) -+ e->Throw( "Scalar variable not allowed in this" -+ " context: "+e->GetParString(1)); -+ -+ return arr->AssocVar( lun, offset); -+ } -+ -+ // gdl_ naming because of weired namespace problem in MSVC -+ BaseGDL* gdl_logical_and( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ if( nParam != 2) -+ e->Throw( -+ "Incorrect number of arguments."); -+ -+ BaseGDL* e1=e->GetParDefined( 0);//, "LOGICAL_AND"); -+ BaseGDL* e2=e->GetParDefined( 1);//, "LOGICAL_AND"); -+ -+ ULong nEl1 = e1->N_Elements(); -+ ULong nEl2 = e2->N_Elements(); -+ -+ Data_* res; -+ -+ if( e1->Scalar()) -+ { -+ if( e1->LogTrue(0)) -+ { -+ res= new Data_( e2->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl2; i++) -+ (*res)[i] = e2->LogTrue( i) ? 1 : 0; -+} -+ } -+ else -+ { -+ return new Data_( e2->Dim()); -+ } -+ } -+ else if( e2->Scalar()) -+ { -+ if( e2->LogTrue(0)) -+ { -+ res= new Data_( e1->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl1; i++) -+ (*res)[i] = e1->LogTrue( i) ? 1 : 0; -+} -+ } -+ else -+ { -+ return new Data_( e1->Dim()); -+ } -+ } -+ else if( nEl2 < nEl1) -+ { -+ res= new Data_( e2->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl2; i++) -+ (*res)[i] = (e1->LogTrue( i) && e2->LogTrue( i)) ? 1 : 0; -+} -+ } -+ else // ( nEl2 >= nEl1) -+ { -+ res= new Data_( e1->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl1; i++) -+ (*res)[i] = (e1->LogTrue( i) && e2->LogTrue( i)) ? 1 : 0; -+} -+ } -+ return res; -+ } -+ -+ // gdl_ naming because of weired namespace problem in MSVC -+ BaseGDL* gdl_logical_or( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ if( nParam != 2) -+ e->Throw( -+ "Incorrect number of arguments."); -+ -+ BaseGDL* e1=e->GetParDefined( 0);//, "LOGICAL_OR"); -+ BaseGDL* e2=e->GetParDefined( 1);//, "LOGICAL_OR"); -+ -+ ULong nEl1 = e1->N_Elements(); -+ ULong nEl2 = e2->N_Elements(); -+ -+ Data_* res; -+ -+ if( e1->Scalar()) -+ { -+ if( e1->LogTrue(0)) -+ { -+ res= new Data_( e2->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl2; i++) -+ (*res)[i] = 1; -+} -+ } -+ else -+ { -+ res= new Data_( e2->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl2; i++) -+ (*res)[i] = e2->LogTrue( i) ? 1 : 0; -+} -+ } -+ } -+ else if( e2->Scalar()) -+ { -+ if( e2->LogTrue(0)) -+ { -+ res= new Data_( e1->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl1; i++) -+ (*res)[i] = 1; -+} -+ } -+ else -+ { -+ res= new Data_( e1->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl1; i++) -+ (*res)[i] = e1->LogTrue( i) ? 1 : 0; -+} -+ } -+ } -+ else if( nEl2 < nEl1) -+ { -+ res= new Data_( e2->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl2 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl2)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl2; i++) -+ (*res)[i] = (e1->LogTrue( i) || e2->LogTrue( i)) ? 1 : 0; -+} -+ } -+ else // ( nEl2 >= nEl1) -+ { -+ res= new Data_( e1->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl1; i++) -+ (*res)[i] = (e1->LogTrue( i) || e2->LogTrue( i)) ? 1 : 0; -+} -+ } -+ return res; -+ } -+ -+ BaseGDL* logical_true( BaseGDL* e1, bool isReference)//( EnvT* e); -+ { -+ assert( e1 != NULL); -+ assert( e1->N_Elements() > 0); -+ -+ -+// SizeT nParam=e->NParam(); -+// if( nParam != 1) -+// e->Throw( -+// "Incorrect number of arguments."); -+// -+// BaseGDL* e1=e->GetParDefined( 0);//, "LOGICAL_TRUE"); -+// -+ ULong nEl1 = e1->N_Elements(); -+ -+ Data_* res = new Data_( e1->Dim(), BaseGDL::NOZERO); -+// #pragma omp parallel if (nEl1 >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl1)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i < nEl1; i++) -+ (*res)[i] = e1->LogTrue( i) ? 1 : 0; -+} -+ return res; -+ } -+ -+ BaseGDL* replicate( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ if( nParam < 2) -+ e->Throw( "Incorrect number of arguments."); -+ dimension dim; -+ arr( e, dim, 1); -+ -+ BaseGDL* p0=e->GetParDefined( 0);//, "REPLICATE"); -+ if( !p0->Scalar()) -+ e->Throw( "Expression must be a scalar in this context: "+ -+ e->GetParString(0)); -+ -+ return p0->New( dim, BaseGDL::INIT); -+ } -+ -+ BaseGDL* strtrim( EnvT* e) -+ { -+ SizeT nParam = e->NParam( 1);//, "STRTRIM"); -+ -+ BaseGDL* p0 = e->GetPar( 0); -+ if( p0 == NULL) -+ e->Throw( -+ "Variable is undefined: "+ -+ e->GetParString(0)); -+ DStringGDL* p0S = static_cast -+ (p0->Convert2(GDL_STRING,BaseGDL::COPY)); -+ -+ DLong mode = 0; -+ if( nParam == 2) -+ { -+ BaseGDL* p1 = e->GetPar( 1); -+ if( p1 == NULL) -+ e->Throw( -+ "Variable is undefined: "+e->GetParString(1)); -+ if( !p1->Scalar()) -+ e->Throw( -+ "Expression must be a " -+ "scalar in this context: "+ -+ e->GetParString(1)); -+ DLongGDL* p1L = static_cast -+ (p1->Convert2(GDL_LONG,BaseGDL::COPY)); -+ -+ mode = (*p1L)[ 0]; -+ -+ GDLDelete(p1L); -+ -+ if( mode < 0 || mode > 2) -+ { -+ ostringstream os; -+ p1->ToStream( os); -+ e->Throw( -+ "Value of <"+ p1->TypeStr() + -+ " ("+os.str()+ -+ ")> is out of allowed range."); -+ } -+ } -+ -+ SizeT nEl = p0S->N_Elements(); -+ -+ if( mode == 2) // both -+ { -+TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; iNParam( 1); -+ -+ DStringGDL* p0S = e->GetParAs( 0); -+ -+ bool removeAll = e->KeywordSet(0); -+ -+ DStringGDL* res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -+ -+ SizeT nEl = p0S->N_Elements(); -+TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; iNParam( 2);//, "STRPOS"); -+ -+ bool reverseOffset = e->KeywordSet(0); // REVERSE_OFFSET -+ bool reverseSearch = e->KeywordSet(1); // REVERSE_SEARCH -+ -+ DStringGDL* p0S = e->GetParAs( 0); -+ -+ DString searchString; -+ // e->AssureScalarPar( 1, searchString); -+ DStringGDL* sStr = e->GetParAs( 1); -+ if( !sStr->Scalar( searchString)) -+ e->Throw( "Search string must be a scalar or one element array: "+ -+ e->GetParString( 1)); -+ -+ unsigned long pos = string::npos; -+ if( nParam > 2) -+{ -+ BaseGDL* p2 = e->GetParDefined(2); -+// if( p2 != NULL) //e->AssureLongScalarPar( 2,posDLong); -+// { -+ const SizeT pIx = 2; -+ BaseGDL* p = e->GetParDefined( pIx); -+ DLongGDL* lp = static_cast(p->Convert2( GDL_LONG, BaseGDL::COPY)); -+ Guard guard_lp( lp); -+ DLong scalar; -+ if( !lp->Scalar( scalar)) -+ throw GDLException("Parameter must be a scalar in this context: "+ -+ e->GetParString(pIx)); -+ pos = scalar; -+ } -+ -+ DLongGDL* res = new DLongGDL( p0S->Dim(), BaseGDL::NOZERO); -+ -+ SizeT nSrcStr = p0S->N_Elements(); -+TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if ((nSrcStr*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nSrcStr*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; iNParam( 2);//, "STRMID"); -+ -+ bool reverse = e->KeywordSet(0); -+ -+ DStringGDL* p0S = e->GetParAs( 0); -+ DLongGDL* p1L = e->GetParAs( 1); -+ -+// BaseGDL* p2 = e->GetPar( 2); -+ DLongGDL* p2L = NULL; -+ if( nParam > 2) p2L = e->GetParAs( 2); -+ -+ DLong scVal1; -+ bool sc1 = p1L->Scalar( scVal1); -+ -+ DLong scVal2 = numeric_limits::max(); -+ bool sc2 = true; -+ if( p2L != NULL) -+ { -+ DLong scalar; -+ sc2 = p2L->Scalar( scalar); -+ scVal2 = scalar; -+ } -+ -+ DLong stride; -+ if( !sc1 && !sc2) -+ { -+ stride = p1L->Dim( 0); -+ if( stride != p2L->Dim( 0)) -+ e->Throw( "Starting offset and length arguments " -+ "have incompatible first dimension."); -+ } -+ else -+ { -+ // at least one scalar, p2L possibly NULL -+ if( p2L == NULL) -+ stride = p1L->Dim( 0); -+ else -+ stride = max( p1L->Dim( 0), p2L->Dim( 0)); -+ -+ stride = (stride > 0)? stride : 1; -+ } -+ -+ dimension resDim( p0S->Dim()); -+ if( stride > 1) -+ resDim >> stride; -+ -+ DStringGDL* res = new DStringGDL( resDim, BaseGDL::NOZERO); -+ -+ SizeT nEl1 = p1L->N_Elements(); -+ SizeT nEl2 = (sc2)? 1 : p2L->N_Elements(); -+ -+ SizeT nSrcStr = p0S->N_Elements(); -+ if( nSrcStr == 1) -+ { -+ // possibly this optimization is not worth the longer code (as the gain can only be a small fraction -+ // of the overall time), but then this is a very common use -+ for( long ii=0; ii= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nSrcStr*10))) default( shared) -+{ -+#pragma omp for -+ for( OMPInt i=0; iN_Elements() > 0); -+ -+// e->NParam( 1);//, "STRLOWCASE"); -+ -+// DStringGDL* p0S = e->GetParAs( 0); -+ DStringGDL* p0S; -+ DStringGDL* res; -+// Guard guard; -+ -+ if( p0->Type() == GDL_STRING) -+ { -+ p0S = static_cast( p0); -+ if( !isReference) -+ res = p0S; -+ else -+ res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -+ } -+ else -+ { -+ p0S = static_cast( p0->Convert2( GDL_STRING, BaseGDL::COPY)); -+ res = p0S; -+// guard.Reset( p0S); -+ } -+ -+// DStringGDL* res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -+ -+ SizeT nEl = p0S->N_Elements(); -+ -+ if( res == p0S) -+ { -+TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; iN_Elements() > 0); -+ -+// e->NParam( 1);//, "STRLOWCASE"); -+ -+// DStringGDL* p0S = e->GetParAs( 0); -+ DStringGDL* p0S; -+ DStringGDL* res; -+// Guard guard; -+ -+ if( p0->Type() == GDL_STRING) -+ { -+ p0S = static_cast( p0); -+ if( !isReference) -+ res = p0S; -+ else -+ res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -+ } -+ else -+ { -+ p0S = static_cast( p0->Convert2( GDL_STRING, BaseGDL::COPY)); -+ res = p0S; -+// guard.Reset( p0S); -+ } -+ -+// DStringGDL* res = new DStringGDL( p0S->Dim(), BaseGDL::NOZERO); -+ -+ SizeT nEl = p0S->N_Elements(); -+ -+ if( res == p0S) -+ { -+TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if ((nEl*10) >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= (nEl*10))) -+{ -+#pragma omp for -+ for( OMPInt i=0; iN_Elements() > 0); -+ -+// e->NParam( 1);//, "STRLEN"); -+ -+ DStringGDL* p0S; -+ Guard guard; -+ -+ if( p0->Type() == GDL_STRING) -+ p0S = static_cast( p0); -+ else -+ { -+ p0S = static_cast( p0->Convert2( GDL_STRING, BaseGDL::COPY)); -+ guard.Reset( p0S); -+ } -+ -+ DLongGDL* res = new DLongGDL( p0S->Dim(), BaseGDL::NOZERO); -+ -+ SizeT nEl = p0S->N_Elements(); -+// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iNParam( 1); -+ -+ DStringGDL* p0S = e->GetParAs( 0); -+ SizeT nEl = p0S->N_Elements(); -+ -+ DString delim = ""; -+ if( nParam > 1) -+ e->AssureStringScalarPar( 1, delim); -+ -+ bool single = e->KeywordSet( 0); // SINGLE -+ -+ if( single) -+ { -+ DStringGDL* res = new DStringGDL( (*p0S)[0]); -+ DString& scl = (*res)[0]; -+ -+ for( SizeT i=1; iDim()); -+ resDim.Purge(); -+ -+ SizeT stride = resDim.Stride( 1); -+ -+ resDim.Remove( 0); -+ -+ DStringGDL* res = new DStringGDL( resDim, BaseGDL::NOZERO); -+ for( SizeT src=0, dst=0; srcNParam( 1);//, "WHERE"); -+ -+ BaseGDL* p0 = e->GetParDefined( 0);//, "WHERE"); -+ -+ SizeT nEl = p0->N_Elements(); -+ -+ SizeT count; -+ -+ static int nullIx = e->KeywordIx("NULL"); -+ bool nullKW = e->KeywordSet(nullIx); -+ -+ DLong* ixList = p0->Where( e->KeywordPresent( 0), count); -+ ArrayGuard guard( ixList); -+ SizeT nCount = nEl - count; -+ -+ if( e->KeywordPresent( 0)) // COMPLEMENT -+ { -+ if( nCount == 0) -+ { -+ if( nullKW) -+ e->SetKW( 0, NullGDL::GetSingleInstance()); -+ else -+ e->SetKW( 0, new DLongGDL( -1)); -+ } -+ else -+ { -+ DLongGDL* cIxList = new DLongGDL( dimension( &nCount, 1), -+ BaseGDL::NOZERO); -+ -+ SizeT cIx = nEl - 1; -+// #pragma omp parallel if (nCount >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nCount)) -+{ -+// #pragma omp for -+ for( SizeT i=0; iSetKW( 0, cIxList); -+ } -+ } -+ -+ if( e->KeywordPresent( 1)) // NCOMPLEMENT -+ { -+ e->SetKW( 1, new DLongGDL( nCount)); -+ } -+ -+ if( nParam == 2) -+ { -+ e->SetPar( 1, new DLongGDL( count)); -+ } -+ -+ if( count == 0) -+ { -+ if( nullKW) -+ return NullGDL::GetSingleInstance(); -+ return new DLongGDL( -1); -+ } -+ -+ return new DLongGDL( ixList, count); -+ -+ // DLongGDL* res = new DLongGDL( dimension( &count, 1), -+ // BaseGDL::NOZERO); -+ // for( SizeT i=0; i(e->Caller()); -+ if( caller == NULL) return new DLongGDL( 0); -+ DLong nP = caller->NParam(); -+ if( caller->IsObject()) -+ return new DLongGDL( nP-1); // "self" is not counted -+ return new DLongGDL( nP); -+ } -+ -+ BaseGDL* keyword_set( EnvT* e) -+ { -+ e->NParam( 1);//, "KEYWORD_SET"); -+ -+ BaseGDL* p0 = e->GetPar( 0); -+ if( p0 == NULL) return new DIntGDL( 0); -+ if( !p0->Scalar()) return new DIntGDL( 1); -+ if( p0->Type() == GDL_STRUCT) return new DIntGDL( 1); -+ if( p0->LogTrue()) return new DIntGDL( 1); -+ return new DIntGDL( 0); -+ } -+ -+ // passing 2nd argument by value is slightly better for float and double, -+ // but incur some overhead for the complex class. -+ template inline void AddOmitNaN(T& dest, T value) -+{ -+ if (isfinite(value)) -+{ -+// #pragma omp atomic -+ dest += value; -+} -+} -+ template inline void AddOmitNaNCpx(T& dest, T value) -+ { -+// #pragma omp atomic -+ dest += T(isfinite(value.real())? value.real() : 0, -+ isfinite(value.imag())? value.imag() : 0); -+ } -+ template<> inline void AddOmitNaN(DComplex& dest, DComplex value) -+ { AddOmitNaNCpx(dest, value); } -+ template<> inline void AddOmitNaN(DComplexDbl& dest, DComplexDbl value) -+ { AddOmitNaNCpx(dest, value); } -+ -+ template inline void NaN2Zero(T& value) -+ { if (!isfinite(value)) value = 0; } -+ template inline void NaN2ZeroCpx(T& value) -+ { -+ value = T(isfinite(value.real())? value.real() : 0, -+ isfinite(value.imag())? value.imag() : 0); -+ } -+ template<> inline void NaN2Zero(DComplex& value) -+ { NaN2ZeroCpx< DComplex>(value); } -+ template<> inline void NaN2Zero(DComplexDbl& value) -+ { NaN2ZeroCpx< DComplexDbl>(value); } -+ -+ // total over all elements -+ template -+ BaseGDL* total_template( T* src, bool omitNaN) -+ { -+ if (!omitNaN) return new T(src->Sum()); -+ typename T::Ty sum = 0; -+ SizeT nEl = src->N_Elements(); -+TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(sum) -+{ -+#pragma omp for -+ for ( OMPInt i=0; i -+ BaseGDL* total_cu_template( T* res, bool omitNaN) -+ { -+ SizeT nEl = res->N_Elements(); -+ if (omitNaN) -+ { -+// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+{ -+// #pragma omp for -+ for( SizeT i=0; i -+ BaseGDL* total_over_dim_template( T* src, -+ const dimension& srcDim, -+ SizeT sumDimIx, -+ bool omitNaN) -+ { -+ SizeT nEl = src->N_Elements(); -+ -+ // get dest dim and number of summations -+ dimension destDim = srcDim; -+ SizeT nSum = destDim.Remove( sumDimIx); -+ -+ T* res = new T( destDim); // zero fields -+ -+ // sumStride is also the number of linear src indexing -+ SizeT sumStride = srcDim.Stride( sumDimIx); -+ SizeT outerStride = srcDim.Stride( sumDimIx + 1); -+ SizeT sumLimit = nSum * sumStride; -+ SizeT rIx=0; -+ for( SizeT o=0; o < nEl; o += outerStride) -+ for( SizeT i=0; i < sumStride; ++i) -+ { -+ SizeT oi = o+i; -+ SizeT oiLimit = sumLimit + oi; -+ if( omitNaN) -+ { -+ for( SizeT s=oi; s -+ BaseGDL* total_over_dim_cu_template( T* res, -+ SizeT sumDimIx, -+ bool omitNaN) -+ { -+ SizeT nEl = res->N_Elements(); -+ const dimension& resDim = res->Dim(); -+ if (omitNaN) -+ { -+ for( SizeT i=0; iNParam( 1);//, "TOTAL"); -+ -+ BaseGDL* p0 = e->GetParDefined( 0);//, "TOTAL"); -+ -+ SizeT nEl = p0->N_Elements(); -+ if( nEl == 0) -+ e->Throw( "Variable is undefined: "+e->GetParString(0)); -+ -+ if( p0->Type() == GDL_STRING) -+ e->Throw( "String expression not allowed " -+ "in this context: "+e->GetParString(0)); -+ -+ static int cumIx = e->KeywordIx( "CUMULATIVE"); -+ static int intIx = e->KeywordIx("INTEGER"); -+ static int doubleIx = e->KeywordIx( "DOUBLE"); -+ static int nanIx = e->KeywordIx( "NAN"); -+ static int preserveIx = e->KeywordIx( "PRESERVE_TYPE"); -+ -+ bool cumulative = e->KeywordSet( cumIx); -+ bool intRes = e->KeywordSet( intIx); -+ bool doubleRes = e->KeywordSet( doubleIx); -+ bool nan = e->KeywordSet( nanIx); -+ bool preserve = e->KeywordSet( preserveIx); -+ -+ DLong sumDim = 0; -+ if( nParam == 2) -+ e->AssureLongScalarPar( 1, sumDim); -+ -+ if( sumDim == 0) -+ { -+ if( !cumulative) -+ { -+ if (preserve) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return total_template(static_cast(p0), false); -+ case GDL_INT: return total_template(static_cast(p0), false); -+ case GDL_UINT: return total_template(static_cast(p0), false); -+ case GDL_LONG: return total_template(static_cast(p0), false); -+ case GDL_ULONG: return total_template(static_cast(p0), false); -+ case GDL_LONG64: return total_template(static_cast(p0), false); -+ case GDL_ULONG64: return total_template(static_cast(p0), false); -+ case GDL_FLOAT: return total_template(static_cast(p0), nan); -+ case GDL_DOUBLE: return total_template(static_cast(p0), nan); -+ case GDL_COMPLEX: return total_template(static_cast(p0), nan); -+ case GDL_COMPLEXDBL: return total_template(static_cast(p0), nan); -+ default: assert(false); -+ } -+ } -+ -+ // Integer parts by Erin Sheldon -+ // In IDL total(), the INTEGER keyword takes precedence -+ if( intRes ) -+ { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ( p0->Type() == GDL_LONG64 ) -+ { -+ return total_template -+ ( static_cast(p0), nan ); -+ } -+ if ( p0->Type() == GDL_ULONG64 ) -+ { -+ return total_template -+ ( static_cast(p0), nan ); -+ } -+ -+ // Conver to Long64 -+ DLong64GDL* p0L64 = static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -+ Guard guard( p0L64); -+ return total_template( p0L64, nan); -+ -+ } // integer results -+ -+ -+ if( p0->Type() == GDL_DOUBLE) -+ { -+ return total_template -+ ( static_cast(p0), nan); -+ } -+ if( p0->Type() == GDL_COMPLEXDBL) -+ { -+ return total_template -+ ( static_cast(p0), nan); -+ } -+ -+ if( !doubleRes) -+ { -+ if( p0->Type() == GDL_FLOAT) -+ { -+ return total_template -+ ( static_cast(p0), nan); -+ } -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ return total_template -+ ( static_cast(p0), nan); -+ } -+ DFloatGDL* p0F = static_cast -+ (p0->Convert2( GDL_FLOAT,BaseGDL::COPY)); -+ Guard guard( p0F); -+ return total_template( p0F, false); -+ } -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ DComplexDblGDL* p0D = static_cast -+ (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ return total_template( p0D, nan); -+ } -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ return total_template( p0D, nan); -+ } -+ else // cumulative -+ { -+ if (preserve) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return total_cu_template(static_cast(p0)->Dup(), false); -+ case GDL_INT: return total_cu_template(static_cast(p0)->Dup(), false); -+ case GDL_UINT: return total_cu_template(static_cast(p0)->Dup(), false); -+ case GDL_LONG: return total_cu_template(static_cast(p0)->Dup(), false); -+ case GDL_ULONG: return total_cu_template(static_cast(p0)->Dup(), false); -+ case GDL_LONG64: return total_cu_template(static_cast(p0)->Dup(), false); -+ case GDL_ULONG64: return total_cu_template(static_cast(p0)->Dup(), false); -+ case GDL_FLOAT: return total_cu_template(static_cast(p0)->Dup(), nan); -+ case GDL_DOUBLE: return total_cu_template(static_cast(p0)->Dup(), nan); -+ case GDL_COMPLEX: return total_cu_template(static_cast(p0)->Dup(), nan); -+ case GDL_COMPLEXDBL: return total_cu_template(static_cast(p0)->Dup(), nan); -+ default: assert(false); -+ } -+ } -+ -+ // INTEGER keyword takes precedence -+ if( intRes ) -+ { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ( p0->Type() == GDL_LONG64 ) -+ { -+ return total_cu_template -+ ( static_cast(p0)->Dup(), nan ); -+ } -+ if ( p0->Type() == GDL_ULONG64 ) -+ { -+ return total_cu_template -+ ( static_cast(p0)->Dup(), nan ); -+ } -+ -+ // Convert to Long64 -+ return total_cu_template -+ ( static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)), nan); -+ -+ } // integer results -+ -+ -+ // special case as GDL_DOUBLE type overrides /GDL_DOUBLE -+ if( p0->Type() == GDL_DOUBLE) -+ { -+ return total_cu_template< DDoubleGDL> -+ ( static_cast(p0)->Dup(), nan); -+ } -+ if( p0->Type() == GDL_COMPLEXDBL) -+ { -+ return total_cu_template< DComplexDblGDL> -+ ( static_cast(p0)->Dup(), nan); -+ } -+ -+ -+ -+ if( !doubleRes) -+ { -+ // special case for GDL_FLOAT has no advantage here -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ return total_cu_template< DComplexGDL> -+ ( static_cast(p0)->Dup(), nan); -+ } -+ return total_cu_template< DFloatGDL> -+ ( static_cast( p0->Convert2(GDL_FLOAT, -+ BaseGDL::COPY)), nan); -+ } -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ return total_cu_template< DComplexDblGDL> -+ ( static_cast(p0->Convert2( GDL_COMPLEXDBL, -+ BaseGDL::COPY)), nan); -+ } -+ return total_cu_template< DDoubleGDL> -+ ( static_cast(p0->Convert2( GDL_DOUBLE, -+ BaseGDL::COPY)), nan); -+ } -+ } -+ -+ // total over sumDim -+ dimension srcDim = p0->Dim(); -+ SizeT srcRank = srcDim.Rank(); -+ -+ if( sumDim < 1 || sumDim > srcRank) -+ e->Throw( -+ "Array must have "+i2s(sumDim)+ -+ " dimensions: "+e->GetParString(0)); -+ -+ if( !cumulative) -+ { -+ if (preserve) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -+ case GDL_INT: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -+ case GDL_UINT: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -+ case GDL_LONG: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -+ case GDL_ULONG: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -+ case GDL_LONG64: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -+ case GDL_ULONG64: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, false); -+ case GDL_FLOAT: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -+ case GDL_DOUBLE: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -+ case GDL_COMPLEX: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -+ case GDL_COMPLEXDBL: return total_over_dim_template(static_cast(p0), srcDim, sumDim-1, nan); -+ default: assert(false); -+ } -+ } -+ -+ // INTEGER keyword takes precedence -+ if( intRes ) -+ { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ( p0->Type() == GDL_LONG64 ) -+ { -+ return total_over_dim_template -+ ( static_cast(p0), srcDim, sumDim-1, nan ); -+ } -+ if ( p0->Type() == GDL_ULONG64 ) -+ { -+ return total_over_dim_template -+ ( static_cast(p0), srcDim, sumDim-1, nan ); -+ } -+ -+ // Conver to Long64 -+ DLong64GDL* p0L64 = static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -+ -+ Guard p0L64_guard( p0L64); -+ return total_over_dim_template -+ ( p0L64, srcDim, sumDim-1, nan); -+ -+ } // integer results -+ -+ -+ if( p0->Type() == GDL_DOUBLE) -+ { -+ return total_over_dim_template< DDoubleGDL> -+ ( static_cast(p0), srcDim, sumDim-1, nan); -+ } -+ if( p0->Type() == GDL_COMPLEXDBL) -+ { -+ return total_over_dim_template< DComplexDblGDL> -+ ( static_cast(p0), srcDim, sumDim-1, nan); -+ } -+ if( !doubleRes) -+ { -+ if( p0->Type() == GDL_FLOAT) -+ { -+ return total_over_dim_template< DFloatGDL> -+ ( static_cast(p0), srcDim, sumDim-1, nan); -+ } -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ return total_over_dim_template< DComplexGDL> -+ ( static_cast(p0), srcDim, sumDim-1, nan); -+ } -+ // default for NOT /GDL_DOUBLE -+ DFloatGDL* p0F = static_cast -+ (p0->Convert2( GDL_FLOAT,BaseGDL::COPY)); -+ Guard p0F_guard( p0F); -+ // p0F_guard.Reset( p0F); -+ return total_over_dim_template< DFloatGDL> -+ ( p0F, srcDim, sumDim-1, false); -+ } -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ DComplexDblGDL* p0D = static_cast -+ (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ // p0D_guard.Reset( p0D); -+ return total_over_dim_template< DComplexDblGDL> -+ ( p0D, srcDim, sumDim-1, nan); -+ } -+ // default for /GDL_DOUBLE -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE,BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ //p0D_guard.Reset( p0D); -+ return total_over_dim_template< DDoubleGDL>( p0D, srcDim, sumDim-1,nan); -+ } -+ else // cumulative -+ { -+ if (preserve) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -+ case GDL_INT: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -+ case GDL_UINT: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -+ case GDL_LONG: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -+ case GDL_ULONG: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -+ case GDL_LONG64: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -+ case GDL_ULONG64: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, false); -+ case GDL_FLOAT: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -+ case GDL_DOUBLE: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -+ case GDL_COMPLEX: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -+ case GDL_COMPLEXDBL: return total_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nan); -+ default: assert(false); -+ } -+ } -+ -+ // INTEGER keyword takes precedence -+ if( intRes ) -+ { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ( p0->Type() == GDL_LONG64 ) -+ { -+ return total_over_dim_cu_template -+ ( static_cast(p0)->Dup(), sumDim-1, nan ); -+ } -+ if ( p0->Type() == GDL_ULONG64 ) -+ { -+ return total_over_dim_cu_template -+ ( static_cast(p0)->Dup(), sumDim-1, nan ); -+ } -+ -+ // Convert to Long64 -+ return total_over_dim_cu_template -+ ( static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)), sumDim-1, nan); -+ -+ } // integer results -+ -+ -+ if( p0->Type() == GDL_DOUBLE) -+ { -+ return total_over_dim_cu_template< DDoubleGDL> -+ ( static_cast(p0)->Dup(), sumDim-1, nan); -+ } -+ if( p0->Type() == GDL_COMPLEXDBL) -+ { -+ return total_over_dim_cu_template< DComplexDblGDL> -+ ( static_cast(p0)->Dup(), sumDim-1, nan); -+ } -+ if( !doubleRes) -+ { -+ // special case for GDL_FLOAT has no advantage here -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ return total_over_dim_cu_template< DComplexGDL> -+ ( static_cast(p0)->Dup(), sumDim-1, nan); -+ } -+ // default for NOT /GDL_DOUBLE -+ return total_over_dim_cu_template< DFloatGDL> -+ ( static_cast( p0->Convert2( GDL_FLOAT, -+ BaseGDL::COPY)), sumDim-1, nan); -+ } -+ if( p0->Type() == GDL_COMPLEX) -+ { -+ return total_over_dim_cu_template< DComplexDblGDL> -+ ( static_cast(p0->Convert2( GDL_COMPLEXDBL, -+ BaseGDL::COPY)), sumDim-1, nan); -+ } -+ // default for /GDL_DOUBLE -+ return total_over_dim_cu_template< DDoubleGDL> -+ ( static_cast(p0->Convert2( GDL_DOUBLE, -+ BaseGDL::COPY)), sumDim-1, nan); -+ } -+ } -+ -+ -+ // passing 2nd argument by value is slightly better for float and double, -+ // but incur some overhead for the complex class. -+ template inline void MultOmitNaN(T& dest, T value) -+ { -+ if (isfinite(value)) -+ { -+// #pragma omp atomic -+ dest *= value; -+ } -+ } -+ template inline void MultOmitNaNCpx(T& dest, T value) -+ { -+ dest *= T(isfinite(value.real())? value.real() : 1, -+ isfinite(value.imag())? value.imag() : 1); -+ } -+ template<> inline void MultOmitNaN(DComplex& dest, DComplex value) -+ { MultOmitNaNCpx(dest, value); } -+ template<> inline void MultOmitNaN(DComplexDbl& dest, DComplexDbl value) -+ { MultOmitNaNCpx(dest, value); } -+ -+ template inline void Nan2One(T& value) -+ { if (!isfinite(value)) value = 1; } -+ template inline void Nan2OneCpx(T& value) -+ { -+ value = T(isfinite(value.real())? value.real() : 1, -+ isfinite(value.imag())? value.imag() : 1); -+ } -+ template<> inline void Nan2One(DComplex& value) -+ { Nan2OneCpx< DComplex>(value); } -+ template<> inline void Nan2One(DComplexDbl& value) -+ { Nan2OneCpx< DComplexDbl>(value); } -+ -+ // product over all elements -+ template -+ BaseGDL* product_template( T* src, bool omitNaN) -+ { -+ typename T::Ty sum = 1; -+ SizeT nEl = src->N_Elements(); -+ if( !omitNaN) -+ { -+TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(sum) -+{ -+#pragma omp for reduction(*:sum) -+ for ( OMPInt i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(sum) -+{ -+#pragma omp for reduction(*:sum) -+ for ( OMPInt i=0; i -+ BaseGDL* product_template( DComplexGDL* src, bool omitNaN) -+ { -+ DComplexGDL::Ty sum = 1; -+ SizeT nEl = src->N_Elements(); -+ if( !omitNaN) -+ { -+ for ( SizeT i=0; i -+ BaseGDL* product_template( DComplexDblGDL* src, bool omitNaN) -+ { -+ DComplexDblGDL::Ty sum = 1; -+ SizeT nEl = src->N_Elements(); -+ if( !omitNaN) -+ { -+ for ( SizeT i=0; i -+ BaseGDL* product_cu_template( T* res, bool omitNaN) -+ { -+ SizeT nEl = res->N_Elements(); -+ if( omitNaN) -+ { -+ for( SizeT i=0; i -+ BaseGDL* product_over_dim_template( T* src, -+ const dimension& srcDim, -+ SizeT sumDimIx, -+ bool omitNaN) -+ { -+ SizeT nEl = src->N_Elements(); -+ -+ // get dest dim and number of summations -+ dimension destDim = srcDim; -+ SizeT nSum = destDim.Remove( sumDimIx); -+ -+ T* res = new T( destDim, BaseGDL::NOZERO); -+ -+ // sumStride is also the number of linear src indexing -+ SizeT sumStride = srcDim.Stride( sumDimIx); -+ SizeT outerStride = srcDim.Stride( sumDimIx + 1); -+ SizeT sumLimit = nSum * sumStride; -+ SizeT rIx=0; -+ for( SizeT o=0; o < nEl; o += outerStride) -+ for( SizeT i=0; i < sumStride; ++i) -+ { -+ (*res)[ rIx] = 1; -+ SizeT oi = o+i; -+ SizeT oiLimit = sumLimit + oi; -+ if( omitNaN) -+ { -+ for( SizeT s=oi; s -+ BaseGDL* product_over_dim_cu_template( T* res, -+ SizeT sumDimIx, -+ bool omitNaN) -+ { -+ SizeT nEl = res->N_Elements(); -+ const dimension& resDim = res->Dim(); -+ if (omitNaN) -+ { -+ for( SizeT i=0; iNParam( 1); -+ -+ BaseGDL* p0 = e->GetParDefined( 0); -+ -+ SizeT nEl = p0->N_Elements(); -+ if( nEl == 0) -+ e->Throw( "Variable is undefined: "+e->GetParString(0)); -+ -+ if( p0->Type() == GDL_STRING) -+ e->Throw( "String expression not allowed " -+ "in this context: "+e->GetParString(0)); -+ -+ static int cumIx = e->KeywordIx( "CUMULATIVE"); -+ static int nanIx = e->KeywordIx( "NAN"); -+ static int intIx = e->KeywordIx("INTEGER"); -+ static int preIx = e->KeywordIx("PRESERVE_TYPE"); -+ bool KwCumul = e->KeywordSet( cumIx); -+ bool KwNaN = e->KeywordSet( nanIx); -+ bool KwInt = e->KeywordSet( intIx); -+ bool KwPre = e->KeywordSet( preIx); -+ bool nanInt=false; -+ -+ DLong sumDim = 0; -+ if( nParam == 2) -+ e->AssureLongScalarPar( 1, sumDim); -+ -+ if( sumDim == 0) { -+ if( !KwCumul) { -+ if (KwPre) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return product_template(static_cast(p0), nanInt); -+ case GDL_INT: return product_template(static_cast(p0), nanInt); -+ case GDL_UINT: return product_template(static_cast(p0), nanInt); -+ case GDL_LONG: return product_template(static_cast(p0), nanInt); -+ case GDL_ULONG: return product_template(static_cast(p0), nanInt); -+ case GDL_LONG64: return product_template(static_cast(p0), nanInt); -+ case GDL_ULONG64: return product_template(static_cast(p0), nanInt); -+ case GDL_FLOAT: return product_template(static_cast(p0), KwNaN); -+ case GDL_DOUBLE: return product_template(static_cast(p0), KwNaN); -+ case GDL_COMPLEX: return product_template(static_cast(p0), KwNaN); -+ case GDL_COMPLEXDBL: return product_template(static_cast(p0), KwNaN); -+ default: assert(false); -+ } -+ } -+ -+ // Integer parts derivated from Total code by Erin Sheldon -+ // In IDL PRODUCT(), the INTEGER keyword takes precedence -+ if (KwInt) { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ((p0->Type() == GDL_LONG64) && (!KwNaN)) { -+ return product_template -+ ( static_cast(p0), nanInt ); -+ } -+ if ((p0->Type() == GDL_ULONG64) && (!KwNaN)) { -+ return product_template -+ (static_cast(p0), nanInt ); -+ } -+ -+ // Convert to Long64 -+ DLong64GDL* p0L64 = static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -+ Guard guard( p0L64); -+ if (KwNaN) { -+ DFloatGDL* p0f = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ Guard guard( p0f); -+ for( SizeT i=0; i( p0L64, nanInt); -+ } // integer results -+ -+ if( p0->Type() == GDL_DOUBLE) { -+ return product_template -+ ( static_cast(p0), KwNaN); -+ } -+ if( p0->Type() == GDL_COMPLEXDBL) { -+ return product_template -+ ( static_cast(p0), KwNaN); -+ } -+ if( p0->Type() == GDL_COMPLEX) { -+ DComplexDblGDL* p0D = static_cast -+ (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ //p0D_guard.Reset( p0D); -+ return product_template( p0D, KwNaN); -+ } -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ // p0D_guard.Reset( p0D); -+ return product_template( p0D, KwNaN); -+ } -+ else -+ { // KwCumul -+ -+ if (KwPre) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return product_cu_template(static_cast(p0)->Dup(), nanInt); -+ case GDL_INT: return product_cu_template(static_cast(p0)->Dup(), nanInt); -+ case GDL_UINT: return product_cu_template(static_cast(p0)->Dup(), nanInt); -+ case GDL_LONG: return product_cu_template(static_cast(p0)->Dup(), nanInt); -+ case GDL_ULONG: return product_cu_template(static_cast(p0)->Dup(), nanInt); -+ case GDL_LONG64: return product_cu_template(static_cast(p0)->Dup(), nanInt); -+ case GDL_ULONG64: return product_cu_template(static_cast(p0)->Dup(), nanInt); -+ case GDL_FLOAT: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -+ case GDL_DOUBLE: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -+ case GDL_COMPLEX: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -+ case GDL_COMPLEXDBL: return product_cu_template(static_cast(p0)->Dup(), KwNaN); -+ default: assert(false); -+ } -+ } -+ -+ // Integer parts derivated from Total code by Erin Sheldon -+ // In IDL PRODUCT(), the INTEGER keyword takes precedence -+ if (KwInt) { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ((p0->Type() == GDL_LONG64) && (!KwNaN)) { -+ return product_cu_template -+ ( static_cast(p0)->Dup(), nanInt); -+ } -+ if ((p0->Type() == GDL_ULONG64) && (!KwNaN)) { -+ return product_cu_template -+ ( static_cast(p0)->Dup(), nanInt); -+ } -+ // Convert to Long64 -+ DLong64GDL* p0L64 = static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -+ Guard guard( p0L64); -+ if (KwNaN) { -+ DFloatGDL* p0f = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ Guard guard( p0f); -+ for( SizeT i=0; i -+ ((p0L64)->Dup(), nanInt); -+ } // integer results -+ -+ // special case as GDL_DOUBLE type overrides /GDL_DOUBLE -+ if (p0->Type() == GDL_DOUBLE) { -+ return product_cu_template< DDoubleGDL> -+ ( static_cast(p0)->Dup(), KwNaN); -+ } -+ if (p0->Type() == GDL_COMPLEXDBL) { -+ return product_cu_template< DComplexDblGDL> -+ ( static_cast(p0)->Dup(), KwNaN); -+ } -+ if (p0->Type() == GDL_COMPLEX) { -+ return product_cu_template< DComplexDblGDL> -+ ( static_cast -+ (p0->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY)), KwNaN); -+ } -+ return product_cu_template< DDoubleGDL> -+ ( static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)), KwNaN); -+ } -+ } -+ -+ // product over sumDim -+ dimension srcDim = p0->Dim(); -+ SizeT srcRank = srcDim.Rank(); -+ -+ if( sumDim < 1 || sumDim > srcRank) -+ e->Throw( "Array must have "+i2s(sumDim)+ -+ " dimensions: "+e->GetParString(0)); -+ -+ if (!KwCumul) { -+ -+ if (KwPre) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -+ case GDL_INT: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -+ case GDL_UINT: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -+ case GDL_LONG: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -+ case GDL_ULONG: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -+ case GDL_LONG64: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -+ case GDL_ULONG64: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, nanInt); -+ case GDL_FLOAT: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -+ case GDL_DOUBLE: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -+ case GDL_COMPLEX: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -+ case GDL_COMPLEXDBL: return product_over_dim_template(static_cast(p0), srcDim, sumDim-1, KwNaN); -+ default: assert(false); -+ } -+ } -+ -+ // Integer parts derivated from Total code by Erin Sheldon -+ // In IDL PRODUCT(), the INTEGER keyword takes precedence -+ if (KwInt) { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ((p0->Type() == GDL_LONG64 ) && (!KwNaN)) { -+ return product_over_dim_template -+ ( static_cast(p0), srcDim, sumDim-1, nanInt); -+ } -+ if ((p0->Type() == GDL_ULONG64) && (!KwNaN)) { -+ return product_over_dim_template -+ ( static_cast(p0), srcDim, sumDim-1, nanInt); -+ } -+ -+ // Conver to Long64 -+ DLong64GDL* p0L64 = static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)); -+ Guard guard( p0L64); -+ if (KwNaN) { -+ DFloatGDL* p0f = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ Guard guard( p0f); -+ for( SizeT i=0; i -+ ( p0L64, srcDim, sumDim-1, nanInt); -+ } // integer results -+ -+ if( p0->Type() == GDL_DOUBLE) { -+ return product_over_dim_template< DDoubleGDL> -+ ( static_cast(p0), srcDim, sumDim-1, KwNaN); -+ } -+ if( p0->Type() == GDL_COMPLEXDBL) { -+ return product_over_dim_template< DComplexDblGDL> -+ ( static_cast(p0), srcDim, sumDim-1, KwNaN); -+ } -+ if( p0->Type() == GDL_COMPLEX) { -+ DComplexDblGDL* p0D = static_cast -+ (p0->Convert2( GDL_COMPLEXDBL,BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ // p0D_guard.Reset( p0D); -+ return product_over_dim_template< DComplexDblGDL> -+ ( p0D, srcDim, sumDim-1, KwNaN); -+ } -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE,BaseGDL::COPY)); -+ Guard p0D_guard( p0D); -+ //p0D_guard.Reset( p0D); -+ return product_over_dim_template< DDoubleGDL> -+ ( p0D, srcDim, sumDim-1,KwNaN); -+ } -+ else -+ { // KwCumul -+ -+ if (KwPre) -+ { -+ switch (p0->Type()) -+ { -+ case GDL_BYTE: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -+ case GDL_INT: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -+ case GDL_UINT: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -+ case GDL_LONG: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -+ case GDL_ULONG: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -+ case GDL_LONG64: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -+ case GDL_ULONG64: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, nanInt); -+ case GDL_FLOAT: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -+ case GDL_DOUBLE: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -+ case GDL_COMPLEX: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -+ case GDL_COMPLEXDBL: return product_over_dim_cu_template(static_cast(p0)->Dup(), sumDim-1, KwNaN); -+ default: assert(false); -+ } -+ } -+ -+ // Integer parts derivated from Total code by Erin Sheldon -+ // In IDL PRODUCT(), the INTEGER keyword takes precedence -+ if (KwInt) { -+ // We use GDL_LONG64 unless the input is GDL_ULONG64 -+ if ((p0->Type() == GDL_LONG64) && (!KwNaN)) { -+ return product_over_dim_cu_template -+ ( static_cast(p0)->Dup(), sumDim-1, nanInt); -+ } -+ if ((p0->Type() == GDL_ULONG64 ) && (!KwNaN)) { -+ return product_over_dim_cu_template -+ ( static_cast(p0)->Dup(), sumDim-1, nanInt); -+ } -+ -+ // Convert to Long64 -+ if (KwNaN) { -+ DFloatGDL* p0f = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ Guard guard( p0f); -+ for( SizeT i=0; i -+ ( static_cast -+ (p0f->Convert2( GDL_LONG64, BaseGDL::COPY)), sumDim-1, nanInt); -+ } else { -+ return product_over_dim_cu_template -+ ( static_cast -+ (p0->Convert2( GDL_LONG64, BaseGDL::COPY)), sumDim-1, nanInt); -+ } -+ } // integer results -+ -+ if( p0->Type() == GDL_DOUBLE) { -+ return product_over_dim_cu_template< DDoubleGDL> -+ ( static_cast(p0)->Dup(), sumDim-1, KwNaN); -+ } -+ if( p0->Type() == GDL_COMPLEXDBL) { -+ return product_over_dim_cu_template< DComplexDblGDL> -+ ( static_cast(p0)->Dup(), sumDim-1, KwNaN); -+ } -+ if( p0->Type() == GDL_COMPLEX) { -+ return product_over_dim_cu_template< DComplexDblGDL> -+ ( static_cast -+ (p0->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY)), sumDim-1, KwNaN); -+ } -+ -+ return product_over_dim_cu_template< DDoubleGDL> -+ ( static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)), sumDim-1, KwNaN); -+ } -+ } -+ -+ BaseGDL* array_equal( EnvT* e) -+ { -+ e->NParam( 2);//, "ARRAY_EQUAL"); -+ -+ BaseGDL* p0 = e->GetParDefined( 0);//, "ARRAY_EQUAL"); -+ BaseGDL* p1 = e->GetParDefined( 1);//, "ARRAY_EQUAL"); -+ -+ if( p0 == p1) return new DByteGDL( 1); -+ -+ SizeT nEl0 = p0->N_Elements(); -+ SizeT nEl1 = p1->N_Elements(); -+ if( nEl0 != nEl1 && nEl0 != 1 && nEl1 != 1) -+ return new DByteGDL( 0); -+ -+ Guard p0_guard; -+ Guard p1_guard; -+ if( p0->Type() != p1->Type()) -+ { -+ if( e->KeywordSet( 0)) // NO_TYPECONV -+ return new DByteGDL( 0); -+ else -+ { -+ DType aTy=p0->Type(); -+ DType bTy=p1->Type(); -+ if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ { -+ p1 = p1->Convert2( aTy, BaseGDL::COPY); -+ p1_guard.Reset( p1); -+ } -+ else -+ { -+ p0 = p0->Convert2( bTy, BaseGDL::COPY); -+ p0_guard.Reset( p0); -+ } -+ } -+ } -+ -+ if( p0->ArrayEqual( p1)) return new DByteGDL( 1); -+ -+ return new DByteGDL( 0); -+ } -+ -+ BaseGDL* min_fun( EnvT* e) -+ { -+ SizeT nParam = e->NParam( 1); -+ BaseGDL* searchArr = e->GetParDefined( 0); -+ -+ bool omitNaN = e->KeywordSet( "NAN"); -+ -+ static int subIx = e->KeywordIx("SUBSCRIPT_MAX"); -+ bool subMax = e->KeywordPresent(subIx); -+ -+ static int dimIx = e->KeywordIx("DIMENSION"); -+ bool dimSet = e->KeywordSet(dimIx); -+ -+ static int maxIx = e->KeywordIx("MAX"); -+ bool maxSet = e->KeywordPresent(maxIx); -+ -+ DLong searchDim; -+ if (dimSet) { -+ e->AssureLongScalarKW(dimIx, searchDim); -+ if (searchDim < 0 || searchDim > searchArr->Rank()) -+ e->Throw("Illegal keyword value for DIMENSION"); -+ } -+ -+ if (dimSet && searchArr->Rank() > 1) -+ { -+ searchDim -= 1; // user-supplied dimensions start with 1! -+ -+ // here destDim is in fact the srcDim... -+ dimension destDim = searchArr->Dim(); -+ SizeT searchStride = destDim.Stride(searchDim); -+ SizeT outerStride = destDim.Stride(searchDim + 1); -+ // ... and now becomes the destDim -+ SizeT nSearch = destDim.Remove(searchDim); -+ SizeT searchLimit = nSearch * searchStride; -+ SizeT nEl = searchArr->N_Elements(); -+ -+ // memory allocation -+ BaseGDL *maxVal, *resArr = searchArr->New(destDim, BaseGDL::NOZERO); -+ DLongGDL *minElArr, *maxElArr; -+ -+ if (maxSet) -+ { -+ e->AssureGlobalKW(maxIx); // instead of using a guard pointer -+ maxVal = searchArr->New(destDim, BaseGDL::NOZERO); -+ } -+ -+ if (subMax) -+ { -+ e->AssureGlobalKW(subIx); // instead of using a guard pointer -+ maxElArr = new DLongGDL(destDim); -+ } -+ -+ if (nParam == 2) -+ { -+ e->AssureGlobalPar(1); // instead of using a guard pointer -+ minElArr = new DLongGDL(destDim); -+ } -+ -+ SizeT rIx = 0; -+ for (SizeT o = 0; o < nEl; o += outerStride) for (SizeT i = 0; i < searchStride; ++i) -+ { -+ searchArr->MinMax( -+ (nParam == 2 ? &((*minElArr)[rIx]) : NULL), -+ (subMax ? &((*maxElArr)[rIx]) : NULL), -+ &resArr, -+ (maxSet ? &maxVal : NULL), -+ omitNaN, o + i, searchLimit + o + i, searchStride, rIx -+ ); -+ rIx++; -+ } -+ -+ if (nParam == 2) e->SetPar(1, minElArr); -+ if (subMax) e->SetKW(subIx, maxElArr); -+ if (maxSet) e->SetKW(maxIx, maxVal); -+ -+ return resArr; -+ } -+ else -+ { -+ DLong minEl; -+ BaseGDL* res; -+ -+ if (maxSet) // MAX keyword given -+ { -+ e->AssureGlobalKW( 0); -+ GDLDelete(e->GetKW( 0)); -+ DLong maxEl; -+ searchArr->MinMax( &minEl, &maxEl, &res, &e->GetKW( 0), omitNaN); -+ if (subMax) e->SetKW(subIx, new DLongGDL(maxEl)); -+ } -+ else // no MAX keyword -+ { -+ if (subMax) -+ { -+ DLong maxEl; -+ searchArr->MinMax( &minEl, &maxEl, &res, NULL, omitNaN); -+ e->SetKW(subIx, new DLongGDL(maxEl)); -+ } -+ else searchArr->MinMax(&minEl, NULL, &res, NULL, omitNaN); -+ } -+ -+ // handle index -+ if (nParam == 2) e->SetPar(1, new DLongGDL( minEl)); -+ else SysVar::SetC( minEl); -+ return res; -+ } -+ } -+ -+ BaseGDL* max_fun( EnvT* e) -+ { -+ SizeT nParam = e->NParam( 1); -+ BaseGDL* searchArr = e->GetParDefined( 0); -+ -+ bool omitNaN = e->KeywordSet( "NAN"); -+ -+ static int subIx = e->KeywordIx("SUBSCRIPT_MIN"); -+ bool subMin = e->KeywordPresent(subIx); -+ -+ static int dimIx = e->KeywordIx("DIMENSION"); -+ bool dimSet = e->KeywordSet(dimIx); -+ -+ static int minIx = e->KeywordIx("MIN"); -+ bool minSet = e->KeywordPresent(minIx); -+ -+ DLong searchDim; -+ if (dimSet) -+ { -+ e->AssureLongScalarKW(dimIx, searchDim); -+ if (searchDim < 0 || searchDim > searchArr->Rank()) -+ e->Throw("Illegal keyword value for DIMENSION"); -+ } -+ -+ if (dimSet && searchArr->Rank() > 1) -+ { -+ searchDim -= 1; // user-supplied dimensions start with 1! -+ -+ // here destDim is in fact the srcDim... -+ dimension destDim = searchArr->Dim(); -+ SizeT searchStride = destDim.Stride(searchDim); -+ SizeT outerStride = destDim.Stride(searchDim + 1); -+ // ... and now becomes the destDim -+ SizeT nSearch = destDim.Remove(searchDim); -+ SizeT searchLimit = nSearch * searchStride; -+ SizeT nEl = searchArr->N_Elements(); -+ -+ // memory allocation -+ BaseGDL *minVal, *resArr = searchArr->New(destDim, BaseGDL::NOZERO); -+ DLongGDL *minElArr, *maxElArr; -+ -+ if (minSet) -+ { -+ e->AssureGlobalKW(minIx); // instead of using a guard pointer -+ minVal = searchArr->New(destDim, BaseGDL::NOZERO); -+ } -+ -+ if (subMin) -+ { -+ e->AssureGlobalKW(subIx); // instead of using a guard pointer -+ minElArr = new DLongGDL(destDim); -+ } -+ -+ if (nParam == 2) -+ { -+ e->AssureGlobalPar(1); // instead of using a guard pointer -+ maxElArr = new DLongGDL(destDim); -+ } -+ -+ SizeT rIx = 0; -+ for (SizeT o = 0; o < nEl; o += outerStride) for (SizeT i = 0; i < searchStride; ++i) -+ { -+ searchArr->MinMax( -+ (subMin ? &((*minElArr)[rIx]) : NULL), -+ (nParam == 2 ? &((*maxElArr)[rIx]) : NULL), -+ (minSet ? &minVal : NULL), -+ &resArr, -+ omitNaN, o + i, searchLimit + o + i, searchStride, rIx -+ ); -+ rIx++; -+ } -+ -+ if (nParam == 2) e->SetPar(1, maxElArr); -+ if (subMin) e->SetKW(subIx, minElArr); -+ if (minSet) e->SetKW(minIx, minVal); -+ -+ return resArr; -+ } -+ else -+ { -+ DLong maxEl; -+ BaseGDL* res; -+ -+ if (minSet) // MIN keyword given -+ { -+ e->AssureGlobalKW( 0); -+ GDLDelete(e->GetKW( 0)); -+ DLong minEl; -+ searchArr->MinMax( &minEl, &maxEl, &e->GetKW( 0), &res, omitNaN); -+ if (subMin) e->SetKW(subIx, new DLongGDL(minEl)); -+ } -+ else // no MIN keyword -+ { -+ if (subMin) -+ { -+ DLong minEl; -+ searchArr->MinMax( &minEl, &maxEl, NULL, &res, omitNaN); -+ e->SetKW(subIx, new DLongGDL(minEl)); -+ } -+ else searchArr->MinMax(NULL, &maxEl, NULL, &res, omitNaN); -+ } -+ -+ // handle index -+ if (nParam == 2) e->SetPar(1, new DLongGDL( maxEl)); -+ else SysVar::SetC(maxEl); -+ return res; -+ } -+ } -+ -+BaseGDL* transpose( EnvT* e) -+ { -+ SizeT nParam=e->NParam( 1); -+ -+ BaseGDL* p0 = e->GetParDefined( 0); -+ if( p0->Type() == GDL_STRUCT) -+ e->Throw("Struct expression not allowed in this context: "+ -+ e->GetParString(0)); -+ -+ SizeT rank = p0->Rank(); -+ if( rank == 0) -+ e->Throw( "Expression must be an array " -+ "in this context: "+ e->GetParString(0)); -+ -+ if( nParam == 2) -+ { -+ -+ BaseGDL* p1 = e->GetParDefined( 1); -+ if( p1->N_Elements() != rank) -+ e->Throw("Incorrect number of elements in permutation."); -+ -+ DUInt* perm = new DUInt[rank]; -+ ArrayGuard perm_guard( perm); -+ -+ DUIntGDL* p1L = static_cast -+ (p1->Convert2( GDL_UINT, BaseGDL::COPY)); -+ for( SizeT i=0; iThrow( "Incorrect permutation vector."); -+ } -+ return p0->Transpose( perm); -+ } -+ -+ return p0->Transpose( NULL); -+ } -+ -+ -+// BaseGDL* matrix_multiply( EnvT* e) -+// { -+// SizeT nParam=e->NParam( 2); -+// -+// BaseGDL* a = e->GetNumericArrayParDefined( 0); -+// BaseGDL* b = e->GetNumericArrayParDefined( 1); -+// -+// static int aTIx = e->KeywordIx("ATRANSPOSE"); -+// bool aT = e->KeywordPresent(aTIx); -+// static int bTIx = e->KeywordIx("BTRANSPOSE"); -+// bool bT = e->KeywordPresent(bTIx); -+// -+// static int strassenIx = e->KeywordIx("STRASSEN_ALGORITHM"); -+// bool strassen = e->KeywordPresent(strassenIx); -+// -+// -+// if( p1->N_Elements() != rank) -+// e->Throw("Incorrect number of elements in permutation."); -+// -+// DUInt* perm = new DUInt[rank]; -+// Guard perm_guard( perm); -+// -+// DUIntGDL* p1L = static_cast -+// (p1->Convert2( GDL_UINT, BaseGDL::COPY)); -+// for( SizeT i=0; iThrow( "Incorrect permutation vector."); -+// } -+// return p0->Transpose( perm); -+// } -+// -+// return a->Transpose( NULL); -+// } -+ -+ // helper function for sort_fun, recursive -+ // optimized version -+ template< typename IndexT> -+ void MergeSortOpt( BaseGDL* p0, IndexT* hhS, IndexT* h1, IndexT* h2, -+ SizeT len) -+ { -+ if( len <= 1) return; -+ -+ SizeT h1N = len / 2; -+ SizeT h2N = len - h1N; -+ -+ // 1st half -+ MergeSortOpt(p0, hhS, h1, h2, h1N); -+ -+ // 2nd half -+ IndexT* hhM = &hhS[h1N]; -+ MergeSortOpt(p0, hhM, h1, h2, h2N); -+ -+ SizeT i; -+ for(i=0; iGreater( h1[h1Ix], h2[h2Ix])) -+ hhS[ i] = h2[ h2Ix++]; -+ else -+ hhS[ i] = h1[ h1Ix++]; -+ } -+ for(; h1Ix < h1N; ++i) hhS[ i] = h1[ h1Ix++]; -+ for(; h2Ix < h2N; ++i) hhS[ i] = h2[ h2Ix++]; -+ } -+ -+ // helper function for sort_fun, recursive -+ void MergeSort( BaseGDL* p0, SizeT* hh, SizeT* h1, SizeT* h2, -+ SizeT start, SizeT end) -+ { -+ if( start+1 >= end) return; -+ -+ SizeT middle = (start+end) / 2; -+ -+ MergeSort(p0, hh, h1, h2, start, middle); -+ MergeSort(p0, hh, h1, h2, middle, end); -+ -+ SizeT h1N = middle - start; -+ SizeT h2N = end - middle; -+ -+ SizeT* hhS = &hh[start]; -+ -+ SizeT i; -+ for(i=0; iGreater( h1[h1Ix], h2[h2Ix])) -+ hhS[ i] = h2[ h2Ix++]; -+ else -+ hhS[ i] = h1[ h1Ix++]; -+ } -+ for(; h1Ix < h1N; ++i) hhS[ i] = h1[ h1Ix++]; -+ for(; h2Ix < h2N; ++i) hhS[ i] = h2[ h2Ix++]; -+ } -+ -+ // sort function uses MergeSort -+ BaseGDL* sort_fun( EnvT* e) -+ { -+ e->NParam( 1); -+ -+ BaseGDL* p0 = e->GetParDefined( 0); -+ -+ if( p0->Type() == GDL_STRUCT) -+ e->Throw( "Struct expression not allowed in this context: "+ -+ e->GetParString(0)); -+ -+ static int l64Ix = e->KeywordIx( "L64"); -+ bool l64 = e->KeywordSet( l64Ix); -+ -+ SizeT nEl = p0->N_Elements(); -+ -+ // helper arrays -+ DLongGDL* res = new DLongGDL( dimension( nEl), BaseGDL::INDGEN); -+ -+ DLong nanIx = nEl; -+ if( p0->Type() == GDL_FLOAT) -+ { -+ DFloatGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) -+ { -+ if( isnan((*p0F)[ i]) )//|| !isfinite((*p0F)[ i])) -+ { -+ --nanIx; -+ (*res)[i] = (*res)[nanIx]; -+ (*res)[ nanIx] = i; -+ -+// cout << "swap " << i << " with " << nanIx << endl; -+// cout << "now: "; -+// for( DLong ii=0; ii < nEl; ++ii) -+// { -+// cout << (*res)[ii] << " "; -+// } -+// cout << endl; -+ } -+ } -+ } -+ else if( p0->Type() == GDL_DOUBLE) -+ { -+ DDoubleGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) -+ { -+ if( isnan((*p0F)[ i]))// || !isfinite((*p0F)[ i])) -+ { -+ --nanIx; -+ (*res)[i] = (*res)[nanIx]; -+ (*res)[ nanIx] = i; -+ } -+ } -+ } -+ else if( p0->Type() == GDL_COMPLEX) -+ { -+ DComplexGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) -+ { -+ if( isnan((*p0F)[ i].real()) || //!isfinite((*p0F)[ i].real()) || -+ isnan((*p0F)[ i].imag()))// || !isfinite((*p0F)[ i].imag()) ) -+ { -+ --nanIx; -+ (*res)[i] = (*res)[nanIx]; -+ (*res)[ nanIx] = i; -+ } -+ } -+ } -+ else if( p0->Type() == GDL_COMPLEXDBL) -+ { -+ DComplexDblGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) -+ { -+ if( isnan((*p0F)[ i].real()) || //!isfinite((*p0F)[ i].real()) || -+ isnan((*p0F)[ i].imag()))// || !isfinite((*p0F)[ i].imag()) ) -+ { -+ --nanIx; -+ (*res)[i] = (*res)[nanIx]; -+ (*res)[ nanIx] = i; -+ } -+ } -+ } -+ -+// cout << "nEl " << nEl << " nanIx " << nanIx << endl; -+ nEl = nanIx; -+// cout << "sorting: "; -+// for( DLong ii=0; ii < nEl; ++ii) -+// { -+// cout << (*res)[ii] << " "; -+// } -+// cout << endl; -+ -+ DLong *hh = static_cast(res->DataAddr()); -+ -+ DLong* h1 = new DLong[ nEl/2]; -+ DLong* h2 = new DLong[ (nEl+1)/2]; -+ // call the sort routine -+ MergeSortOpt( p0, hh, h1, h2, nEl); -+ delete[] h1; -+ delete[] h2; -+ -+ if( l64) -+ { -+ // leave it this way, as sorting of more than 2^31 -+ // items seems not feasible in the future we might -+ // use MergeSortOpt(...) for this -+ return res->Convert2( GDL_LONG64); -+ } -+ -+ return res; -+ } -+ -+ // uses MergeSort -+ // 2 parts in the code: without "width" or with "width" (limited to 1D and 2D) -+ BaseGDL* median( EnvT* e) { -+ -+ BaseGDL* p0 = e->GetParDefined( 0); -+ -+ if( p0->Type() == GDL_PTR) -+ e->Throw( "Pointer expression not allowed in this context: "+ e->GetParString(0)); -+ if( p0->Type() == GDL_OBJ) -+ e->Throw( "Object expression not allowed in this context: "+ e->GetParString(0)); -+ if( p0->Type() == GDL_STRUCT) -+ e->Throw( "Struct expression not allowed in this context: "+ e->GetParString(0)); -+ -+ if( p0->Rank() == 0) -+ e->Throw( "Expression must be an array in this context: "+ e->GetParString(0)); -+ -+ SizeT nParam = e->NParam( 1); -+ SizeT nEl = p0->N_Elements(); -+ -+ // "f_nan" and "d_nan" used by both parts ... -+ static DStructGDL *Values = SysVar::Values(); -+ DFloat f_nan=(*static_cast(Values->GetTag(Values->Desc()->TagIndex("F_NAN"), 0)))[0]; -+ DDouble d_nan=(*static_cast(Values->GetTag(Values->Desc()->TagIndex("D_NAN"), 0)))[0]; -+ -+ // -------------------------------------------------------- -+ // begin of the part 1: without "width" param -+ if( nParam == 1) { -+ -+ static int evenIx = e->KeywordIx( "EVEN"); -+ -+ // TYPE -+ bool dbl = -+ p0->Type() == GDL_DOUBLE || -+ p0->Type() == GDL_COMPLEXDBL || -+ e->KeywordSet(e->KeywordIx("DOUBLE")); -+ DType type = dbl ? GDL_DOUBLE : GDL_FLOAT; -+ bool noconv = (dbl && p0->Type() == GDL_DOUBLE) || -+ (!dbl && p0->Type() == GDL_FLOAT); -+ -+ // DIMENSION keyword -+ DLong dim = 0; -+ DLong nmed = 1; -+ BaseGDL *res; -+ e->AssureLongScalarKWIfPresent( "DIMENSION", dim); -+ -+ // cout << "dim : "<< dim << endl; -+ -+ if (dim > p0->Rank()) -+ e->Throw( "Illegal keyword value for DIMENSION."); -+ -+ if (dim > 0) { -+ DLong dims[8]; -+ DLong k = 0; -+ for (SizeT i=0; iRank(); ++i) -+ if (i != (dim-1)) { -+ nmed *= p0->Dim(i); -+ dims[k++] = p0->Dim(i); -+ } -+ dimension dimRes((DLong *) dims, p0->Rank()-1); -+ res = dbl -+ ? static_cast(new DDoubleGDL(dimRes, BaseGDL::NOZERO)) -+ : static_cast(new DFloatGDL(dimRes, BaseGDL::NOZERO)); -+ } else { -+ res = dbl -+ ? static_cast(new DDoubleGDL(1)) -+ : static_cast(new DFloatGDL(1)); -+ } -+ -+ // conversion of Complex types -+ if (p0->Type() == GDL_COMPLEX) p0 = p0->Convert2(GDL_FLOAT, BaseGDL::COPY); -+ if (p0->Type() == GDL_COMPLEXDBL) p0 = p0->Convert2(GDL_DOUBLE, BaseGDL::COPY); -+ -+ // helper arrays -+ if (nmed > 1) nEl = p0->N_Elements() / nmed; -+ -+ // cout << "hello2" << endl; -+ -+ DLong *hh = new DLong[ nEl]; -+ DLong* h1 = new DLong[ nEl/2]; -+ DLong* h2 = new DLong[ (nEl+1)/2]; -+ -+ DLong accumStride = 1; -+ if (nmed > 1) -+ for( DLong i=0; iDim(i); -+ -+ BaseGDL *op1, *op2, *op3; -+ if (dbl) op3 = new DDoubleGDL(2); -+ else op3 = new DFloatGDL(2); -+ -+ // nEl_extern is used to store "nEl" initial value -+ DLong nanIx, nEl_extern; -+ nEl_extern=nEl; -+ // if (nmed > 1) nEl_extern = p0->N_Elements() / nmed; -+ //else nEl_extern = p0->N_Elements(); -+ -+ // cout << "hello type" << p0->Type() << endl; -+ -+ // Loop over all subarray medians -+ for (SizeT k=0; kType() == GDL_DOUBLE) { -+ DDoubleGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) { -+ if( isnan((*p0F)[i])) { -+ --nanIx; -+ hh[i] = hh[nanIx]; -+ hh[ nanIx] = i; -+ } -+ } -+ } -+ -+ if (p0->Type() == GDL_FLOAT) { -+ DFloatGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) { -+ if( isnan((*p0F)[i])) { -+ --nanIx; -+ hh[i] = hh[nanIx]; -+ hh[ nanIx] = i; -+ } -+ } -+ } -+ -+ //cout << "nEl " << nEl << " nanIx " << nanIx << endl; -+ nEl = nanIx; -+ } -+ else -+ { -+ nanIx = nEl; -+ nEl=nEl_extern; -+ -+ // DLong nanIx = nEl; -+ // Starting Element -+ DLong start = accumStride * p0->Dim(dim-1) * (k / accumStride) + -+ (k % accumStride); -+ for( DLong i=0; iType() == GDL_FLOAT) { -+ DFloatGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) { -+ jj=start + i * accumStride; -+ if( isnan((*p0F)[ jj]) ) { -+ --nanIx; -+ hh[i] = hh[nanIx]; -+ hh[ nanIx] = i; -+ } -+ } -+ nEl = nanIx; -+ } -+ -+ if (p0->Type() == GDL_DOUBLE) { -+ DDoubleGDL* p0F = static_cast(p0); -+ for( DLong i=nEl-1; i >= 0; --i) { -+ jj=start + i * accumStride; -+ if( isnan((*p0F)[ jj]) ) { -+ --nanIx; -+ hh[i] = hh[nanIx]; -+ hh[ nanIx] = i; -+ } -+ } -+ //cout << "nanIx :" << nanIx << "nEl :" << nEl << endl; -+ nEl = nanIx; -+ } -+ } -+ DLong medEl, medEl_1; -+ -+ // call the sort routine -+ if (nEl > 1) { -+ MergeSortOpt( p0, hh, h1, h2, nEl); -+ medEl = hh[ nEl/2]; -+ medEl_1 = hh[ nEl/2 - 1]; -+ } else { -+ if (nEl == 1) { -+ medEl = hh[0]; -+ medEl_1 = hh[0]; -+ } else -+ { // normal case, more than one element, nothing to do -+ //cout << "gasp : no result ! " << endl; -+ } -+ } -+ -+ if (nEl <= 0) { // we have a NaN -+ if (dbl) (*static_cast(res))[k] = d_nan; -+ else (*static_cast(res))[k] = f_nan; -+ } else { -+ //cout << k << "" << (*static_cast(p0))[medEl] << " " -+ // << (*static_cast(p0))[medEl_1] << endl; -+ //cout << "k :" << k << endl; -+ if( (nEl % 2) == 1 || !e->KeywordSet( evenIx)) { -+ if (nmed == 1) -+ res = p0->NewIx(medEl)->Convert2(type, BaseGDL::CONVERT); -+ else { -+ if (noconv) -+ { -+ if (dbl) (*static_cast(res))[k] = (*static_cast(p0))[medEl]; -+ else (*static_cast(res))[k] = (*static_cast(p0))[medEl]; -+ } -+ else -+ { -+ op1 = p0->NewIx(medEl)->Convert2(type, BaseGDL::CONVERT); -+ if (dbl) (*static_cast(res))[k] = (*static_cast(op1))[0]; -+ else (*static_cast(res))[k] = (*static_cast(op1))[0]; -+ delete(op1); -+ } -+ } -+ } else { -+ if (noconv) -+ { -+ if (dbl) (*static_cast(res))[k] = .5 * ( -+ (*static_cast(p0))[medEl] + -+ (*static_cast(p0))[medEl_1] -+ ); -+ else (*static_cast(res))[k] = .5 * ( -+ (*static_cast(p0))[medEl] + -+ (*static_cast(p0))[medEl_1] -+ ); -+ } -+ else -+ { -+ op1 = p0->NewIx(medEl)->Convert2(type, BaseGDL::CONVERT); -+ op2 = p0->NewIx(medEl_1)->Convert2(type, BaseGDL::CONVERT); -+ if (nmed == 1) res = op2->Add(op1)->Div(op3); // TODO: leak with res? -+ else -+ { -+ if (dbl) (*static_cast(res))[k] = -+ (*static_cast((op2->Add(op1)->Div(op3))))[0]; -+ else (*static_cast(res))[k] = -+ (*static_cast((op2->Add(op1)->Div(op3))))[0]; -+ delete(op2); -+ } -+ delete(op1); -+ } -+ } -+ } -+ } -+ delete(op3); -+ delete[] h1; -+ delete[] h2; -+ delete[] hh; -+ -+ return res; -+ } -+ -+ // begin of the part 2: with "width" param -+ if( nParam == 2) { -+ // with parameter Width : median filtering with no optimisation, -+ // such as histogram algorithms. -+ // Copyright: (C) 2008 by Nicolas Galmiche -+ -+ // basic checks on "vector/array" input -+ DDoubleGDL* p0 = e->GetParAs( 0); -+ -+ if( p0->Rank() > 2) -+ e->Throw( "Only 1 or 2 dimensions allowed: "+ e->GetParString(0)); -+ -+ // basic checks on "width" input -+ DDoubleGDL* p1d = e->GetParAs(1); -+ -+ if (p1d->N_Elements() > 1 || (*p1d)[0] <=0 ) -+ e->Throw( "Width must be a positive scalar or 1 (positive) element array in this context: "+ e->GetParString(0)); -+ DLong MaxAllowedWidth=0; -+ if (p0->Rank() == 1) MaxAllowedWidth=p0->N_Elements(); -+ if (p0->Rank() == 2) { -+ MaxAllowedWidth=p0->Dim(0); -+ if (p0->Dim(1) < MaxAllowedWidth) MaxAllowedWidth=p0->Dim(1); -+ } -+ const int debug =0; -+ if (debug == 1) { -+ cout << "X dim " << p0->Dim(0) <Dim(1) <Throw("Width must be > 1, and < dimension of array (NaN or Inf)"); -+ -+ DLongGDL* p1 = e->GetParAs(1); -+ -+ DDoubleGDL *tamp = new DDoubleGDL(p0->Dim(),BaseGDL::NOZERO); -+ DDouble min=((*p0)[0]); -+ DDouble max=min; -+ -+ for (SizeT ii=0 ; iiN_Elements() ; ++ii) -+ {(*tamp)[ii]=(*p0)[ii]; -+ if ( (*p0)[ii] < min ) min = ((*p0)[ii]); -+ if ( (*p0)[ii] > max ) max = ((*p0)[ii]); -+ } -+ -+ //---------------------------- END d'acquisistion des paramÃ?tres ------------------------------------- -+ -+ -+ static int evenIx = e->KeywordIx( "EVEN"); -+ static int doubleIx = e->KeywordIx( "DOUBLE"); -+ static DStructGDL *Values = SysVar::Values(); -+ DDouble d_nan=(*static_cast(Values->GetTag(Values->Desc()->TagIndex("D_NAN"), 0)))[0]; -+ DDouble d_infinity= (*static_cast(Values->GetTag(Values->Desc()->TagIndex("D_INFINITY"), 0)))[0]; -+ -+ //------------------------------ Init variables and allocation --------------------------------------- -+ SizeT width=(*p1)[0]; -+ SizeT N_MaskElem= width*width; -+ SizeT larg = p0->Stride(1); -+ SizeT haut = p0->Stride(2)/larg; -+ SizeT lim= static_cast(round(width/2)); -+ SizeT init=(lim*larg+lim); -+ -+ // we don't go further if dimension(s) versus not width OK -+ -+ if (debug == 1) {cout << "ici" <Rank() == 1) { -+ if (larg < width || width==1 ) e->Throw( "Width must be > 1, and < width of vector"); -+ } -+ if ( p0->Rank() == 2) { -+ if (larg < width || haut < width || width==1) e->Throw("Width must be > 1, and < dimension of array"); -+ } -+ -+ // for 2D arrays, we use the algorithm described in paper -+ // from T. Huang, G. Yang, and G. Tang, “A Fast Two-Dimensional Median -+ // Filtering Algorithm,†IEEE Trans. Acoust., Speech, Signal Processing, -+ // vol. 27, no. 1, pp. 13–18, 1979. -+ -+ if ( (e->GetParDefined( 0)->Type() == GDL_BYTE || -+ e->GetParDefined( 0)->Type() == GDL_INT || -+ e->GetParDefined( 0)->Type() == GDL_UINT || -+ e->GetParDefined( 0)->Type() == GDL_LONG || -+ e->GetParDefined( 0)->Type() == GDL_ULONG || -+ e->GetParDefined( 0)->Type() == GDL_LONG64 || -+ e->GetParDefined( 0)->Type() == GDL_ULONG64) && -+ (haut>1)) -+ { -+ SizeT taille=static_cast(abs(max)-min+1); -+ DDoubleGDL* Histo = new DDoubleGDL(taille,BaseGDL::NOZERO); -+ if (width % 2 ==0) -+ { -+ for(SizeT i=0 ; i((*p0)[ii+yy*larg]-min)]++; -+ } -+ -+ while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -+ { -+ ltmed+= static_cast((*Histo)[med]); -+ ++med; -+ } -+ if (e->KeywordSet( evenIx)) -+ { -+ -+ SizeT EvenMed=med; -+ //if ((*Histo)[EvenMed]==1 || (ltmed!=0 && ltmed !=(N_MaskElem /2) -1)) -+ if ((*Histo)[EvenMed]==1 || (ltmed!=0 && N_MaskElem /2- ltmed!=1) ) -+ { -+ while ((*Histo)[EvenMed-1]==0) -+ { EvenMed--;} -+ (*tamp)[init+i*larg]=((med+min)+(EvenMed-1+min))/2; -+ } -+ else -+ (*tamp)[init+i*larg]=med+min; -+ } -+ else -+ {(*tamp)[init+i*larg]=med+min; } -+ -+ for(SizeT j=init+i*larg +1; j((*p0)[initMask-1+k*larg]-min)]--; -+ if ((*p0)[initMask-1+k*larg]-min((*p0)[initMask+k*larg+2*lim-1]-min)]++; -+ if ((*p0)[initMask+k*larg+2*lim-1]-minN_MaskElem /2) -+ { -+ while(ltmed>N_MaskElem /2) -+ { -+ --med; -+ ltmed-=static_cast((*Histo)[med]); -+ } -+ } -+ else -+ { -+ while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -+ { -+ ltmed+= static_cast((*Histo)[med]); -+ ++med; -+ } -+ } -+ -+ if (e->KeywordSet( evenIx)) -+ { -+ SizeT EvenMed=med; -+ if ((*Histo)[EvenMed]==1 || (ltmed!=0 &&N_MaskElem /2- ltmed!=1 )) -+ { -+ while ((*Histo)[EvenMed-1]==0) -+ { EvenMed--;} -+ (*tamp)[j]=((med+min)+(EvenMed-1+min))/2; -+ } -+ else -+ {(*tamp)[j]=med+min; } -+ } -+ else -+ {(*tamp)[j]=med+min; } -+ } -+ } -+ } -+ else -+ { -+ for(SizeT i=0 ; i((*p0)[ii+yy*larg]-min)]++; -+ } -+ -+ while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -+ { -+ ltmed+= static_cast((*Histo)[med]); -+ ++med; -+ } -+ (*tamp)[init+i*larg]=med+min; -+ -+ for(SizeT j=init+i*larg +1; j((*p0)[initMask-1+k*larg]-min)]--; -+ if ((*p0)[initMask-1+k*larg]-min((*p0)[initMask+k*larg+2*lim]-min)]++; -+ if ((*p0)[initMask+k*larg+2*lim]-minN_MaskElem /2) -+ { -+ while(ltmed>N_MaskElem /2) -+ { -+ --med; -+ ltmed-=static_cast((*Histo)[med]); -+ } -+ } -+ else -+ { -+ while (ltmed+(*Histo)[med]<=(N_MaskElem /2)) -+ { -+ ltmed+= static_cast((*Histo)[med]); -+ ++med; -+ } -+ } -+ -+ (*tamp)[j]=med+min; -+ -+ } -+ } -+ } -+ -+ } -+ else -+ { -+ DLong* hh; -+ DLong* h1; -+ DLong* h2; -+ DDoubleGDL* Mask,*Mask1D; -+ if ( p0->Rank() != 1 ) -+ { -+ hh = new DLong[ N_MaskElem]; -+ h1 = new DLong[ N_MaskElem/2]; -+ h2= new DLong[ (N_MaskElem+1)/2]; -+ Mask = new DDoubleGDL(N_MaskElem,BaseGDL::NOZERO); -+ -+ for( DLong i=0; iRank() == 1 )//------------------------ For a vector with even width ------------------- -+ { -+ for (SizeT col= lim ; col(Mask1Dbis); -+ MergeSortOpt( besort, hhbis, h1bis, h2bis,(width - ctl_NaN)); -+ if (e->KeywordSet( evenIx)&& (width - ctl_NaN) % 2 == 0) -+ (*tamp)[col]=((*Mask1Dbis)[hhbis[ (width-ctl_NaN)/2]]+(*Mask1Dbis -+ )[hhbis [ (width - ctl_NaN-1)/2]])/2; -+ else -+ (*tamp)[col]=(*Mask1Dbis)[hhbis[ (width- ctl_NaN)/2]]; -+ delete[]hhbis; -+ delete[]h2bis; -+ delete[]h1bis; -+ } -+ } -+ else -+ { -+ BaseGDL* besort=static_cast(Mask1D); -+ MergeSortOpt( besort, hh, h1, h2,width ); // call the sort routine -+ -+ if (e->KeywordSet( evenIx)) -+ -+ (*tamp)[col]=((*Mask1D)[hh[ width/2]]+(*Mask1D)[hh[ (width-1)/2]])/2; -+ else -+ (*tamp)[col]=(*Mask1D)[hh[ width/2]];// replace value by Mask median -+ } -+ } -+ -+ } -+ else//------------------------ For an array with even width ------------------- -+ { -+ SizeT jj; -+ for(SizeT i=0 ; i(Maskb); -+ MergeSortOpt( besort, hhb, h1b, h2b,(N_MaskElem - ctl_NaN)); -+ if ((N_MaskElem - ctl_NaN) % 2 == 0 && e->KeywordSet( evenIx)) -+ (*tamp)[j]=((*Maskb)[hhb[ (N_MaskElem-ctl_NaN)/2]]+(*Maskb)[hhb -+ [ (N_MaskElem - -+ ctl_NaN-1)/2]])/2; -+ else -+ (*tamp)[j]=(*Maskb)[hhb[ (N_MaskElem- ctl_NaN)/2]]; -+ delete[]hhb; -+ delete[]h2b; -+ delete[]h1b; -+ } -+ } -+ else -+ { -+ BaseGDL* besort=static_cast(Mask); -+ MergeSortOpt( besort, hh, h1, h2, N_MaskElem); // call the sort routine -+ if (e->KeywordSet( evenIx)) -+ (*tamp)[j]=((*Mask)[hh[ N_MaskElem/2]]+(*Mask)[hh[ (N_MaskElem-1)/2]])/2; -+ else -+ (*tamp)[j]=(*Mask)[hh[ N_MaskElem/2]];// replace value by median Mask one -+ } -+ } -+ } -+ } -+ } -+ -+ else -+ { -+ if ( p0->Rank() == 1 )//------------------------ For a vector with odd width ------------------- -+ -+ { -+ for (SizeT col= lim ; col(Mask1Dbis); -+ MergeSortOpt( besort, hhbis, h1bis, h2bis,(width - ctl_NaN)); -+ if (e->KeywordSet( evenIx)&& (width - ctl_NaN) % 2 == 0) -+ (*tamp)[col]=((*Mask1Dbis)[hhbis[ (width-ctl_NaN)/2]]+(*Mask1Dbis -+ )[hhbis [ (width - ctl_NaN-1)/2]])/2; -+ else(*tamp)[col]=(*Mask1Dbis)[hhbis[ (width- ctl_NaN)/2]]; -+ delete[]hhbis; -+ delete[]h2bis; -+ delete[]h1bis; -+ } -+ } -+ else -+ { -+ BaseGDL* besort=static_cast(Mask1D); -+ MergeSortOpt( besort, hh, h1, h2,width ); // call the sort routine -+ (*tamp)[col]=(*Mask1D)[hh[ (width)/2]]; // replace value by Mask median -+ } -+ } -+ -+ } -+ -+ else //----------------------------- For an array with odd width --------------------------------- -+ { -+ SizeT jj; -+ for(SizeT i=0 ; i(Maskb); -+ MergeSortOpt( besort, hhb, h1b, h2b,(N_MaskElem - ctl_NaN)); -+ if ((N_MaskElem - ctl_NaN) % 2 == 0 && e->KeywordSet( evenIx)) -+ (*tamp)[j]=((*Maskb)[hhb[ (N_MaskElem-ctl_NaN)/2]]+(*Maskb)[hhb -+ [ (N_MaskElem - -+ ctl_NaN-1)/2]])/2; -+ else(*tamp)[j]=(*Maskb)[hhb[(N_MaskElem- ctl_NaN)/2]]; -+ delete[]hhb; -+ delete[]h2b; -+ delete[]h1b; -+ } -+ } -+ else -+ { -+ BaseGDL* besort=static_cast(Mask); -+ MergeSortOpt( besort, hh, h1, h2, N_MaskElem); // call the sort routine -+ (*tamp)[j]=(*Mask)[hh[ (N_MaskElem)/2]]; // replace value by Mask median -+ } -+ } -+ } -+ } -+ } -+ -+ //--------------------------- END OF MEDIAN FILTER ALOGORITHMS ----------------------------------- -+ -+ delete[] h1; -+ delete[] h2; -+ delete[] hh; -+ } -+ if ( e->GetParDefined( 0)->Type() == GDL_DOUBLE || p0->Type() == GDL_COMPLEXDBL ||e->KeywordSet( doubleIx) ) -+ return tamp; -+ else if (e->GetParDefined( 0)->Type() == GDL_BYTE) -+ return tamp->Convert2(GDL_BYTE,BaseGDL::CONVERT); -+ -+ return tamp->Convert2(GDL_FLOAT,BaseGDL::CONVERT); -+ -+ }// end if -+ -+ }// end of median -+ -+ BaseGDL* shift_fun( EnvT* e) -+ { -+ SizeT nParam = e->NParam( 2); -+ -+ BaseGDL* p0 = e->GetParDefined( 0); -+ -+ SizeT nShift = nParam - 1; -+ if( nShift == 1) -+ { -+ DLong s1; -+ e->AssureLongScalarPar( 1, s1); -+ -+ // IncRef[Obj] done for GDL_PTR and GDL_OBJ -+ return p0->CShift( s1); -+ } -+ -+ if( p0->Rank() != nShift) -+ e->Throw( "Incorrect number of arguments."); -+ -+ DLong sIx[ MAXRANK]; -+ for( SizeT i=0; i< nShift; i++) -+ e->AssureLongScalarPar( i+1, sIx[ i]); -+ -+ if( p0->Type() == GDL_OBJ) -+ GDLInterpreter::IncRefObj( static_cast(p0)); -+ else if( p0->Type() == GDL_PTR) -+ GDLInterpreter::IncRef( static_cast(p0)); -+ -+ return p0->CShift( sIx); -+ } -+ -+ BaseGDL* arg_present( EnvT* e) -+ { -+ e->NParam( 1); -+ -+ if( !e->GlobalPar( 0)) -+ return new DIntGDL( 0); -+ -+ EnvBaseT* caller = e->Caller(); -+ if( caller == NULL) -+ return new DIntGDL( 0); -+ -+ BaseGDL** pp0 = &e->GetPar( 0); -+ -+ int ix = caller->FindGlobalKW( pp0); -+ if( ix == -1) -+ return new DIntGDL( 0); -+ -+ return new DIntGDL( 1); -+ } -+ -+ BaseGDL* eof_fun( EnvT* e) -+ { -+ e->NParam( 1); -+ -+ DLong lun; -+ e->AssureLongScalarPar( 0, lun); -+ -+ bool stdLun = check_lun( e, lun); -+ if( stdLun) -+ return new DIntGDL( 0); -+ -+ // nicer error message (Disregard if socket) -+ if ( fileUnits[ lun-1].SockNum() == -1) { -+ if( !fileUnits[ lun-1].IsOpen()) -+ throw GDLIOException( e->CallingNode(), "File unit is not open: "+i2s( lun)+"."); -+ -+ if( fileUnits[ lun-1].Eof()) -+ return new DIntGDL( 1); -+ } else { -+ // Socket -+ string *recvBuf = &fileUnits[ lun-1].RecvBuf(); -+ if (recvBuf->size() == 0) -+ return new DIntGDL( 1); -+ } -+ return new DIntGDL( 0); -+ } -+ -+ /* -+ BaseGDL* convol( EnvT* e) -+ { -+ SizeT nParam=e->NParam( 2); -+ -+ BaseGDL* p0 = e->GetNumericParDefined( 0); -+ if( p0->Rank() == 0) -+ e->Throw( "Expression must be an array in this context: "+ -+ e->GetParString(0)); -+ -+ BaseGDL* p1 = e->GetNumericParDefined( 1); -+ if( p1->Rank() == 0) -+ e->Throw( "Expression must be an array in this context: "+ -+ e->GetParString(1)); -+ -+ if( p0->N_Elements() < p1->N_Elements()) -+ e->Throw( "Incompatible dimensions for Array and Kernel."); -+ -+ // rank 1 for kernel works always -+ if( p1->Rank() != 1) -+ { -+ SizeT rank = p0->Rank(); -+ if( rank != p1->Rank()) -+ e->Throw( "Incompatible dimensions for Array and Kernel."); -+ -+ for( SizeT r=0; rDim( r) < p1->Dim( r)) -+ e->Throw( "Incompatible dimensions for Array and Kernel."); -+ } -+ -+ // convert kernel to array type -+ Guard p1Guard; -+ if( p0->Type() == GDL_BYTE) -+ { -+ if( p1->Type() != GDL_INT) -+ { -+ p1 = p1->Convert2( GDL_INT, BaseGDL::COPY); -+ p1Guard.Reset( p1); -+ } -+ } -+ else if( p0->Type() != p1->Type()) -+ { -+ p1 = p1->Convert2( p0->Type(), BaseGDL::COPY); -+ p1Guard.Reset( p1); -+ } -+ -+ BaseGDL* scale; -+ Guard scaleGuard; -+ if( nParam > 2) -+ { -+ scale = e->GetParDefined( 2); -+ if( scale->Rank() > 0) -+ e->Throw( "Expression must be a scalar in this context: "+ -+ e->GetParString(2)); -+ -+ // p1 here handles GDL_BYTE case also -+ if( p1->Type() != scale->Type()) -+ { -+ scale = scale->Convert2( p1->Type(),BaseGDL::COPY); -+ scaleGuard.Reset( scale); -+ } -+ } -+ else -+ { -+ scale = p1->New( dimension(), BaseGDL::ZERO); -+ } -+ -+ bool center = true; -+ static int centerIx = e->KeywordIx( "CENTER"); -+ if( e->KeywordPresent( centerIx)) -+ { -+ DLong c; -+ e->AssureLongScalarKW( centerIx, c); -+ center = (c != 0); -+ } -+ -+ // overrides EDGE_TRUNCATE -+ static int edge_wrapIx = e->KeywordIx( "EDGE_WRAP"); -+ bool edge_wrap = e->KeywordSet( edge_wrapIx); -+ static int edge_truncateIx = e->KeywordIx( "EDGE_TRUNCATE"); -+ bool edge_truncate = e->KeywordSet( edge_truncateIx); -+ -+ int edgeMode = 0; -+ if( edge_wrap) -+ edgeMode = 1; -+ else if( edge_truncate) -+ edgeMode = 2; -+ -+ // p0, p1 and scale have same type -+ // p1 has rank of 1 or same rank as p0 with each dimension smaller than p0 -+ // scale is a scalar -+ -+ static int biasIx = e->KeywordIx("BIAS"); -+ bool statusBias = e->KeywordPresent( biasIx ); -+ DLong bias=0; -+ if(statusBias) -+ e->AssureLongScalarKW( biasIx, bias); -+ -+ -+ if(statusBias)cout<<"bias is present: "<Convol( p1, scale, NULL, center, false, edgeMode); -+ -+ } -+ */ -+ BaseGDL* rebin_fun( EnvT* e) -+ { -+ SizeT nParam = e->NParam( 2); -+ -+ BaseGDL* p0 = e->GetNumericParDefined( 0); -+ -+ SizeT rank = p0->Rank(); -+ -+ if( rank == 0) -+ e->Throw( "Expression must be an array in this context: "+ -+ e->GetParString(0)); -+ -+ SizeT resDimInit[ MAXRANK]; -+ -+ DLongGDL* p1 = e->GetParAs(1); -+ if (p1->Rank() > 0 && nParam > 2) -+ e->Throw("The new dimensions must either be specified as an array or as a set of scalars."); -+ SizeT np = p1->Rank() == 0 ? nParam : p1->N_Elements() + 1; -+ -+ for( SizeT p=1; pRank() == 0) e->AssureLongScalarPar( p, newDim); -+ else newDim = (*p1)[p - 1]; -+ -+ if( newDim <= 0) -+ e->Throw( "Array dimensions must be greater than 0."); -+ -+ if( rank >= p) -+ { -+ SizeT oldDim = p0->Dim( p-1); -+ -+ if( newDim > oldDim) -+ { -+ if( (newDim % oldDim) != 0) -+ e->Throw( "Result dimensions must be integer factor " -+ "of original dimensions."); -+ } -+ else -+ { -+ if( (oldDim % newDim) != 0) -+ e->Throw( "Result dimensions must be integer factor " -+ "of original dimensions."); -+ } -+ } -+ -+ resDimInit[ p-1] = newDim; -+ } -+ -+ dimension resDim( resDimInit, np-1); -+ -+ static int sampleIx = e->KeywordIx( "SAMPLE"); -+ bool sample = e->KeywordSet( sampleIx); -+ -+ return p0->Rebin( resDim, sample); -+ } -+ -+ BaseGDL* obj_class( EnvT* e) -+ { -+ SizeT nParam = e->NParam(); -+ -+ static int countIx = e->KeywordIx( "COUNT"); -+ static int superIx = e->KeywordIx( "SUPERCLASS"); -+ -+ bool super = e->KeywordSet( superIx); -+ -+ bool count = e->KeywordPresent( countIx); -+ if( count) -+ e->AssureGlobalKW( countIx); -+ -+ if( nParam > 0) -+ { -+ BaseGDL* p0 = e->GetParDefined( 0); -+ -+ if( p0->Type() != GDL_STRING && p0->Type() != GDL_OBJ) -+ e->Throw( "Argument must be a scalar object reference or string: "+ -+ e->GetParString(0)); -+ -+ if( !p0->Scalar()) -+ e->Throw( "Expression must be a scalar or 1 element " -+ "array in this context: "+e->GetParString(0)); -+ -+ DStructDesc* objDesc; -+ -+ if( p0->Type() == GDL_STRING) -+ { -+ DString objName; -+ e->AssureScalarPar( 0, objName); -+ objName = StrUpCase( objName); -+ -+ objDesc = FindInStructList( structList, objName); -+ if( objDesc == NULL) -+ { -+ if( count) -+ e->SetKW( countIx, new DLongGDL( 0)); -+ return new DStringGDL( ""); -+ } -+ } -+ else // GDL_OBJ -+ { -+ DObj objRef; -+ e->AssureScalarPar( 0, objRef); -+ -+ if( objRef == 0) -+ { -+ if( count) -+ e->SetKW( countIx, new DLongGDL( 0)); -+ return new DStringGDL( ""); -+ } -+ -+ DStructGDL* oStruct; -+ try { -+ oStruct = e->GetObjHeap( objRef); -+ } -+ catch ( GDLInterpreter::HeapException ) -+ { // non valid object -+ if( count) -+ e->SetKW( countIx, new DLongGDL( 0)); -+ return new DStringGDL( ""); -+ } -+ -+ objDesc = oStruct->Desc(); // cannot be NULL -+ } -+ -+ if( !super) -+ { -+ if( count) -+ e->SetKW( countIx, new DLongGDL( 1)); -+ return new DStringGDL( objDesc->Name()); -+ } -+ -+ vector< string> pNames; -+ objDesc->GetParentNames( pNames); -+ -+ SizeT nNames = pNames.size(); -+ -+ if( count) -+ e->SetKW( countIx, new DLongGDL( nNames)); -+ -+ if( nNames == 0) -+ { -+ return new DStringGDL( ""); -+ } -+ -+ DStringGDL* res = new DStringGDL( dimension( nNames), -+ BaseGDL::NOZERO); -+ -+ for( SizeT i=0; iThrow( "Conflicting keywords."); -+ -+ SizeT nObj = structList.size(); -+ -+ DStringGDL* res = new DStringGDL( dimension( nObj), -+ BaseGDL::NOZERO); -+ -+ for( SizeT i=0; iName(); -+ } -+ -+ return res; -+ } -+ -+ BaseGDL* obj_isa( EnvT* e) -+ { -+ SizeT nParam = e->NParam( 2); -+ -+ BaseGDL* p0 = e->GetPar( 0); -+ if( p0 == NULL || p0->Type() != GDL_OBJ) -+ e->Throw( "Object reference type required in this context: "+ -+ e->GetParString(0)); -+ -+ DString className; -+ e->AssureScalarPar( 1, className); -+ className = StrUpCase( className); -+ -+ DObjGDL* pObj = static_cast( p0); -+ -+ DByteGDL* res = new DByteGDL( pObj->Dim()); // zero -+ -+ GDLInterpreter* interpreter = e->Interpreter(); -+ -+ SizeT nElem = pObj->N_Elements(); -+ for( SizeT i=0; iObjValid( (*pObj)[ i])) -+ { -+ DStructGDL* oStruct = e->GetObjHeap( (*pObj)[i]); -+ if( oStruct->Desc()->IsParent( className)) -+ (*res)[i] = 1; -+ } -+ } -+ -+ return res; -+ } -+ -+ BaseGDL* n_tags( EnvT* e) -+ { -+ e->NParam( 1); -+ -+ BaseGDL* p0 = e->GetPar( 0); -+ if( p0 == NULL) -+ return new DLongGDL( 0); -+ -+ if( p0->Type() != GDL_STRUCT) -+ return new DLongGDL( 0); -+ -+ DStructGDL* s = static_cast( p0); -+ -+ //static int lengthIx = e->KeywordIx( "DATA_LENGTH"); -+ //bool length = e->KeywordSet( lengthIx); -+ -+ // we don't know now how to distinghuis the 2 following cases -+ if(e->KeywordSet("DATA_LENGTH")) -+ return new DLongGDL( s->Sizeof()); -+ -+ if(e->KeywordSet("LENGTH")) -+ return new DLongGDL( s->Sizeof()); -+ -+ return new DLongGDL( s->Desc()->NTags()); -+ } -+ -+ BaseGDL* bytscl( EnvT* e) -+ { -+ SizeT nParam = e->NParam( 1); -+ -+ BaseGDL* p0=e->GetNumericParDefined( 0); -+ -+ static int minIx = e->KeywordIx( "MIN"); -+ static int maxIx = e->KeywordIx( "MAX"); -+ static int topIx = e->KeywordIx( "TOP"); -+ bool omitNaN = e->KeywordPresent( 3); -+ -+ DLong topL=255; -+ if( e->GetKW( topIx) != NULL) -+ e->AssureLongScalarKW( topIx, topL); -+ if (topL > 255) topL=255; // Bug corrected! -+ DByte top = static_cast(topL); -+ DDouble dTop = static_cast(top); -+ -+ DDouble min; -+ bool minSet = false; -+ // SA: handling 3 parameters to emulate undocumented IDL behaviour -+ // of translating second and third arguments to MIN and MAX, respectively -+ // (parameters have precedence over keywords) -+ if (nParam >= 2) -+ { -+ e->AssureDoubleScalarPar(1, min); -+ minSet = true; -+ } -+ else if (e->GetKW(minIx) != NULL) -+ { -+ e->AssureDoubleScalarKW(minIx, min); -+ minSet = true; -+ } -+ -+ DDouble max; -+ bool maxSet = false; -+ if (nParam == 3) -+ { -+ e->AssureDoubleScalarPar(2, max); -+ maxSet = true; -+ } -+ else if (e->GetKW(maxIx) != NULL) -+ { -+ e->AssureDoubleScalarKW(maxIx, max); -+ maxSet = true; -+ } -+ -+ DDoubleGDL* dRes = -+ static_cast(p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ -+ DLong maxEl, minEl; -+ if( !maxSet || !minSet) -+ dRes->MinMax( &minEl, &maxEl, NULL, NULL, omitNaN); -+ if( !minSet) -+ min = (*dRes)[ minEl]; -+ if( !maxSet) -+ max = (*dRes)[ maxEl]; -+ -+ SizeT nEl = dRes->N_Elements(); -+ for( SizeT i=0; i= max) (*dRes)[ i] = dTop; -+ else -+ { -+ // SA: floor is used for integer types to simulate manipulation on input data types -+ if (IntType(p0->Type())) (*dRes)[ i] = floor(((dTop + 1.)*(d - min) - 1.) / (max-min)); -+ // SA (?): here floor is used (instead of round) to simulate IDL behaviour -+ else (*dRes)[ i] = floor((d - min) / (max-min) * (dTop + .9999)); -+ } -+ } -+ -+ return dRes->Convert2( GDL_BYTE); -+ } -+ -+ BaseGDL* strtok_fun( EnvT* e) -+ { -+ SizeT nParam=e->NParam( 1); -+ -+ DString stringIn; -+ e->AssureStringScalarPar( 0, stringIn); -+ -+ DString pattern = " \t"; -+ if(nParam > 1) { -+ e->AssureStringScalarPar( 1, pattern); -+ } -+ -+ static int extractIx = e->KeywordIx( "EXTRACT"); -+ bool extract = e->KeywordSet( extractIx); -+ -+ static int lengthIx = e->KeywordIx( "LENGTH"); -+ bool lengthPresent = e->KeywordPresent( lengthIx); -+ -+ if( extract && lengthPresent) -+ e->Throw( "Conflicting keywords."); -+ -+ static int pre0Ix = e->KeywordIx( "PRESERVE_NULL"); -+ bool pre0 = e->KeywordSet( pre0Ix); -+ -+ static int regexIx = e->KeywordIx( "REGEX"); -+ bool regex = e->KeywordSet( regexIx); -+ char err_msg[MAX_REGEXPERR_LENGTH]; -+ regex_t regexp; -+ -+ vector tokenStart; -+ vector tokenLen; -+ -+ int strLen = stringIn.length(); -+ -+ DString escape = ""; -+ e->AssureStringScalarKWIfPresent( "ESCAPE", escape); -+ vector escList; -+ long pos = 0; -+ while(pos != string::npos) -+ { -+ pos = stringIn.find_first_of( escape, pos); -+ if( pos != string::npos) -+ { -+ escList.push_back( pos+1); // remember escaped char -+ pos += 2; // skip escaped char -+ } -+ } -+ vector::iterator escBeg = escList.begin(); -+ vector::iterator escEnd = escList.end(); -+ -+ long tokB = 0; -+ long tokE; -+ long nextE = 0; -+ long actLen; -+ -+ // If regex then compile regex -+ if( regex) { -+ if (pattern == " \t") pattern = " "; // regcomp doesn't like "\t" JMG -+ int compRes = regcomp( ®exp, pattern.c_str(), REG_EXTENDED); -+ if (compRes) { -+ regerror(compRes, ®exp, err_msg, MAX_REGEXPERR_LENGTH); -+ e->Throw( "Error processing regular expression: "+ -+ pattern+"\n "+string(err_msg)+"."); -+ } -+ } -+ -+ for(;;) -+ { -+ regmatch_t pmatch[1]; -+ if( regex) { -+ int matchres = regexec( ®exp, stringIn.c_str()+nextE, 1, pmatch, 0); -+ tokE = matchres? -1:pmatch[0].rm_so; -+ } else { -+ tokE = stringIn.find_first_of( pattern, nextE); -+ } -+ -+ if( tokE == string::npos) -+ { -+ actLen = strLen - tokB; -+ if( actLen > 0 || pre0) -+ { -+ tokenStart.push_back( tokB); -+ tokenLen.push_back( actLen); -+ } -+ break; -+ } -+ -+ if( find( escBeg, escEnd, tokE) == escEnd) -+ { -+ if (regex) actLen = tokE; else actLen = tokE - tokB; -+ if( actLen > 0 || pre0) -+ { -+ tokenStart.push_back( tokB); -+ tokenLen.push_back( actLen); -+ } -+ if (regex) tokB += pmatch[0].rm_eo; else tokB = tokE + 1; -+ } -+ if (regex) nextE += pmatch[0].rm_eo; else nextE = tokE + 1; -+ } // for(;;) -+ -+ if (regex) regfree( ®exp); -+ -+ SizeT nTok = tokenStart.size(); -+ -+ if( !extract) -+ { -+ if( lengthPresent) -+ { -+ e->AssureGlobalKW( lengthIx); -+ -+ if( nTok > 0) -+ { -+ dimension dim(nTok); -+ DLongGDL* len = new DLongGDL(dim); -+ for(int i=0; i < nTok; i++) -+ (*len)[i] = tokenLen[i]; -+ -+ e->SetKW( lengthIx, len); -+ } -+ else -+ { -+ e->SetKW( lengthIx, new DLongGDL( 0)); -+ } -+ } -+ -+ if( nTok == 0) return new DLongGDL( 0); -+ -+ dimension dim(nTok); -+ DLongGDL* d = new DLongGDL(dim); -+ for(int i=0; i < nTok; i++) -+ (*d)[i] = tokenStart[i]; -+ return d; -+ } -+ -+ // EXTRACT -+ if( nTok == 0) return new DStringGDL( ""); -+ -+ dimension dim(nTok); -+ DStringGDL *d = new DStringGDL(dim); -+ for(int i=0; i < nTok; i++) -+ { -+ (*d)[i] = stringIn.substr(tokenStart[i], tokenLen[i]); -+ -+ // remove escape -+ DString& act = (*d)[i]; -+ long escPos = act.find_first_of( escape, 0); -+ while( escPos != string::npos) -+ { -+ act = act.substr( 0, escPos)+act.substr( escPos+1); -+ escPos = act.find_first_of( escape, escPos+1); -+ } -+ } -+ return d; -+ } -+ -+ BaseGDL* getenv_fun( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ -+ static int environmentIx = e->KeywordIx( "ENVIRONMENT" ); -+ bool environment = e->KeywordSet( environmentIx ); -+ -+ SizeT nEnv; -+ DStringGDL* env; -+ -+ if( environment) { -+ -+ if(nParam != 0) -+ e->Throw( "Incorrect number of arguments."); -+ -+ // determine number of environment entries -+ for(nEnv = 0; environ[nEnv] != NULL ; ++nEnv); -+ -+ dimension dim( nEnv ); -+ env = new DStringGDL(dim); -+ -+ // copy stuff into local string array -+ for(SizeT i=0; i < nEnv ; ++i) -+ (*env)[i] = environ[i]; -+ -+ } else { -+ -+ if(nParam != 1) -+ e->Throw( "Incorrect number of arguments."); -+ -+ DStringGDL* name = e->GetParAs(0); -+ nEnv = name->N_Elements(); -+ -+ env = new DStringGDL( name->Dim()); -+ -+ // copy the stuff into local string only if param found -+ char *resPtr; -+ for(SizeT i=0; i < nEnv ; ++i) -+ { -+ // handle special environment variables -+ // GDL_TMPDIR, IDL_TMPDIR -+ if( (*name)[i] == "GDL_TMPDIR" || (*name)[i] == "IDL_TMPDIR") -+ { -+ resPtr = getenv((*name)[i].c_str()); -+ -+ if( resPtr != NULL) -+ (*env)[i] = resPtr; -+ else -+ (*env)[i] = SysVar::Dir(); -+ -+ AppendIfNeeded( (*env)[i], "/"); -+ } -+ else // normal environment variables -+ if( (resPtr = getenv((*name)[i].c_str())) ) -+ (*env)[i] = resPtr; -+ } -+ } -+ -+ return env; -+ } -+ -+ BaseGDL* tag_names_fun( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ DStructGDL* struc= e->GetParAs(0); -+ -+ static int structureNameIx = e->KeywordIx( "STRUCTURE_NAME" ); -+ bool structureName = e->KeywordSet( structureNameIx ); -+ -+ DStringGDL* tagNames; -+ -+ if(structureName){ -+ -+ if ((*struc).Desc()->Name() != "$truct") -+ tagNames = new DStringGDL((*struc).Desc()->Name()); -+ else -+ tagNames = new DStringGDL(""); -+ -+ } else { -+ SizeT nTags = (*struc).Desc()->NTags(); -+ -+ tagNames = new DStringGDL(dimension(nTags)); -+ for(int i=0; i < nTags; ++i) -+ (*tagNames)[i] = (*struc).Desc()->TagName(i); -+ } -+ -+ return tagNames; -+ } -+ -+// AC 12-Oc-2011: better version for: len=len, /Extract and /Sub -+// but it is still not perfect -+ -+ BaseGDL* stregex_fun( EnvT* e) -+ { -+ SizeT nParam=e->NParam( 2); -+ -+ DStringGDL* stringExpr= e->GetParAs(0); -+ dimension dim = stringExpr->Dim(); -+ -+ DString pattern; -+ e->AssureStringScalarPar(1, pattern); -+ if (pattern.size() <= 0) -+ { -+ e->Throw( "Error processing regular expression: "+pattern+ -+ "\n empty (sub)expression"); -+ } -+ -+ static int booleanIx = e->KeywordIx( "BOOLEAN" ); -+ bool booleanKW = e->KeywordSet( booleanIx ); -+ -+ static int extractIx = e->KeywordIx( "EXTRACT" ); -+ bool extractKW = e->KeywordSet( extractIx ); -+ -+ static int foldCaseIx = e->KeywordIx( "FOLD_CASE" ); -+ bool foldCaseKW = e->KeywordSet( foldCaseIx ); -+ -+ //XXXpch: this is wrong, should check arg_present -+ static int lengthIx = e->KeywordIx( "LENGTH" ); -+ bool lengthKW = e->KeywordPresent( lengthIx ); -+ -+ static int subexprIx = e->KeywordIx( "SUBEXPR" ); -+ bool subexprKW = e->KeywordSet( subexprIx ); -+ -+ if( booleanKW && (subexprKW || extractKW || lengthKW)) -+ e->Throw( "Conflicting keywords."); -+ -+ char err_msg[MAX_REGEXPERR_LENGTH]; -+ -+ // set the compile flags -+ int cflags = REG_EXTENDED; -+ if (foldCaseKW) -+ cflags |= REG_ICASE; -+ if (booleanKW) -+ cflags |= REG_NOSUB; -+ -+ // compile the regular expression -+ regex_t regexp; -+ int compRes = regcomp( ®exp, pattern.c_str(), cflags); -+ SizeT nSubExpr = regexp.re_nsub + 1; -+ -+ // cout << regexp.re_nsub << endl; -+ -+ if (compRes) { -+ regerror(compRes, ®exp, err_msg, MAX_REGEXPERR_LENGTH); -+ e->Throw( "Error processing regular expression: "+ -+ pattern+"\n "+string(err_msg)+"."); -+ } -+ -+ BaseGDL* result; -+ -+ if( booleanKW) -+ result = new DByteGDL(dim); -+ else if( extractKW && !subexprKW) -+ { -+ // cout << "my pb ! ? dim= " << dim << endl; -+ result = new DStringGDL(dim); -+ } -+ else if( subexprKW) -+ { -+ // cout << "my pb 2 ? dim= " << dim << endl; -+ dimension subExprDim = dim; -+ subExprDim >> nSubExpr; // m_schellens: commented in, needed -+ if( extractKW) -+ result = new DStringGDL(subExprDim); -+ else -+ result = new DLongGDL(subExprDim); -+ } -+ else -+ result = new DLongGDL(dim); -+ -+ DLongGDL* len = NULL; -+ if( lengthKW) { -+ e->AssureGlobalKW( lengthIx); -+ if( subexprKW) -+ { -+ dimension subExprDim = dim; -+ subExprDim >> nSubExpr; // m_schellens: commented in, needed -+ len = new DLongGDL(subExprDim); -+ } -+ else -+ { -+ len = new DLongGDL(dim); -+ } -+ for( SizeT i=0; iN_Elements(); ++i) -+ (*len)[i]= -1; -+ } -+ -+ int nmatch = 1; -+ if( subexprKW) nmatch = nSubExpr; -+ -+ regmatch_t* pmatch = new regmatch_t[nSubExpr]; -+ ArrayGuard pmatchGuard( pmatch); -+ -+ // cout << "dim " << dim.NDimElements() << endl; -+ for( SizeT s=0; s(result))[i+s*nSubExpr] = -+ (*stringExpr)[s].substr( pmatch[i].rm_so, pmatch[i].rm_eo - pmatch[i].rm_so); -+// (*stringExpr)[i+s*nSubExpr].substr( pmatch[i].rm_so, pmatch[i].rm_eo - pmatch[i].rm_so); -+ if( lengthKW) -+ (*len)[i+s*nSubExpr] = pmatch[i].rm_so != -1 ? pmatch[i].rm_eo - pmatch[i].rm_so : -1; -+// (*len)[i+s*nSubExpr] = pmatch[i].rm_eo - pmatch[i].rm_so; -+ } -+ } -+ else if ( subexprKW) -+ { -+ // cout << "je ne comprends pas v2: "<< nSubExpr << endl; -+ -+ // Loop through subexpressions & fill output array -+ for( SizeT i = 0; i(result))[i+s*nSubExpr] = pmatch[i].rm_so; -+ if( lengthKW) -+ (*len)[i+s*nSubExpr] = pmatch[i].rm_so != -1 ? pmatch[i].rm_eo - pmatch[i].rm_so : -1; -+ } -+ } -+ else -+ { -+ if( booleanKW) -+ (* static_cast(result))[s] = (matchres == 0); -+ else if ( extractKW) // !subExprKW -+ { -+ if( matchres == 0) -+ (* static_cast(result))[s] = -+ (*stringExpr)[s].substr( pmatch[0].rm_so, -+ pmatch[0].rm_eo - pmatch[0].rm_so); -+ } -+ else -+ (*static_cast(result))[s] = matchres ? -1 : pmatch[0].rm_so; -+ } -+ -+ if( lengthKW && !subexprKW) -+ (*len)[s] = pmatch[0].rm_eo - pmatch[0].rm_so; -+ } -+ -+ regfree( ®exp); -+ -+ if( lengthKW) -+ e->SetKW( lengthIx, len); -+ -+ return result; -+ } -+ -+ BaseGDL* routine_info( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ if (nParam > 1) e->Throw("Incorrect number of arguments."); -+ -+ static int functionsIx = e->KeywordIx( "FUNCTIONS" ); -+ bool functionsKW = e->KeywordSet( functionsIx ); -+ static int systemIx = e->KeywordIx( "SYSTEM" ); -+ bool systemKW = e->KeywordSet( systemIx ); -+ static int disabledIx = e->KeywordIx( "DISABLED" ); -+ bool disabledKW = e->KeywordSet( disabledIx ); -+ static int parametersIx = e->KeywordIx( "PARAMETERS" ); -+ bool parametersKW = e->KeywordSet( parametersIx ); -+ static int sourceIx = e->KeywordIx( "SOURCE" ); -+ bool sourceKW = e->KeywordSet(sourceIx ); -+ -+ if (sourceKW) { -+ -+ // sanity checks -+ if (systemKW) e->Throw("Conflicting keywords."); -+ -+ // we are not ready to manage the case when no param is provide (routine name) -+ if (nParam == 0) e->Throw("This case is not ready"); -+ -+ // it seems that the code inside "CREATE_STRUCTURE()" (see here below) -+ // shall be a base to do it (notes by AC, May 16, 2013) -+ -+ /*if (functionsKW) { -+ if (funList.size() == 0) { -+ return new DStringGDL(""); -+ } else { -+ */ -+ -+ // getting the routine name from the first parameter (must be a singleton) -+ DString raw_name, name; -+ e->AssureScalarPar(0, raw_name); -+ name = StrUpCase(raw_name); -+ -+ string FullFileName; -+ bool found=false; -+ -+ // SizeT n = funList.size(); -+ //cout << funList.size() << endl; -+ //cout << proList.size() << endl; -+ -+ // looking in the compiled functions (if /function keyword provided) -+ // or in the compiled procedures -+ if (functionsKW) { -+ for(FunListT::iterator i=funList.begin(); i != funList.end(); ++i) { -+ if ((*i)->ObjectName() == name) { -+ found=true; -+ FullFileName=(*i)->GetFilename(); -+ break; -+ } -+ } -+ if (!found) e->Throw("% Attempt to call undefined/not compiled function: '"+raw_name+"'"); -+ } else { -+ for(ProListT::iterator i=proList.begin(); i != proList.end(); ++i) { -+ if ((*i)->ObjectName() == name) { -+ found=true; -+ FullFileName=(*i)->GetFilename(); -+ break; -+ } -+ } -+ if (!found) e->Throw("% Attempt to call undefined/not compiled procedure: '"+raw_name+"'"); -+ } -+ -+ // creating the output anonymous structure -+ DStructDesc* stru_desc = new DStructDesc("$truct"); -+ SpDString aString; -+ stru_desc->AddTag("NAME", &aString); -+ stru_desc->AddTag("PATH", &aString); -+ -+ DStructGDL* stru = new DStructGDL(stru_desc, dimension()); -+ // filling the structure with information about the routine -+ stru->InitTag("NAME", DStringGDL(name)); -+ stru->InitTag("PATH", DStringGDL(FullFileName)); -+ -+ return stru; -+ -+ } -+ -+ if (parametersKW) -+ { -+ // sanity checks -+ if (systemKW || disabledKW) e->Throw("Conflicting keywords."); -+ -+ // getting the routine name from the first parameter -+ DString name; -+ e->AssureScalarPar(0, name); -+ name = StrUpCase(name); -+ -+ DSubUD* routine = functionsKW -+ ? static_cast(funList[GDLInterpreter::GetFunIx(name)]) -+ : static_cast(proList[GDLInterpreter::GetProIx(name)]); -+ SizeT np = routine->NPar(), nk = routine->NKey(); -+ -+ // creating the output anonymous structure -+ DStructDesc* stru_desc = new DStructDesc("$truct"); -+ SpDLong aLong; -+ stru_desc->AddTag("NUM_ARGS", &aLong); -+ stru_desc->AddTag("NUM_KW_ARGS", &aLong); -+ if (np > 0) -+ { -+ SpDString aStringArr(dimension((int)np)); -+ stru_desc->AddTag("ARGS", &aStringArr); -+ } -+ if (nk > 0) -+ { -+ SpDString aStringArr(dimension((int)nk)); -+ stru_desc->AddTag("KW_ARGS", &aStringArr); -+ } -+ DStructGDL* stru = new DStructGDL(stru_desc, dimension()); -+ -+ // filling the structure with information about the routine -+ stru->InitTag("NUM_ARGS", DLongGDL(np)); -+ stru->InitTag("NUM_KW_ARGS", DLongGDL(nk)); -+ if (np > 0) -+ { -+ DStringGDL *pnames = new DStringGDL(dimension(np)); -+ for (SizeT p = 0; p < np; ++p) (*pnames)[p] = routine->GetVarName(nk + p); -+ stru->InitTag("ARGS", *pnames); -+ GDLDelete(pnames); -+ } -+ if (nk > 0) -+ { -+ DStringGDL *knames = new DStringGDL(dimension(nk)); -+ for (SizeT k = 0; k < nk; ++k) (*knames)[k] = routine->GetKWName(k); -+ stru->InitTag("KW_ARGS", *knames); -+ GDLDelete(knames); -+ } -+ -+ // returning -+ return stru; -+ } -+ -+ // GDL does not have disabled routines -+ if( disabledKW) return new DStringGDL(""); -+ -+ // if( functionsKW || systemKW || nParam == 0) -+ // { -+ vector subList; -+ -+ if( functionsKW) -+ { -+ if( systemKW) -+ { -+ SizeT n = libFunList.size(); -+ if( n == 0) return new DStringGDL(""); -+ -+ DStringGDL* res = new DStringGDL( dimension( n), BaseGDL::NOZERO); -+ for( SizeT i = 0; iObjectName(); -+ -+ return res; -+ } -+ else -+ { -+ SizeT n = funList.size(); -+ if( n == 0) return new DStringGDL(""); -+ subList.resize( n); -+ -+ for( SizeT i = 0; iObjectName()); -+ } -+ } -+ else -+ { -+ if( systemKW) -+ { -+ SizeT n = libProList.size(); -+ if( n == 0) return new DStringGDL(""); -+ -+ DStringGDL* res = new DStringGDL( dimension( n), BaseGDL::NOZERO); -+ for( SizeT i = 0; iObjectName(); -+ -+ return res; -+ } -+ else -+ { -+ SizeT n = proList.size(); -+ if( n == 0) return new DStringGDL(""); -+ subList.resize( n); -+ -+ for( SizeT i = 0; iObjectName()); -+ } -+ } -+ -+ sort( subList.begin(), subList.end()); -+ SizeT nS = subList.size(); -+ -+ DStringGDL* res = new DStringGDL( dimension( nS), BaseGDL::NOZERO); -+ for( SizeT s=0; s -+ rl_prep_terminal (0); -+#endif -+ -+ SizeT nParam=e->NParam(); -+ -+ bool doWait = true; -+ if( nParam > 0) -+ { -+ doWait = false; -+ DLong waitArg = 0; -+ e->AssureLongScalarPar( 0, waitArg); -+ if( waitArg != 0) -+ { -+ doWait = true; -+ } -+ } -+ -+ // https://sourceforge.net/forum/forum.php?thread_id=3292183&forum_id=338691 -+ // DONE: Implement proper SCALAR parameter handling (doWait variable) -+ // which is/was not blocking in the original program. -+ // note: multi-byte input is not supported here. -+ -+ char c='\0'; //initialize is never a bad idea... -+ -+ int fd=fileno(stdin); -+#ifndef _MSC_VER -+ struct termios orig, get; -+#endif -+ // Get terminal setup to revert to it at end. -+#ifndef _MSC_VER -+ (void)tcgetattr(fd, &orig); -+ // New terminal setup, non-canonical. -+ get.c_lflag = ISIG; -+#endif -+ if (doWait) -+ { -+ // will wait for a character -+#ifndef _MSC_VER -+ get.c_cc[VTIME]=0; -+ get.c_cc[VMIN]=1; -+ (void)tcsetattr(fd, TCSANOW, &get); -+#endif -+ cin.get(c); -+ } -+ else -+ { -+ // will not wait, but return EOF or next character in terminal buffer if present -+#ifndef _MSC_VER -+ get.c_cc[VTIME]=0; -+ get.c_cc[VMIN]=0; -+ (void)tcsetattr(fd, TCSANOW, &get); -+#endif -+ //the trick is *not to use C++ functions here. cin.get would wait.* -+ c=std::fgetc(stdin); -+ //and to convert EOF to null (otherwise GDL may exit if not compiled with -+ //[lib][n]curses) -+ if(c==EOF) c='\0'; -+ } -+ -+ // Restore original terminal settings. -+#ifndef _MSC_VER -+ (void)tcsetattr(fd, TCSANOW, &orig); -+#endif -+#if defined(HAVE_LIBREADLINE) -+ rl_deprep_terminal (); -+#endif -+ -+ DStringGDL* res = new DStringGDL( DString( i2s( c))); -+ -+ return res; -+ -+ } -+ -+ -+ BaseGDL* temporary( EnvT* e) -+ { -+ SizeT nParam=e->NParam(1); -+ -+ BaseGDL** p0 = &e->GetParDefined( 0); -+ -+ BaseGDL* ret = *p0; -+ -+ *p0 = NULL; // make parameter undefined -+ return ret; -+ } -+ -+ BaseGDL* memory( EnvT* e) -+ { -+ SizeT nParam=e->NParam( 0); -+ -+ BaseGDL* ret; -+ bool kw_l64 = e->KeywordSet(e->KeywordIx("L64")); -+ // TODO: IDL-doc mentions about automatically switching to L64 if needed -+ -+ if (e->KeywordSet(e->KeywordIx("STRUCTURE"))) -+ { -+ // returning structure -+ if (kw_l64) -+ { -+ ret = new DStructGDL("IDL_MEMORY64"); -+ DStructGDL* retStru = static_cast(ret); -+ (retStru->GetTag(retStru->Desc()->TagIndex("CURRENT")))->InitFrom( DLong64GDL(MemStats::GetCurrent())); -+ (retStru->GetTag(retStru->Desc()->TagIndex("NUM_ALLOC")))->InitFrom( DLong64GDL(MemStats::GetNumAlloc())); -+ (retStru->GetTag(retStru->Desc()->TagIndex("NUM_FREE")))->InitFrom( DLong64GDL(MemStats::GetNumFree())); -+ (retStru->GetTag(retStru->Desc()->TagIndex("HIGHWATER")))->InitFrom( DLong64GDL(MemStats::GetHighWater())); -+ } -+ else -+ { -+ ret = new DStructGDL("IDL_MEMORY"); -+ DStructGDL* retStru = static_cast(ret); -+ (retStru->GetTag(retStru->Desc()->TagIndex("CURRENT")))->InitFrom( DLongGDL(MemStats::GetCurrent())); -+ (retStru->GetTag(retStru->Desc()->TagIndex("NUM_ALLOC")))->InitFrom( DLongGDL(MemStats::GetNumAlloc())); -+ (retStru->GetTag(retStru->Desc()->TagIndex("NUM_FREE")))->InitFrom( DLongGDL(MemStats::GetNumFree())); -+ (retStru->GetTag(retStru->Desc()->TagIndex("HIGHWATER")))->InitFrom( DLongGDL(MemStats::GetHighWater())); -+ } -+ } -+ else -+ { -+ bool kw_current = e->KeywordSet(e->KeywordIx("CURRENT")); -+ bool kw_num_alloc = e->KeywordSet(e->KeywordIx("NUM_ALLOC")); -+ bool kw_num_free = e->KeywordSet(e->KeywordIx("NUM_FREE")); -+ bool kw_highwater = e->KeywordSet(e->KeywordIx("HIGHWATER")); -+ -+ // Following the IDL documentation: mutually exclusive keywords -+ // IDL behaves different, incl. segfaults with selected kw combinations -+ if (kw_current + kw_num_alloc + kw_num_free + kw_highwater > 1) -+ e->Throw("CURRENT, NUM_ALLOC, NUM_FREE & HIGHWATER keywords" -+ " are mutually exclusive"); -+ -+ if (kw_current) -+ { -+ if (kw_l64) ret = new DLong64GDL(MemStats::GetCurrent()); -+ else ret = new DLongGDL(MemStats::GetCurrent()); -+ } -+ else if (kw_num_alloc) -+ { -+ if (kw_l64) ret = new DLong64GDL(MemStats::GetNumAlloc()); -+ else ret = new DLongGDL(MemStats::GetNumAlloc()); -+ } -+ else if (kw_num_free) -+ { -+ if (kw_l64) ret = new DLong64GDL(MemStats::GetNumFree()); -+ else ret = new DLongGDL(MemStats::GetNumFree()); -+ } -+ else if (kw_highwater) -+ { -+ if (kw_l64) ret = new DLong64GDL(MemStats::GetHighWater()); -+ else ret = new DLongGDL(MemStats::GetHighWater()); -+ } -+ else -+ { -+ // returning 4-element array -+ if (kw_l64) -+ { -+ ret = new DLong64GDL(dimension(4)); -+ (*static_cast(ret))[0] = MemStats::GetCurrent(); -+ (*static_cast(ret))[1] = MemStats::GetNumAlloc(); -+ (*static_cast(ret))[2] = MemStats::GetNumFree(); -+ (*static_cast(ret))[3] = MemStats::GetHighWater(); -+ } -+ else -+ { -+ ret = new DLongGDL(dimension(4)); -+ (*static_cast(ret))[0] = MemStats::GetCurrent(); -+ (*static_cast(ret))[1] = MemStats::GetNumAlloc(); -+ (*static_cast(ret))[2] = MemStats::GetNumFree(); -+ (*static_cast(ret))[3] = MemStats::GetHighWater(); -+ } -+ } -+ } -+ -+ return ret; -+ } -+ -+ inline DByte StrCmp( const string& s1, const string& s2, DLong n) -+ { -+ if( n <= 0) return 1; -+ if( s1.substr(0,n) == s2.substr(0,n)) return 1; -+ return 0; -+ } -+ inline DByte StrCmp( const string& s1, const string& s2) -+ { -+ if( s1 == s2) return 1; -+ return 0; -+ } -+ inline DByte StrCmpFold( const string& s1, const string& s2, DLong n) -+ { -+ if( n <= 0) return 1; -+ if( StrUpCase( s1.substr(0,n)) == StrUpCase(s2.substr(0,n))) return 1; -+ return 0; -+ } -+ inline DByte StrCmpFold( const string& s1, const string& s2) -+ { -+ if( StrUpCase( s1) == StrUpCase(s2)) return 1; -+ return 0; -+ } -+ -+ BaseGDL* strcmp_fun( EnvT* e) -+ { -+ SizeT nParam=e->NParam(2); -+ -+ DStringGDL* s0 = static_cast( e->GetParAs< DStringGDL>( 0)); -+ DStringGDL* s1 = static_cast( e->GetParAs< DStringGDL>( 1)); -+ -+ DLongGDL* l2 = NULL; -+ if( nParam > 2) -+ { -+ l2 = static_cast( e->GetParAs< DLongGDL>( 2)); -+ } -+ -+ static int foldIx = e->KeywordIx( "FOLD_CASE"); -+ bool fold = e->KeywordSet( foldIx ); -+ -+ if( s0->Scalar() && s1->Scalar()) -+ { -+ if( l2 == NULL) -+ { -+ if( fold) -+ return new DByteGDL( StrCmpFold( (*s0)[0], (*s1)[0])); -+ else -+ return new DByteGDL( StrCmp( (*s0)[0], (*s1)[0])); -+ } -+ else -+ { -+ DByteGDL* res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -+ SizeT nEl = l2->N_Elements(); -+ if( fold) -+ for( SizeT i=0; iScalar()) -+ { -+ DByteGDL* res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -+ SizeT nEl = s1->N_Elements(); -+ if( fold) -+ for( SizeT i=0; iScalar()) -+ { -+ DByteGDL* res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -+ SizeT nEl = s0->N_Elements(); -+ if( fold) -+ for( SizeT i=0; iN_Elements() <= s1->N_Elements()) -+ { -+ res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -+ nEl = s0->N_Elements(); -+ } -+ else -+ { -+ res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -+ nEl = s1->N_Elements(); -+ } -+ if( fold) -+ for( SizeT i=0; iScalar(); -+ if( s0->Scalar()) -+ { -+ if( l2Scalar || s1->N_Elements() <= l2->N_Elements()) -+ { -+ res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -+ nEl = s1->N_Elements(); -+ } -+ else -+ { -+ res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -+ nEl = l2->N_Elements(); -+ } -+ if( fold) -+ for( SizeT i=0; iScalar()) -+ { -+ if( l2Scalar || s0->N_Elements() <= l2->N_Elements()) -+ { -+ res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -+ nEl = s0->N_Elements(); -+ } -+ else -+ { -+ res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -+ nEl = l2->N_Elements(); -+ } -+ if( fold) -+ for( SizeT i=0; iN_Elements() <= s1->N_Elements()) -+ { -+ res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -+ nEl = s0->N_Elements(); -+ } -+ else -+ { -+ res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -+ nEl = s1->N_Elements(); -+ } -+ else -+ { -+ if( s0->N_Elements() <= s1->N_Elements()) -+ if( s0->N_Elements() <= l2->N_Elements()) -+ { -+ res = new DByteGDL( s0->Dim(), BaseGDL::NOZERO); -+ nEl = s0->N_Elements(); -+ } -+ else -+ { -+ res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -+ nEl = l2->N_Elements(); -+ } -+ else -+ if( s1->N_Elements() <= l2->N_Elements()) -+ { -+ res = new DByteGDL( s1->Dim(), BaseGDL::NOZERO); -+ nEl = s1->N_Elements(); -+ } -+ else -+ { -+ res = new DByteGDL( l2->Dim(), BaseGDL::NOZERO); -+ nEl = l2->N_Elements(); -+ } -+ } -+ if( fold) -+ for( SizeT i=0; i 'Z')) -+ e->Throw( "Illegal tag name: "+name+"."); -+ for( SizeT i=1; i 'Z') && -+ (n[i] < '0' || n[i] > '9')) -+ e->Throw( "Illegal tag name: "+name+"."); -+ } -+ return n; -+ } -+ -+ BaseGDL* create_struct( EnvT* e) -+ { -+ static int nameIx = e->KeywordIx( "NAME" ); -+ DString name = "$truct"; -+ if( e->KeywordPresent( nameIx)) { -+ // Check if name exists, if not then treat as unnamed -+ if (e->GetKW( nameIx) != NULL) -+ e->AssureStringScalarKW( nameIx, name); -+ } -+ -+ if( name != "$truct") // named struct -+ { -+ name = StrUpCase( name); -+ -+ SizeT nParam=e->NParam(); -+ -+ if( nParam == 0) -+ { -+ DStructDesc* desc = -+ e->Interpreter()->GetStruct( name, e->CallingNode()); -+ -+ dimension dim( 1); -+ return new DStructGDL( desc, dim); -+ } -+ -+ DStructDesc* nStructDesc; -+ Guard nStructDescGuard; -+ -+ DStructDesc* oStructDesc= -+ FindInStructList( structList, name); -+ -+ if( oStructDesc == NULL || oStructDesc->NTags() > 0) -+ { -+ // not defined at all yet (-> define now) -+ // or completely defined (-> define now and check equality) -+ nStructDesc= new DStructDesc( name); -+ -+ // guard it -+ nStructDescGuard.Reset( nStructDesc); -+ } -+ else -+ { -+ // NTags() == 0 -+ // not completely defined (only name in list) -+ nStructDesc= oStructDesc; -+ } -+ -+ // the instance variable -+ // dimension dim( 1); -+ // DStructGDL* instance = new DStructGDL( nStructDesc, dim); -+ DStructGDL* instance = new DStructGDL( nStructDesc); -+ Guard instance_guard(instance); -+ -+ for( SizeT p=0; pGetParDefined( p); -+ if( par->Type() == GDL_STRUCT) -+ { -+ DStructGDL* parStruct = static_cast( par); -+ // add struct -+ if( !parStruct->Scalar()) -+ e->Throw("Expression must be a scalar in this context: "+ -+ e->GetParString( p)); -+ -+ DStructDesc* desc = parStruct->Desc(); -+ for( SizeT t=0; t< desc->NTags(); ++t) -+ { -+ instance->NewTag( desc->TagName( t), -+ parStruct->GetTag( t)->Dup()); -+ } -+ } -+ else -+ { -+ // add tag value pair -+ DStringGDL* tagNames = e->GetParAs( p); -+ SizeT nTags = tagNames->N_Elements(); -+ -+ SizeT tagStart = p+1; -+ SizeT tagEnd = p+nTags; -+ if( tagEnd >= nParam) -+ e->Throw( "Incorrect number of arguments."); -+ -+ do{ -+ ++p; -+ BaseGDL* value = e->GetParDefined( p); -+ -+ // add -+ instance->NewTag( TagName( e, (*tagNames)[ p-tagStart]), -+ value->Dup()); -+ } -+ while( pAssureIdentical(nStructDesc); -+ instance->DStructGDL::SetDesc(oStructDesc); -+ //delete nStructDesc; // auto_ptr -+ } -+ } -+ else -+ { -+ // release from guard (if not NULL) -+ nStructDescGuard.release(); -+ // insert into struct list -+ structList.push_back(nStructDesc); -+ } -+ -+ instance_guard.release(); -+ return instance; -+ } -+ else -+ { // unnamed struc -+ -+ // Handle case of single structure parameter -+ SizeT nParam; -+ nParam = e->NParam(1); -+ BaseGDL* par = e->GetParDefined( 0); -+// DStructGDL* parStruct = dynamic_cast( par); -+ if (nParam != 1 || par->Type() != GDL_STRUCT)// == NULL) -+ nParam=e->NParam(2); -+ -+ DStructDesc* nStructDesc = new DStructDesc( "$truct"); -+ // instance takes care of nStructDesc since it is unnamed -+ // dimension dim( 1); -+ // DStructGDL* instance = new DStructGDL( nStructDesc, dim); -+ DStructGDL* instance = new DStructGDL( nStructDesc); -+ Guard instance_guard(instance); -+ -+ for( SizeT p=0; pGetParDefined( p); -+// DStructGDL* parStruct = dynamic_cast( par); -+// if( parStruct != NULL) -+ if( par->Type() == GDL_STRUCT) -+ { -+ // add struct -+ DStructGDL* parStruct = static_cast( par); -+ if( !parStruct->Scalar()) -+ e->Throw("Expression must be a scalar in this context: "+ -+ e->GetParString( p)); -+ -+ DStructDesc* desc = parStruct->Desc(); -+ for( SizeT t=0; t< desc->NTags(); ++t) -+ { -+ instance->NewTag( desc->TagName( t), -+ parStruct->GetTag( t)->Dup()); -+ } -+ ++p; -+ } -+ else -+ { -+ // add tag value pair -+ DStringGDL* tagNames = e->GetParAs( p); -+ SizeT nTags = tagNames->N_Elements(); -+ -+ SizeT tagStart = p+1; -+ SizeT tagEnd = p+nTags; -+ if( tagEnd >= nParam) -+ e->Throw( "Incorrect number of arguments."); -+ -+ for(++p; p<=tagEnd; ++p) -+ { -+ BaseGDL* value = e->GetParDefined( p); -+ -+ // add -+ instance->NewTag( TagName( e, (*tagNames)[ p-tagStart]), -+ value->Dup()); -+ } -+ } -+ } -+ -+ instance_guard.release(); -+ return instance; -+ } -+ } -+ -+ BaseGDL* rotate( EnvT* e) -+ { -+ e->NParam(2); -+ BaseGDL* p0 = e->GetParDefined( 0); -+ -+ if( p0->Rank() == 0) -+ e->Throw( "Expression must be an array in this context: " + e->GetParString( 0)); -+ -+ if( p0->Rank() != 1 && p0->Rank() != 2) -+ e->Throw( "Only 1 or 2 dimensions allowed: " + e->GetParString( 0)); -+ -+ if( p0->Type() == GDL_STRUCT) -+ e->Throw( "STRUCT expression not allowed in this context: "+ -+ e->GetParString( 0)); -+ -+ DLong dir; -+ e->AssureLongScalarPar( 1, dir); -+ -+ return p0->Rotate( dir); -+ } -+ -+ // SA: based on the code of rotate() (above) -+ BaseGDL* reverse( EnvT* e) -+ { -+ e->NParam(1); -+ BaseGDL* p0 = e->GetParDefined(0); -+ if (p0->Rank() == 0) return p0->Dup(); -+ -+ DLong dim = 1; -+ if (e->GetPar(1) != NULL) -+ e->AssureLongScalarPar(1, dim); -+ if (p0->Rank() != 0 && (dim > p0->Rank() || dim < 1)) -+ e->Throw("Subscript_index must be positive and less than or equal to number of dimensions."); -+ -+ BaseGDL* ret; -+ // IDL doc states that OVERWRITE is ignored for one- or two-dim. arrays -+ // but it seems to behave differently -+ // if (p0->Rank() > 2 && e->KeywordSet("OVERWRITE") && e->GlobalPar(0)) -+ if (e->KeywordSet("OVERWRITE")) -+ { -+ p0->Reverse(dim-1); -+ bool stolen = e->StealLocalPar( 0); -+ if( !stolen) e->GetPar(0) = NULL; -+ return p0; -+ } -+ else ret = p0->DupReverse(dim - 1); -+ return ret; -+ } -+ -+ // SA: parse_url based on the PHP parse_url() function code -+ // by Jim Winstead / The PHP Group (PHP license v. 3.01) -+ // (http://svn.php.net/viewvc/php/php-src/trunk/ext/standard/url.c) -+ // PHP is free software available at http://www.php.net/software/ -+ // -+ // notes: -+ // - IDL does not support IPv6 URLs, GDL does -+ // - IDL includes characters after '#' in the QUERY part, GDL -+ // just skips them and issues a warning (perhaps not needed) -+ // - IDL preserves controll characters in URLs, GDL preserves -+ // them as well but a warning is issued -+ // - IDL sets 80 as a default value for PORT, even if the url has -+ // an ftp:// schema indicated - GDL does not have any default value -+ // - IDL excludes the leading "/" from the path, GDL preserves it -+ // ... these differences seem just rational for me but please do change -+ // it if IDL-compatibility would be beneficial for any reason here -+ -+ BaseGDL* parse_url(EnvT* env) -+ { -+ // sanity check for number of parameters -+ SizeT nParam = env->NParam(); -+ -+ // 1-nd argument : the url string -+ DString url; -+ env->AssureScalarPar(0, url); -+ -+ // sanity check for controll characters -+ string::iterator it; -+ for (it = url.begin(); it < url.end(); it++) if (iscntrl(*it)) -+ { -+ Warning("PARSE_URL: URL contains a control character"); -+ break; -+ } -+ -+ // creating the output anonymous structure -+ DStructDesc* urlstru_desc = new DStructDesc("$truct"); -+ SpDString aString; -+ urlstru_desc->AddTag("SCHEME", &aString); -+ static size_t ixSCHEME = 0; -+ urlstru_desc->AddTag("USERNAME", &aString); -+ urlstru_desc->AddTag("PASSWORD", &aString); -+ urlstru_desc->AddTag("HOST", &aString); -+ urlstru_desc->AddTag("PORT", &aString); -+ static size_t ixPORT = 4; -+ urlstru_desc->AddTag("PATH", &aString); -+ urlstru_desc->AddTag("QUERY", &aString); -+ DStructGDL* urlstru = new DStructGDL(urlstru_desc, dimension()); -+ Guard urlstru_guard(urlstru); -+ -+ // parsing the URL -+ char const *str = url.c_str(); -+ size_t length = url.length(); -+ char port_buf[6]; -+ char const *s, *e, *p, *pp, *ue; -+ -+ s = str; -+ ue = s + length; -+ -+ // parsing scheme -+ if ((e = (const char*)memchr(s, ':', length)) && (e - s)) -+ { -+ // validating scheme -+ p = s; -+ while (p < e) -+ { -+ // scheme = 1*[ lowalpha | digit | "+" | "-" | "." ] -+ if (!isalpha(*p) && !isdigit(*p) && *p != '+' && *p != '.' && *p != '-') -+ { -+ if (e + 1 < ue) goto parse_port; -+ else goto just_path; -+ } -+ p++; -+ } -+ if (*(e + 1) == '\0') -+ { -+ // only scheme is available -+ urlstru->InitTag("SCHEME", DStringGDL(string(s, (e - s)))); -+ goto end; -+ } -+ // schemas without '/' (like mailto: and zlib:) -+ if (*(e+1) != '/') -+ { -+ // check if the data we get is a port this allows us to correctly parse things like a.com:80 -+ p = e + 1; -+ while (isdigit(*p)) p++; -+ if ((*p == '\0' || *p == '/') && (p - e) < 7) goto parse_port; -+ urlstru->InitTag("SCHEME", DStringGDL(string(s, (e - s)))); -+ length -= ++e - s; -+ s = e; -+ goto just_path; -+ } -+ else -+ { -+ urlstru->InitTag("SCHEME", DStringGDL(string(s, (e - s)))); -+ if (*(e+2) == '/') -+ { -+ s = e + 3; -+ if (!strncasecmp("file", -+ (*static_cast(urlstru->GetTag(ixSCHEME)))[0].c_str(), -+ sizeof("file") -+ )) -+ { -+ if (*(e + 3) == '/') -+ { -+ // support windows drive letters as in: file:///c:/somedir/file.txt -+ if (*(e + 5) == ':') s = e + 4; -+ goto nohost; -+ } -+ } -+ } -+ else -+ { -+ if (!strncasecmp("file", -+ (*static_cast(urlstru->GetTag(ixSCHEME)))[0].c_str(), -+ sizeof("file")) -+ ) -+ { -+ s = e + 1; -+ goto nohost; -+ } -+ else -+ { -+ length -= ++e - s; -+ s = e; -+ goto just_path; -+ } -+ } -+ } -+ } -+ else if (e) -+ { -+ // no scheme, look for port -+ parse_port: -+ p = e + 1; -+ pp = p; -+ while (pp-p < 6 && isdigit(*pp)) pp++; -+ if (pp-p < 6 && (*pp == '/' || *pp == '\0')) -+ { -+ memcpy(port_buf, p, (pp-p)); -+ port_buf[pp-p] = '\0'; -+ urlstru->InitTag("PORT", DStringGDL(port_buf)); -+ } -+ else goto just_path; -+ } -+ else -+ { -+ just_path: -+ ue = s + length; -+ goto nohost; -+ } -+ e = ue; -+ if (!(p = (const char*)memchr(s, '/', (ue - s)))) -+ { -+ if ((p = (const char*)memchr(s, '?', (ue - s)))) e = p; -+ else if ((p = (const char*)memchr(s, '#', (ue - s)))) e = p; -+ } -+ else e = p; -+ // check for login and password -+ { -+ size_t pos; -+ if ((pos = string(s, e - s).find_last_of("@")) != string::npos) -+ { -+ p = s + pos; -+ if ((pp = (const char*)memchr(s, ':', (p-s)))) -+ { -+ if ((pp-s) > 0) urlstru->InitTag("USERNAME", DStringGDL(string(s, (pp - s)))); -+ pp++; -+ if (p-pp > 0) urlstru->InitTag("PASSWORD", DStringGDL(string(pp, (p - pp)))); -+ } -+ else urlstru->InitTag("USERNAME", DStringGDL(string(s, (p - s)))); -+ s = p + 1; -+ } -+ } -+ // check for port -+ if (*s == '[' && *(e-1) == ']') p = s; // IPv6 embedded address -+ else for(p = e; *p != ':' && p >= s; p--); // memrchr is a GNU extension -+ if (p >= s && *p == ':') -+ { -+ if ((*static_cast(urlstru->GetTag(ixPORT)))[0].length() == 0) -+ { -+ p++; -+ if (e-p > 5) env->Throw("port cannot be longer then 5 characters"); -+ else if (e - p > 0) -+ { -+ memcpy(port_buf, p, (e-p)); -+ port_buf[e-p] = '\0'; -+ urlstru->InitTag("PORT", DStringGDL(port_buf)); -+ } -+ p--; -+ } -+ } -+ else p = e; -+ // check if we have a valid host, if we don't reject the string as url -+ if ((p-s) < 1) env->Throw("invalid host"); -+ urlstru->InitTag("HOST", DStringGDL(string(s, (p - s)))); -+ if (e == ue) goto end; -+ s = e; -+ nohost: -+ if ((p = (const char*)memchr(s, '?', (ue - s)))) -+ { -+ pp = strchr(s, '#'); -+ if (pp && pp < p) -+ { -+ p = pp; -+ pp = strchr(pp+2, '#'); -+ } -+ if (p - s) urlstru->InitTag("PATH", DStringGDL(string(s, (p - s)))); -+ if (pp) -+ { -+ if (pp - ++p) urlstru->InitTag("QUERY", DStringGDL(string(p, (pp - p)))); -+ p = pp; -+ goto label_parse; -+ } -+ else if (++p - ue) urlstru->InitTag("QUERY", DStringGDL(string(p, (ue - p)))); -+ } -+ else if ((p = (const char*)memchr(s, '#', (ue - s)))) -+ { -+ if (p - s) urlstru->InitTag("PATH", DStringGDL(string(s, (p - s)))); -+ label_parse: -+ p++; -+ if (ue - p) Warning("PARSE_URL: URL fragment left out: #" + string(p, (ue-p))); -+ } -+ else urlstru->InitTag("PATH", DStringGDL(string(s, (ue - s)))); -+ end: -+ -+ // returning the result -+ urlstru_guard.release(); -+ return urlstru; -+ } -+ -+ BaseGDL* locale_get(EnvT* e) -+ { -+#ifdef HAVE_LOCALE_H -+ -+ // make GDL inherit the calling process locale -+ setlocale(LC_ALL, ""); -+ // note doen the inherited locale -+ DStringGDL *locale = new DStringGDL(setlocale(LC_CTYPE, NULL)); -+ // return to the C locale -+ setlocale(LC_ALL, "C"); -+ -+ return locale; -+#else -+ e->Throw("OS does not provide locale information"); -+#endif -+ } -+ -+ // SA: relies on the contents of the lib::command_line_args vector -+ // defined and filled with data (pointers) in gdl.cpp -+ BaseGDL* command_line_args_fun(EnvT* e) -+ { -+#ifdef PYTHON_MODULE -+ e->Throw("no command line arguments available (GDL built as a Python module)"); -+#else -+ static int countIx = e->KeywordIx("COUNT"); -+ extern std::vector command_line_args; -+ -+ // setting the COUNT keyword value -+ if (e->KeywordPresent(countIx)) -+ { -+ e->AssureGlobalKW(countIx); -+ e->SetKW(countIx, new DLongGDL(command_line_args.size())); -+ } -+ -+ // returning empty string or an array of arguments -+ if (command_line_args.empty()) return new DStringGDL(""); -+ else -+ { -+ BaseGDL* ret = new DStringGDL(dimension(command_line_args.size())); -+ for (size_t i = 0; i < command_line_args.size(); i++) -+ (*static_cast(ret))[i] = command_line_args[i]; -+ return ret; -+ } -+#endif -+ } -+ -+ // SA: relies in the uname() from libc (must be there if POSIX) -+ BaseGDL* get_login_info( EnvT* e) -+ { -+ // getting the info -+#ifdef _MSC_VER -+ #define MAX_TCHAR_BUF 256 -+ -+ char login[MAX_TCHAR_BUF]; -+ char info[MAX_TCHAR_BUF]; -+ -+ DWORD N_TCHAR = MAX_TCHAR_BUF; -+ -+ #ifdef _UNICODE -+ TCHAR t_buf[MAX_TCHAR_BUF]; -+ GetUserName(t_buf, &N_TCHAR); -+ WideCharToMultiByte(CP_ACP, 0, t_buf, N_TCHAR, login, N_TCHAR, NULL, NULL); -+ GetComputerName( t_buf, &N_TCHAR ); -+ WideCharToMultiByte(CP_ACP, 0, t_buf, N_TCHAR, info, N_TCHAR, NULL, NULL); -+ #else -+ GetUserName(login, &N_TCHAR); -+ GetComputerName(info, &N_TCHAR); -+ #endif -+#else -+ char* login = getlogin(); -+ if (login == NULL) e->Throw("Failed to get user name from the OS"); -+ struct utsname info; -+ if (0 != uname(&info)) e->Throw("Failed to get machine name from the OS"); -+#endif -+ // creating the output anonymous structure -+ DStructDesc* stru_desc = new DStructDesc("$truct"); -+ SpDString aString; -+ stru_desc->AddTag("MACHINE_NAME", &aString); -+ stru_desc->AddTag("USER_NAME", &aString); -+ DStructGDL* stru = new DStructGDL(stru_desc, dimension()); -+ -+ // returning the info -+ stru->InitTag("USER_NAME", DStringGDL(login)); -+#ifdef _MSC_VER -+ stru->InitTag("MACHINE_NAME", DStringGDL(info)); -+#else -+ stru->InitTag("MACHINE_NAME", DStringGDL(info.nodename)); -+#endif -+ return stru; -+ } -+ -+ // SA: base64 logic in base64.hpp, based on code by Bob Withers (consult base64.hpp) -+ BaseGDL* idl_base64(EnvT* e) -+ { -+ BaseGDL* p0 = e->GetPar(0); -+ if (p0 != NULL) -+ { -+ if (p0->Rank() == 0 && p0->Type() == GDL_STRING) -+ { -+ // decoding -+ string* str = &((*static_cast(p0))[0]); -+ if (str->length() == 0) return new DByteGDL(0); -+ if (str->length() % 4 != 0) -+ e->Throw("Input string length must be a multiple of 4"); -+ unsigned int retlen = base64::decodeSize(*str); -+ if (retlen == 0 || retlen > str->length()) e->Throw("No data in the input string"); -+ DByteGDL* ret = new DByteGDL(dimension(retlen)); -+ if (!base64::decode(*str, (char*)&((*ret)[0]), ret->N_Elements())) -+ e->Throw("Base64 decoder failed"); -+ return ret; -+ } -+ if (p0->Rank() >= 1 && p0->Type() == GDL_BYTE) -+ { -+ // encoding -+ return new DStringGDL( -+ base64::encode((char*)&(*static_cast(p0))[0], p0->N_Elements()) -+ ); -+ } -+ } -+ e->Throw("Expecting string or byte array as a first parameter"); -+ } -+ -+ BaseGDL* get_drive_list(EnvT* e) -+ { -+ if (e->KeywordPresent(0)) e->SetKW(0, new DLongGDL(0)); -+ return new DStringGDL(""); -+ } -+ -+ // note: changes here MUST be reflected in scope_varfetch_reference() as well -+ // because DLibFun of this function is used for scope_varfetch_reference() the keyword -+ // indices must match -+ BaseGDL* scope_varfetch_value( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ -+ EnvStackT& callStack = e->Interpreter()->CallStack(); -+// DLong curlevnum = callStack.size()-1; -+// 'e' is not on the stack -+ DLong curlevnum = callStack.size(); -+ -+// static int variablesIx = e->KeywordIx( "VARIABLES" ); -+ static int levelIx = e->KeywordIx( "LEVEL" ); -+ -+ DLongGDL* level = e->IfDefGetKWAs( levelIx); -+ -+ DLong desiredlevnum = 0; -+ -+ if (level != NULL) -+ desiredlevnum = (*level)[0]; -+ -+ if (desiredlevnum <= 0) desiredlevnum += curlevnum; -+ if (desiredlevnum < 1) desiredlevnum = 1; -+ else if (desiredlevnum > curlevnum) desiredlevnum = curlevnum; -+ -+ DSubUD* pro = static_cast(callStack[desiredlevnum-1]->GetPro()); -+ -+ SizeT nVar = pro->Size(); // # var in GDL for desired level -+ int nKey = pro->NKey(); -+ -+ DString varName; -+ -+ e->AssureScalarPar( 0, varName); -+ varName = StrUpCase( varName); -+ -+ int xI = pro->FindVar( varName); -+ if (xI != -1) -+ { -+// BaseGDL*& par = ((EnvT*)(callStack[desiredlevnum-1]))->GetPar( xI); -+ BaseGDL*& par = callStack[desiredlevnum-1]->GetKW( xI); -+ -+ if( par == NULL) -+ e->Throw( "Variable is undefined: " + varName); -+ -+ return par->Dup(); -+ } -+ -+ e->Throw( "Variable not found: " + varName); -+ return new DLongGDL(0); // compiler shut-up -+ } -+ -+ // this routine is special, only called as an l-function (from FCALL_LIB::LEval()) -+ // it MUST use an EnvT set up for scope_varfetch_value -+ BaseGDL** scope_varfetch_reference( EnvT* e) -+ { -+ SizeT nParam=e->NParam(); -+ -+ EnvStackT& callStack = e->Interpreter()->CallStack(); -+// DLong curlevnum = callStack.size()-1; -+// 'e' is not on the stack -+ DLong curlevnum = callStack.size(); -+ -+// static int variablesIx = e->KeywordIx( "VARIABLES" ); -+ static int levelIx = e->KeywordIx( "LEVEL" ); -+ -+ DLongGDL* level = e->IfDefGetKWAs( levelIx); -+ -+ DLong desiredlevnum = 0; -+ -+ if (level != NULL) -+ desiredlevnum = (*level)[0]; -+ -+ if (desiredlevnum <= 0) desiredlevnum += curlevnum; -+ if (desiredlevnum < 1) desiredlevnum = 1; -+ else if (desiredlevnum > curlevnum) desiredlevnum = curlevnum; -+ -+ DSubUD* pro = static_cast(callStack[desiredlevnum-1]->GetPro()); -+ -+ SizeT nVar = pro->Size(); // # var in GDL for desired level -+ int nKey = pro->NKey(); -+ -+ DString varName; -+ -+ e->AssureScalarPar( 0, varName); -+ varName = StrUpCase( varName); -+ int xI = pro->FindVar( varName); -+ if (xI != -1) -+ { -+// BaseGDL*& par = ((EnvT*)(callStack[desiredlevnum-1]))->GetPar( xI); -+ BaseGDL*& par = callStack[desiredlevnum-1]->GetKW( xI); -+ -+// if( par == NULL) -+// e->Throw( "Variable is undefined: " + varName); -+ -+ return ∥ -+ } -+ -+ e->Throw( "LVariable not found: " + varName); -+ return NULL; // compiler shut-up -+ } -+ -+ -+} // namespace -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_fun.hpp gdl/src/basic_fun.hpp ---- gdl-0.9.3/src/basic_fun.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_fun.hpp 2013-07-31 09:41:43.700246531 -0600 -@@ -121,7 +121,7 @@ - - BaseGDL* strjoin( EnvT* e); - -- BaseGDL* convol( EnvT* e); -+ // BaseGDL* convol( EnvT* e); - - BaseGDL* rebin_fun( EnvT* e); - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_fun_jmg.cpp gdl/src/basic_fun_jmg.cpp ---- gdl-0.9.3/src/basic_fun_jmg.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_fun_jmg.cpp 2013-07-31 09:41:43.706246510 -0600 -@@ -38,9 +38,19 @@ - - using namespace std; - using namespace antlr; -- -+ -+ - BaseGDL* size( EnvT* e) - { -+ static int L64Ix = e->KeywordIx( "L64"); -+ static int dimIx = e->KeywordIx( "DIMENSIONS"); -+ static int FILE_LUNIx = e->KeywordIx( "FILE_LUN"); -+ static int N_DIMENSIONSIx = e->KeywordIx( "N_DIMENSIONS"); -+ static int N_ELEMENTSIx = e->KeywordIx( "N_ELEMENTS"); -+ static int STRUCTUREIx = e->KeywordIx( "STRUCTURE"); -+ static int TNAMEIx = e->KeywordIx( "TNAME"); -+ static int TYPEIx = e->KeywordIx( "TYPE"); -+ - e->NParam( 1); // might be GDL_UNDEF, but must be given - - // BaseGDL* p0 = e->GetParDefined( 0); //, "SIZE"); -@@ -57,18 +67,16 @@ - } - - // DIMENSIONS -- static int dimIx = e->KeywordIx( "DIMENSIONS"); -- - if( e->KeywordSet( dimIx)) { - if( Rank == 0) -- if( e->KeywordSet(0)) -+ if( e->KeywordSet(L64Ix)) - return new DLong64GDL( 0); - else - return new DLongGDL( 0); - - dimension dim( Rank); - -- if( e->KeywordSet(0)) { // L64 -+ if( e->KeywordSet(L64Ix)) { // L64 - DLong64GDL* res = new DLong64GDL( dim, BaseGDL::NOZERO); - (*res)[0] = 0; - for( SizeT i=0; iDim(i); -@@ -81,17 +89,17 @@ - } - - // FILE_LUN -- } else if( e->KeywordSet(2)) { -+ } else if( e->KeywordSet(FILE_LUNIx)) { - - e->Throw( "FILE_LUN not supported yet."); - - // N_DIMENSIONS -- } else if( e->KeywordSet(3)) { -+ } else if( e->KeywordSet(N_DIMENSIONSIx)) { - - return new DLongGDL( Rank); - - //N_ELEMENTS -- } else if( e->KeywordSet(4)) { -+ } else if( e->KeywordSet(N_ELEMENTSIx)) { - - if( e->KeywordSet(0)) - return new DULongGDL( nEl); -@@ -99,7 +107,7 @@ - return new DLongGDL( nEl); - - // STRUCTURE -- } else if( e->KeywordSet(5)) { -+ } else if( e->KeywordSet(STRUCTUREIx)) { - - - DStructGDL* res = new DStructGDL( "IDL_SIZE"); -@@ -141,7 +149,7 @@ - //e->Throw( "STRUCTURE not supported yet."); - - // TNAME -- } else if( e->KeywordSet(6)) { -+ } else if( e->KeywordSet(TNAMEIx)) { - - if( p0 == NULL) - return new DStringGDL( "UNDEFINED"); -@@ -149,7 +157,7 @@ - return new DStringGDL( p0->TypeStr()); - - // TYPE -- } else if( e->KeywordSet(7)) { -+ } else if( e->KeywordSet(TYPEIx)) { - - return new DLongGDL( vType ); - -@@ -157,7 +165,7 @@ - - dimension dim( 3 + Rank); - -- if( e->KeywordSet(0)) { -+ if( e->KeywordSet(L64Ix)) { - DLong64GDL* res = new DLong64GDL( dim, BaseGDL::NOZERO); - (*res)[ 0] = Rank; - for( SizeT i=0; iDim(i); -@@ -329,7 +337,7 @@ - e->AssureLongScalarKWIfPresent( typeIx, type); - - DLongGDL* dimKey=NULL; -- auto_ptr dimKey_guard; -+ Guard dimKey_guard; - - static int sizeix = e->KeywordIx( "SIZE"); - static int dimensionix = e->KeywordIx( "DIMENSION"); -@@ -344,7 +352,7 @@ - { - dimension dim(l_dimension->N_Elements(),1); - dimKey=new DLongGDL(dim, BaseGDL::NOZERO); -- dimKey_guard.reset( dimKey); //e->Guard( dimKey); -+ dimKey_guard.Reset( dimKey); //e->Guard( dimKey); - for (int i=0;iN_Elements();++i) - (*dimKey)[i]=(*l_dimension)[i]; - } -@@ -361,7 +369,7 @@ - { - dimension dim((*l_size)[0],1); - dimKey=new DLongGDL(dim, BaseGDL::NOZERO); -- dimKey_guard.reset( dimKey); //e->Guard( dimKey); -+ dimKey_guard.Reset( dimKey); //e->Guard( dimKey); - // e->Guard( dimKey); - for (int i=1;i<=(*l_size)[0];++i) - (*dimKey)[i-1]=(*l_size)[i]; -@@ -387,7 +395,7 @@ - - static int valueix = e->KeywordIx( "VALUE"); - BaseGDL* value = e->GetKW( valueix); -- auto_ptr value_guard; -+ Guard value_guard; - if( value != NULL) - { - if( !value->Scalar()) -@@ -398,7 +406,7 @@ - else - { - value = value->Convert2( static_cast(type), BaseGDL::COPY); -- value_guard.reset(value);//e->Guard( value); -+ value_guard.Reset(value);//e->Guard( value); - } - } - -@@ -650,7 +658,7 @@ - DLong curlevnum = callStack.size(); - - if (e->KeywordSet( "S_FUNCTIONS")) { -- deque subList; -+ vector subList; - - SizeT nFun = libFunList.size(); - for( SizeT i = 0; iKeywordSet( "S_PROCEDURES")) { -- deque subList; -+ vector subList; - - SizeT nPro = libProList.size(); - for( SizeT i = 0; i pfList; -+ vector pfList; - pfList.push_back("$MAIN$"); - - // Procedures -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_op_add.cpp gdl/src/basic_op_add.cpp ---- gdl-0.9.3/src/basic_op_add.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/basic_op_add.cpp 2013-07-31 09:41:43.724246447 -0600 -@@ -0,0 +1,423 @@ -+/*************************************************************************** -+ basic_op_add.cpp - GDL add (+) operators -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002 by Marc Schellens -+ email : m_schellens@users.sf.net -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+// to be included from datatypes.cpp -+#ifdef INCLUDE_BASIC_OP_CPP -+ -+// // header in datatypes.hpp -+// -+// //#include "datatypes.hpp" -+// //#include "dstructgdl.hpp" -+// //#include "arrayindex.hpp" -+// -+// //#include -+// #include "sigfpehandler.hpp" -+// -+// #ifdef _OPENMP -+// #include -+// #endif -+// -+// #include "typetraits.hpp" -+// -+// using namespace std; -+ -+ -+// ************************ -+// Add -+// ************************ -+ -+// also see Add...New operators (in basic_op_new.cpp) -+ -+// Adds right to itself, //C deletes right -+// right must always have more or same number of elements -+template -+BaseGDL* Data_::Add( BaseGDL* r) -+{ -+ -+ -+ Data_* right=static_cast(r); -+ -+ // ULong rEl=right->N_Elements(); -+ ULong nEl=N_Elements(); -+ // assert( rEl); -+ assert( nEl); -+ if( nEl == 1) -+ { -+ (*this)[0] += (*right)[0]; -+ return this; -+ } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ mThis += mRight; -+ return this; -+#else -+ -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] += (*right)[i]; -+ } //C delete right; -+ return this; -+#endif -+ -+} -+template -+BaseGDL* Data_::AddInv( BaseGDL* r) -+{ -+ assert( this->Type() != GDL_OBJ); // should never be called via this -+ return Add( r); // this needs to be modified -+} -+template<> -+BaseGDL* Data_::AddInv( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ // ULong rEl=right->N_Elements(); -+ ULong nEl=N_Elements(); -+ // assert( rEl); -+ assert( nEl); -+ if( nEl == 1) -+ { -+ (*this)[0] = (*right)[0] + (*this)[0]; -+ return this; -+ } -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] = (*right)[i] + (*this)[i]; -+ } //C delete right; -+ return this; -+} -+// invalid types -+template<> -+BaseGDL* Data_::Add( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+BaseGDL* Data_::Add( BaseGDL* r) -+{ -+ // overload here -+ Data_* self; -+ DSubUD* plusOverload; -+ -+ ProgNodeP callingNode = interpreter->GetRetTree(); -+ -+ if( !Scalar()) -+ { -+ if( r->Type() == GDL_OBJ && r->Scalar()) -+ { -+ self = static_cast( r); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -+ if( plusOverload == NULL) -+ { -+ throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -+ } -+ } -+ else -+ { -+ throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -+ } -+ } -+ else -+ { -+ // Scalar() -+ self = static_cast( this); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -+ if( plusOverload == NULL) -+ { -+ if( r->Type() == GDL_OBJ && r->Scalar()) -+ { -+ self = static_cast( r); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -+ if( plusOverload == NULL) -+ { -+ throw GDLException(callingNode,"Cannot apply not overloaded operator to datatype OBJECT.",true, false); -+ } -+ } -+ else -+ { -+ throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -+ } -+ } -+ } -+ -+ assert( self->Scalar()); -+ assert( plusOverload != NULL); -+ -+ // hidden SELF is counted as well -+ int nParSub = plusOverload->NPar(); -+ assert( nParSub >= 1); // SELF -+ if( nParSub < 3) // (SELF), LEFT, RIGHT -+ { -+ throw GDLException( callingNode, plusOverload->ObjectName() + -+ ": Incorrect number of arguments.", -+ false, false); -+ } -+ EnvUDT* newEnv; -+ Guard selfGuard; -+ BaseGDL* thisP; -+ // Dup() here is not optimal -+ // avoid at least for internal overload routines (which do/must not change SELF or r) -+ bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -+ if( internalDSubUD) -+ { -+ thisP = this; -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -+ newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -+ } -+ else -+ { -+ self = self->Dup(); -+ selfGuard.Init( self); -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -+ newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -+ } -+ -+ -+ // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -+ StackGuard guard(interpreter->CallStack()); -+ -+ interpreter->CallStack().push_back( newEnv); -+ -+ // make the call -+ BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -+ -+ if( !internalDSubUD && self != selfGuard.Get()) -+ { -+ // always put out warning first, in case of a later crash -+ Warning( "WARNING: " + plusOverload->ObjectName() + -+ ": Assignment to SELF detected (GDL session still ok)."); -+ // assignment to SELF -> self was deleted and points to new variable -+ // which it owns -+ selfGuard.Release(); -+ if( static_cast(self) != NullGDL::GetSingleInstance()) -+ selfGuard.Reset(self); -+ } -+ return res; -+} -+// difference from above: Order of parameters in call -+template<> -+BaseGDL* Data_::AddInv( BaseGDL* r) -+{ -+ if( r->Type() == GDL_OBJ && r->Scalar()) -+ { -+ return r->Add( this); // for right order of parameters -+ } -+ -+ // overload here -+ Data_* self; -+ DSubUD* plusOverload; -+ -+ ProgNodeP callingNode = interpreter->GetRetTree(); -+ -+ if( !Scalar()) -+ { -+ throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -+ } -+ else -+ { -+ // Scalar() -+ self = static_cast( this); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -+ if( plusOverload == NULL) -+ { -+ throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -+ } -+ } -+ -+ assert( self->Scalar()); -+ assert( plusOverload != NULL); -+ -+ // hidden SELF is counted as well -+ int nParSub = plusOverload->NPar(); -+ assert( nParSub >= 1); // SELF -+ if( nParSub < 3) // (SELF), LEFT, RIGHT -+ { -+ throw GDLException( callingNode, plusOverload->ObjectName() + -+ ": Incorrect number of arguments.", -+ false, false); -+ } -+ EnvUDT* newEnv; -+ Guard selfGuard; -+ BaseGDL* thisP; -+ // Dup() here is not optimal -+ // avoid at least for internal overload routines (which do/must not change SELF or r) -+ bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -+ if( internalDSubUD) -+ { -+ thisP = this; -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ // order different to Add -+ newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -+ newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -+ } -+ else -+ { -+ self = self->Dup(); -+ selfGuard.Init( self); -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ // order different to Add -+ newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -+ newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -+ } -+ -+ -+ // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -+ StackGuard guard(interpreter->CallStack()); -+ -+ interpreter->CallStack().push_back( newEnv); -+ -+ // make the call -+ BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -+ -+ if( !internalDSubUD && self != selfGuard.Get()) -+ { -+ // always put out warning first, in case of a later crash -+ Warning( "WARNING: " + plusOverload->ObjectName() + -+ ": Assignment to SELF detected (GDL session still ok)."); -+ // assignment to SELF -> self was deleted and points to new variable -+ // which it owns -+ selfGuard.Release(); -+ if( static_cast(self) != NullGDL::GetSingleInstance()) -+ selfGuard.Reset(self); -+ } -+ return res; -+} -+ -+template -+BaseGDL* Data_::AddS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ if( nEl == 1) -+ { -+ (*this)[0] += (*right)[0]; -+ return this; -+ } -+ Ty s = (*right)[0]; -+ // right->Scalar(s); -+ // dd += s; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ mThis += s; -+ return this; -+#else -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] += s; -+ } //C delete right; -+ return this; -+#endif -+ -+} -+template<> -+BaseGDL* Data_::AddS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ if( nEl == 1) -+ { -+ (*this)[0] += (*right)[0]; -+ return this; -+ } -+ Ty s = (*right)[0]; -+ // right->Scalar(s); -+ // dd += s; -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] += s; -+ } //C delete right; -+ return this; -+} -+ -+template -+BaseGDL* Data_::AddInvS( BaseGDL* r) -+{ -+ return AddS( r); -+} -+template<> -+BaseGDL* Data_::AddInvS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ if( nEl == 1) -+ { -+ (*this)[0] = (*right)[0] + (*this)[0] ; -+ return this; -+ } -+ Ty s = (*right)[0]; -+ // right->Scalar(s); -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] = s + (*this)[i]; -+ } //C delete right; -+ return this; -+ -+} -+ -+// invalid types -+template<> -+BaseGDL* Data_::AddS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+BaseGDL* Data_::AddS( BaseGDL* r) -+{ -+ return Add( r); -+} -+template<> -+BaseGDL* Data_::AddInvS( BaseGDL* r) -+{ -+ return AddInv( r); -+} -+ -+ -+//#include "instantiate_templates.hpp" -+ -+#endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_op.cpp gdl/src/basic_op.cpp ---- gdl-0.9.3/src/basic_op.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_op.cpp 2013-07-31 09:41:43.722246454 -0600 -@@ -31,11 +31,20 @@ - #include - #endif - --#include "strassenmatrix.hpp" -+// #include "strassenmatrix.hpp" - #include "typetraits.hpp" - - using namespace std; - -+#if defined(USE_EIGEN) -+using namespace Eigen; -+#endif -+ -+#include "basic_op_add.cpp" -+#include "basic_op_sub.cpp" -+#include "basic_op_mult.cpp" -+#include "basic_op_div.cpp" -+ - // Not operation - // for integers - template -@@ -53,11 +62,12 @@ - // if( !nEl) throw GDLException("Variable is undefined."); - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] = ~(*this)[i]; -- } return this; -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] = ~(*this)[i]; -+ } -+ return this; - } - // others - template<> -@@ -76,7 +86,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = ((*this)[i] == 0.0f)? 1.0f : 0.0f; - } return this; - } -@@ -95,14 +105,14 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = ((*this)[i] == 0.0)? 1.0 : 0.0; - } return this; - } - template<> - Data_* Data_::NotOp() - { -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> -@@ -117,21 +127,16 @@ - throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } --DStructGDL* DStructGDL::NotOp() --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::NotOp() - { -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> - Data_* Data_::NotOp() - { -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - -@@ -153,7 +158,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = -(*this)[i]; - } return this; - } -@@ -167,11 +172,6 @@ - // this is deleted by convert2!!! - return static_cast( newThis->UMinus()); - } --BaseGDL* DStructGDL::UMinus() --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - BaseGDL* Data_::UMinus() - { -@@ -205,7 +205,41 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) -+ (*res)[i] = ((*this)[i] == 0)? 1 : 0; -+ } return res; -+} -+template<> -+Data_* Data_::LogNeg() -+{ -+ if( this->Scalar()) -+ { -+ DSubUD* isTrueOverload = static_cast(GDLInterpreter::GetObjHeapOperator( dd[0], OOIsTrue)); -+ if( isTrueOverload != NULL) -+ { -+ if( this->LogTrue()) -+ return new Data_( 0); -+ else -+ return new Data_( 1); -+ } -+ } -+ -+ SizeT nEl = dd.size(); -+ assert( nEl); -+ // if( nEl == 0) throw GDLException("Variable is undefined."); -+ DByteGDL* res = new Data_( this->dim, BaseGDL::NOZERO); -+ -+ if( nEl == 1) -+ { -+ (*res)[0] = ((*this)[0] == 0)? 1 : 0; -+ return res; -+ } -+ -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] == 0)? 1 : 0; - } return res; - } -@@ -226,7 +260,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] == 0.0f)? 1 : 0; - } return res; - } -@@ -247,7 +281,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] == 0.0)? 1 : 0; - } return res; - } -@@ -267,7 +301,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] == "")? 1 : 0; - } return res; - } -@@ -287,7 +321,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i].real() == 0.0 && (*this)[i].imag() == 0.0)? 1 : 0; - } return res; - } -@@ -307,7 +341,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i].real() == 0.0 && (*this)[i].imag() == 0.0)? 1 : 0; - } return res; - } -@@ -329,7 +363,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i]--; - }} - template -@@ -347,7 +381,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i]++; - }} - // float -@@ -367,7 +401,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] -= 1.0; - }} - template<> -@@ -386,7 +420,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] += 1.0; - }} - // double -@@ -406,7 +440,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] -= 1.0; - }} - template<> -@@ -425,7 +459,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] += 1.0; - }} - // complex -@@ -445,7 +479,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] -= 1.0; - }} - template<> -@@ -464,7 +498,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] += 1.0; - }} - template<> -@@ -483,7 +517,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] -= 1.0; - }} - template<> -@@ -502,7 +536,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] += 1.0; - }} - // forbidden types -@@ -571,7 +605,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] == s); - } } - else if( StrictScalar(s)) -@@ -586,7 +620,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] == s); - } } - else if( rEl < nEl) -@@ -596,7 +630,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] == (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -611,7 +645,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] == (*this)[i]); - } } - //C delete right; -@@ -632,7 +666,7 @@ - // - // DFun* EQOverload = static_cast(desc->GetOperator( OOEQ)); - // -- DFun* EQOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*this)[0], OOEQ)); -+ DSubUD* EQOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*this)[0], OOEQ)); - if( EQOverload != NULL) - { - ProgNodeP callingNode = interpreter->GetRetTree(); -@@ -646,7 +680,7 @@ - false, false); - } - EnvUDT* newEnv; -- BaseGDL* self; -+ DObjGDL* self; - Guard selfGuard; - // Dup() here is not optimal - // avoid at least for internal overload routines (which do/must not change SELF or r) -@@ -655,7 +689,7 @@ - { - self = this; - newEnv= new EnvUDT( callingNode, EQOverload, &self); -- newEnv->SetNextParUnchecked( &self); // LEFT parameter -+ newEnv->SetNextParUnchecked( (BaseGDL**) &self); // LEFT parameter - newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv - } - else -@@ -684,7 +718,7 @@ - // assignment to SELF -> self was deleted and points to new variable - // which it owns - selfGuard.Release(); -- if( self != NullGDL::GetSingleInstance()) -+ if( static_cast(self) != NullGDL::GetSingleInstance()) - selfGuard.Reset(self); - } - -@@ -726,7 +760,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] == s); - } } - else if( StrictScalar(s)) -@@ -741,7 +775,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] == s); - } } - else if( rEl < nEl) -@@ -751,7 +785,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] == (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -766,7 +800,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] == (*this)[i]); - } } - //C delete right; -@@ -774,11 +808,6 @@ - return res; - } - // invalid types --BaseGDL* DStructGDL::EqOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - // template<> - // Data_* Data_::EqOp( BaseGDL* r) - // { -@@ -821,7 +850,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] != s); - } } - else if( StrictScalar(s)) -@@ -836,7 +865,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] != s); - } } - else if( rEl < nEl) -@@ -846,7 +875,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] != (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -861,7 +890,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] != (*this)[i]); - } } - //C delete right; -@@ -883,7 +912,8 @@ - // - // DFun* NEOverload = static_cast(desc->GetOperator( OONE)); - // -- DFun* NEOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*this)[0], OONE)); -+ DSubUD* NEOverload = -+ static_cast(GDLInterpreter::GetObjHeapOperator( (*this)[0], OONE)); - if( NEOverload != NULL) - { - ProgNodeP callingNode = interpreter->GetRetTree(); -@@ -897,7 +927,7 @@ - false, false); - } - EnvUDT* newEnv; -- BaseGDL* self; -+ DObjGDL* self; - Guard selfGuard; - // Dup() here is not optimal - // avoid at least for internal overload routines (which do/must not change SELF or r) -@@ -906,7 +936,7 @@ - { - self = this; - newEnv= new EnvUDT( callingNode, NEOverload, &self); -- newEnv->SetNextParUnchecked( &self); // LEFT parameter -+ newEnv->SetNextParUnchecked( (BaseGDL**)&self); // LEFT parameter - newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv - } - else -@@ -935,7 +965,7 @@ - // assignment to SELF -> self was deleted and points to new variable - // which it owns - selfGuard.Release(); -- if( self != NullGDL::GetSingleInstance()) -+ if( static_cast( self) != NullGDL::GetSingleInstance()) - selfGuard.Reset(self); - } - -@@ -948,7 +978,7 @@ - // here r can be of any GDL type (due to operator overloading) - if( r->Type() != GDL_OBJ) - { -- throw GDLException("Unable to convert variable to type object reference.",true,false); -+ throw GDLException("Unable to convert variable to type object reference.",true,false); - } - - // same code as for other types from here -@@ -976,7 +1006,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] != s); - } } - else if( StrictScalar(s)) -@@ -991,7 +1021,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] != s); - } } - else if( rEl < nEl) -@@ -1001,7 +1031,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] != (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -1016,7 +1046,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] != (*this)[i]); - } } - //C delete right; -@@ -1025,11 +1055,6 @@ - } - - // invalid types --BaseGDL* DStructGDL::NeOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - // template<> - // Data_* Data_::NeOp( BaseGDL* r) - // { -@@ -1071,7 +1096,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] <= s); - } } - else if( StrictScalar(s)) -@@ -1086,7 +1111,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] >= s); - } } - else if( rEl < nEl) -@@ -1096,7 +1121,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] >= (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -1111,7 +1136,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] >= (*this)[i]); - } } - //C delete right; -@@ -1119,11 +1144,6 @@ - return res; - } - // invalid types --BaseGDL* DStructGDL::LeOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::LeOp( BaseGDL* r) - { -@@ -1177,7 +1197,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] < s); - } } - else if( StrictScalar(s)) -@@ -1192,7 +1212,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] > s); - } } - else if( rEl < nEl) -@@ -1202,7 +1222,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] > (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -1217,7 +1237,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] > (*this)[i]); - } } - //C delete right; -@@ -1225,11 +1245,6 @@ - return res; - } - // invalid types --BaseGDL* DStructGDL::LtOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::LtOp( BaseGDL* r) - { -@@ -1283,7 +1298,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] >= s); - } } - else if( StrictScalar(s)) -@@ -1298,7 +1313,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] <= s); - } } - else if( rEl < nEl) -@@ -1308,7 +1323,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] <= (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -1323,7 +1338,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] <= (*this)[i]); - } } - //C delete right; -@@ -1331,11 +1346,6 @@ - return res; - } - // invalid types --BaseGDL* DStructGDL::GeOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::GeOp( BaseGDL* r) - { -@@ -1389,7 +1399,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*this)[i] > s); - } } - else if( StrictScalar(s)) -@@ -1404,7 +1414,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] < s); - } } - else if( rEl < nEl) -@@ -1414,7 +1424,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] < (*this)[i]); - } } - else // ( rEl >= nEl) -@@ -1429,7 +1439,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] < (*this)[i]); - } } - //C delete right; -@@ -1437,11 +1447,6 @@ - return res; - } - // invalid types --BaseGDL* DStructGDL::GtOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::GtOp( BaseGDL* r) - { -@@ -1466,11 +1471,148 @@ - throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return NULL; - } -+ -+//#undef USE_EIGEN - // MatrixOp --// returns *this # *r, //C deletes itself and right -+// returns *this # *r, //C does not delete itself and right - template --Data_* Data_::MatrixOp( BaseGDL* r, bool transpose, bool transposeResult, bool strassen) -+Data_* Data_::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose) - { -+#ifdef USE_EIGEN -+ bool at = atranspose; -+ bool bt = btranspose; -+ -+ Data_* par1 = static_cast(r); -+ -+ long NbCol0, NbRow0, NbCol1, NbRow1;//, NbCol2, NbRow2; -+ SizeT rank0 = this->Rank(); -+ SizeT rank1 = par1->Rank(); -+ if (rank0 == 2) -+ { -+ NbCol0 = this->Dim(0); -+ NbRow0 = this->Dim(1); -+ } -+ else if (rank0 > 2) -+ { -+ throw GDLException("Array must have 1 or 2 dimensions",true,false); -+ } -+ else // rank0 0 or 1 -+ { -+ NbCol0 = this->Dim(0); -+ if( NbCol0 == 0) NbCol0=1; -+ NbRow0 = 1; -+ } -+ -+ if (rank1 == 2) -+ { -+ NbCol1 = par1->Dim(0); -+ NbRow1 = par1->Dim(1); -+ } -+ else if (rank1 > 2) -+ { -+ throw GDLException("Array must have 1 or 2 dimensions",true,false); -+ } -+ else // rank1 0 or 1 -+ { -+ NbCol1 = par1->Dim(0); -+ if( NbCol1 == 0) NbCol1=1; -+ NbRow1 = 1; -+ } -+ // NbCol0, NbRow0, NbCol1, NbRow1 are properly set now -+ -+ // vector cases (possible degeneration) -+ if( rank0 <= 1 || rank1 <=1) -+ { -+ if( rank0 <= 1 && rank1 <=1) -+ { -+ // [NbCol0,1]#[NbCol1,1] -> just transpose b (if a is not transposed) -+ if( !at) // && !bt -+ bt = true; -+ } -+ else if( rank0 <= 1) // rank1 == 2 -+ { -+ // [NbCol0,1]#[NbCol1,NbRow1] -+ if( !at && (!bt && NbCol1 != 1) || (bt && NbRow1 != 1)) -+ at = true; -+ } -+ else // if( rank1 <= 1) // rank0 == 2 -+ { -+ // [NbCol0,NbRow0]#[NbCol1,1] -+ if( !bt && (!at && NbRow0 == 1) || (at && NbCol0 == 1)) -+ bt = true; -+ } -+ } -+ -+ Map,Aligned> m0(&(*this)[0], NbCol0, NbRow0); -+ Map,Aligned> m1(&(*par1)[0], NbCol1, NbRow1); -+ -+ if (at && bt) -+ { -+ if( /*(at && bt) &&*/ (NbCol0 != NbRow1)) -+ { -+ throw GDLException("Operands of matrix multiply have incompatible dimensions.atbt",true,false); -+// e->Throw("Operands of matrix multiply have incompatible dimensions: " + e->GetParString(0) + ", " + e->GetParString(1) + "."); -+ } -+ long& NbCol2 = NbRow0 ; -+ long& NbRow2 = NbCol1 ; -+ dimension dim(NbCol2, NbRow2); -+ -+ Data_* res = new Data_(dim, BaseGDL::NOZERO); -+ // no guarding necessary: eigen only throws on memory allocation -+ -+ Map,Aligned> m2(&(*res)[0], NbCol2, NbRow2); -+ m2.noalias() = m0.transpose() * m1.transpose(); -+ return res; -+ } -+ else if (bt) -+ { -+ if( /*(!at && bt) &&*/ (NbRow0 != NbRow1)) -+ { -+ throw GDLException("Operands of matrix multiply have incompatible dimensions.bt",true,false); -+// e->Throw("Operands of matrix multiply have incompatible dimensions: " + e->GetParString(0) + ", " + e->GetParString(1) + "."); -+ } -+ long& NbCol2 = NbCol0; -+ long& NbRow2 = NbCol1; -+ dimension dim(NbCol2, NbRow2); -+ -+ Data_* res = new Data_(dim, BaseGDL::NOZERO); -+ Map,Aligned> m2(&(*res)[0], NbCol2, NbRow2); -+ m2.noalias() = m0 * m1.transpose(); -+ return res; -+ } else if (at) -+ { -+ if( /*(at && !bt) &&*/ (NbCol0 != NbCol1)) -+ { -+ throw GDLException("Operands of matrix multiply have incompatible dimensions.at",true,false); -+// e->Throw("Operands of matrix multiply have incompatible dimensions: " + e->GetParString(0) + ", " + e->GetParString(1) + "."); -+ } -+ long& NbCol2 = NbRow0; -+ long& NbRow2 = NbRow1; -+ dimension dim(NbCol2, NbRow2); -+ -+ Data_* res = new Data_(dim, BaseGDL::NOZERO); -+ Map,Aligned> m2(&(*res)[0], NbCol2, NbRow2); -+ m2.noalias() = m0.transpose() * m1; -+ return res; -+ } else -+ { -+ if( /*(!at && !bt) &&*/ (NbRow0 != NbCol1)) -+ { -+ throw GDLException("Operands of matrix multiply have incompatible dimensions._",true,false); -+// e->Throw("Operands of matrix multiply have incompatible dimensions: " + e->GetParString(0) + ", " + e->GetParString(1) + "."); -+ } -+ long& NbCol2 = NbCol0; -+ long& NbRow2 = NbRow1; -+ dimension dim(NbCol2, NbRow2); -+ -+ Data_* res = new Data_(dim, BaseGDL::NOZERO); -+ Map,Aligned> m2(&(*res)[0], NbCol2, NbRow2); -+ m2.noalias() = m0*m1; -+ return res; -+ } -+ -+#else -+ - Data_* right=static_cast(r); - - // ULong rEl=right->N_Elements(); -@@ -1478,7 +1620,7 @@ - // assert( rEl); - // assert( nEl); - // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- -+ - Data_* res; - - if( this->dim.Rank() <= 1 && right->dim.Rank() <= 1) -@@ -1503,8 +1645,8 @@ - #pragma omp parallel if (nOp >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nOp)) default(shared) - { - #pragma omp for -- for( int colA=0; colA < nCol; colA++) // res dim 0 -- for( SizeT rowB=0; rowB < nRow; rowB++) // res dim 1 -+ for( OMPInt colA=0; colA < nCol; colA++) // res dim 0 -+ for( OMPInt rowB=0; rowB < nRow; rowB++) // res dim 1 - (*res)[ rowB * nCol + colA] += (*this)[colA] * (*right)[rowB]; - } - } -@@ -1514,70 +1656,87 @@ - // [n] # [n,m] -> [1,m] ([n] -> [1,n]) - - // right op 1st -- SizeT nRow=transpose ? right->dim[0] : right->dim[1]; -+ SizeT nRow=btranspose ? right->dim[0] : right->dim[1]; - if( nRow == 0) nRow=1; - - // loop dim -- SizeT nRowEl=transpose ? right->dim[1] : right->dim[0]; -+ SizeT nRowEl=btranspose ? right->dim[1] : right->dim[0]; - if( nRowEl == 0) nRowEl=1; - - // result dim - SizeT nCol, nColEl; -- if( this->dim.Rank() <= 1) -- { -- nColEl=this->dim[0]; -- if( nColEl == 0) // scalar -- { -- nColEl=1; -- nCol =1; -- } -- else if( nRowEl == 1) -- { -- nCol = nColEl; -- nColEl = 1; -- } -- else -- { -- nCol = 1; -- } -- } -+ if( !atranspose) -+ { -+ if( this->dim.Rank() <= 1) -+ { -+ nColEl=this->dim[0]; -+ if( nColEl == 0) // scalar -+ { -+ nColEl=1; -+ nCol =1; -+ } -+ else if( nRowEl == 1) -+ { -+ nCol = nColEl; -+ nColEl = 1; -+ } -+ else -+ { -+ nCol = 1; -+ } -+ } -+ else -+ { -+ nCol=this->dim[0]; -+ nColEl=this->dim[1]; -+ assert( nColEl > 0); // rank is two -> cannot be zero -+ // if( nColEl == 0) nColEl=1; -+ } -+ } - else -- { -- nCol=this->dim[0]; -- nColEl=this->dim[1]; -- assert( nColEl > 0); // rank is two -> cannot be zero -- // if( nColEl == 0) nColEl=1; -- } -- -- // cout << "nColEl, nRowEl: " << nColEl << " " << nRowEl << endl; -- // cout << "nCol, nRow: " << nCol << " " << nRow << endl; -- -- // SizeT nRowEl=right->dim[0]; -+ { -+ if( this->dim.Rank() <= 1) -+ { -+ nColEl=this->dim[0]; -+ if( nColEl == 0) // scalar -+ { -+ nColEl=1; -+ nCol =1; -+ } -+ else if( nRowEl == 1) -+ { -+ nCol = nColEl; -+ nColEl = 1; -+ } -+ else -+ { -+ nCol = 1; -+ } -+ } -+ else -+ { -+ nCol=this->dim[1]; -+ nColEl=this->dim[0]; -+ assert( nColEl > 0); // rank is two -> cannot be zero -+ // if( nColEl == 0) nColEl=1; -+ } -+ } -+ - if( nColEl != nRowEl) - throw GDLException("Operands of matrix multiply have" - " incompatible dimensions.",true,false); - -- if( transposeResult) -- { -- if( nCol > 1) -- res=New(dimension( nRow, nCol),BaseGDL::NOZERO); -- else -- res=New(dimension(nRow),BaseGDL::NOZERO); -- } -+ if( nRow > 1) -+ res=New(dimension(nCol,nRow),BaseGDL::NOZERO); - else -- { -- if( nRow > 1) -- res=New(dimension(nCol,nRow),BaseGDL::NOZERO); -- else -- res=New(dimension(nCol),BaseGDL::NOZERO); -- } -+ res=New(dimension(nCol),BaseGDL::NOZERO); - - SizeT rIxEnd = nRow * nColEl; - //#ifdef _OPENMP - SizeT nOp = rIxEnd * nCol; - - #ifdef USE_STRASSEN_MATRIXMULTIPLICATION -- if( !transpose && !transposeResult && strassen) -+ if( !btranspose && !atranspose && strassen) - //if( nOp > 1000000) - { - SizeT maxDim; -@@ -1594,8 +1753,6 @@ - SizeT mSz = 2; - while (mSz < maxDim) mSz <<= 1; - -- // Ty* buf = new Ty[ 3 * mSz * mSz]; -- - SM1( mSz, nCol, nColEl, nRow, - static_cast(right->DataAddr()), - static_cast(this->DataAddr()), -@@ -1608,29 +1765,21 @@ - } - #endif - -- // for( SizeT j=0; j < nCol; ++j) // res dim 0 -- // for( SizeT i=0; i < rIxEnd; i++) // res dim 1 -- // for( SizeT k=0; k < nColEl; ++k) -- // (*res)[ (i * nCol) + j] += (*right)[ (i*nColEl)+k] * (*this)[ k*nCol+j]; -- -- -- //#endif -- -- if( !transposeResult) // normal -+ if( !atranspose) // normal - { -- if( !transpose) // normal -+ if( !btranspose) // normal - { - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nOp >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nOp)) default(shared) - { - #pragma omp for -- for( int colA=0; colA < nCol; ++colA) // res dim 0 -- for( SizeT rIx=0, rowBnCol=0; rIx < rIxEnd; -+ for( OMPInt colA=0; colA < nCol; ++colA) // res dim 0 -+ for( OMPInt rIx=0, rowBnCol=0; rIx < rIxEnd; - rIx += nColEl, rowBnCol += nCol) // res dim 1 - { - Ty& resEl = (*res)[ rowBnCol + colA]; - resEl = 0;//(*this)[ colA] * (*right)[ rIx]; // initialization -- for( SizeT i=0; i < nColEl; ++i) -+ for( OMPInt i=0; i < nColEl; ++i) - resEl += (*this)[ i*nCol+colA] * (*right)[ rIx+i]; - } - } -@@ -1641,33 +1790,35 @@ - #pragma omp parallel if (nOp >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nOp)) default(shared) - { - #pragma omp for -- for( int colA=0; colA < nCol; ++colA) // res dim 0 -- for( SizeT rIx=0, rowBnCol=0; rIx < nRow; ++rIx, rowBnCol += nCol) // res dim 1 -+ for( OMPInt colA=0; colA < nCol; ++colA) // res dim 0 -+ for( OMPInt rIx=0, rowBnCol=0; rIx < nRow; ++rIx, rowBnCol += nCol) // res dim 1 - { - Ty& resEl = (*res)[ rowBnCol + colA]; - resEl = 0;//(*this)[ colA] * (*right)[ rIx]; // initialization -- for( SizeT i=0; i < nColEl; ++i) -+ for( OMPInt i=0; i < nColEl; ++i) - resEl += (*this)[ i*nCol+colA] * (*right)[ rIx + i * nRow]; - } - } - } - } -- else // transposeResult -+ else // atranspose - { -- if( !transpose) // normal -+ if( !btranspose) // normal - { - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nOp >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nOp)) default(shared) - { - #pragma omp for -- for( int colA=0; colA < nCol; ++colA) // res dim 0 -- for( SizeT rIx=0, rowBnCol=0; rIx < rIxEnd; -+ for( OMPInt colA=0; colA < nCol; ++colA) // res dim 0 -+ for( OMPInt rIx=0, rowBnCol=0; rIx < rIxEnd; - rIx += nColEl, ++rowBnCol) // res dim 1 - { -- Ty& resEl = (*res)[ rowBnCol + colA * nRow]; -+ Ty& resEl = (*res)[ rowBnCol * nCol + colA]; -+// Ty& resEl = (*res)[ rowBnCol + colA * nRow]; - resEl = 0;//(*this)[ colA] * (*right)[ rIx]; // initialization -- for( SizeT i=0; i < nColEl; ++i) -- resEl += (*this)[ i*nCol+colA] * (*right)[ rIx+i]; -+ for( OMPInt i=0; i < nColEl; ++i) -+ resEl += (*this)[ i+colA*nColEl] * (*right)[ rIx+i]; -+// resEl += (*this)[ i*nCol+colA] * (*right)[ rIx+i]; - } - } - } -@@ -1677,13 +1828,15 @@ - #pragma omp parallel if (nOp >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nOp)) default(shared) - { - #pragma omp for -- for( int colA=0; colA < nCol; ++colA) // res dim 0 -- for( SizeT rIx=0; rIx < nRow; ++rIx) // res dim 1 -+ for( OMPInt colA=0; colA < nCol; ++colA) // res dim 0 -+ for( OMPInt rIx=0; rIx < nRow; ++rIx) // res dim 1 - { -- Ty& resEl = (*res)[ rIx + colA * nRow]; -+ Ty& resEl = (*res)[ rIx *nCol + colA]; -+// Ty& resEl = (*res)[ rIx + colA * nRow]; - resEl = 0;//(*this)[ colA] * (*right)[ rIx]; // initialization -- for( SizeT i=0; i < nColEl; ++i) -- resEl += (*this)[ i*nCol+colA] * (*right)[ rIx + i * nRow]; -+ for( OMPInt i=0; i < nColEl; ++i) -+ resEl += (*this)[ i+colA*nColEl] * (*right)[ rIx + i * nRow]; -+// resEl += (*this)[ i*nCol+colA] * (*right)[ rIx + i * nRow]; - } - } - } -@@ -1691,9 +1844,8 @@ - - - } -- //C delete right; -- //C delete this; - return res; -+#endif // #elseif USE_EIGEN - } - - -@@ -1701,25 +1853,20 @@ - - - // invalid types --DStructGDL* DStructGDL::MatrixOp( BaseGDL* r, bool t, bool tr, bool s) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> --Data_* Data_::MatrixOp( BaseGDL* r, bool t, bool tr, bool s) -+Data_* Data_::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose) - { - throw GDLException("Cannot apply operation to datatype STRING.",true,false); - return this; - } - template<> --Data_* Data_::MatrixOp( BaseGDL* r, bool t, bool tr, bool s) -+Data_* Data_::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose) - { - throw GDLException("Cannot apply operation to datatype PTR.",true,false); - return NULL; - } - template<> --Data_* Data_::MatrixOp( BaseGDL* r, bool t, bool tr, bool s) -+Data_* Data_::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose) - { - throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); - return NULL; -@@ -1733,6 +1880,7 @@ - // for integers - template - Data_* Data_::AndOp( BaseGDL* r) -+// GDL_DEFINE_INTEGER_FUNCTION( Data_*) AndOp( BaseGDL* r) - { - Data_* right=static_cast(r); - -@@ -1751,7 +1899,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = (*this)[i] & (*right)[i]; // & Ty(1); - } //C delete right; - return this; -@@ -1781,7 +1929,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*right)[i] == zero) (*this)[i]=zero; - // if( (*this)[i] == zero || (*right)[i] == zero) (*this)[i]=zero; - } //C delete right; -@@ -1805,12 +1953,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*this)[i] = (*right)[i]; - } //C delete right; - return this; - } --// for doubles -+// // for doubles - template<> - Data_* Data_::AndOp( BaseGDL* r) - { -@@ -1829,7 +1977,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*right)[i] == zero) (*this)[i]=zero; - // if( (*this)[i] == zero || (*right)[i] == zero) (*this)[i]=zero; - } //C delete right; -@@ -1853,42 +2001,36 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*this)[i] = (*right)[i]; - } //C delete right; - return this; - } - // invalid types --DStructGDL* DStructGDL::AndOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::AndOpInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --// template<> --// DStructGDL* DStructGDL::AndOpInv( BaseGDL* r) -+// GDL_DEFINE_COMPLEX_FUNCTION( Data_*) AndOp( BaseGDL* r) - // { --// throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); --// return this; -+// throw GDLException("Cannot apply operation to datatype "+Sp::str+".",true,false); -+// return this; - // } - template<> --Data_* Data_::AndOp( BaseGDL* r) -+Data_* Data_::AndOp( BaseGDL* r) - { -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> --Data_* Data_::AndOp( BaseGDL* r) -+Data_* Data_::AndOp( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } -+// GDL_DEFINE_OTHER_FUNCTION( Data_*) AndOp( BaseGDL* r) -+// { -+// throw GDLException("Cannot apply operation to datatype "+Sp::str+".",true,false); -+// return this; -+// } - template<> --Data_* Data_::AndOp( BaseGDL* r) -+Data_* Data_::AndOp( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; -@@ -1918,9 +2060,9 @@ - return this; - } - // template<> --// Data_* Data_::AndOpInv( BaseGDL* r) -+// Data_* Data_::AndOpInv( BaseGDL* r) - // { --// throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+// throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); - // return this; - // } - template -@@ -1945,7 +2087,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(s) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] &= s; - } - return this; -@@ -2008,7 +2150,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*this)[i] = s; - }} - return this; -@@ -2064,28 +2206,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*this)[i] = s; - }} - return this; - } - // invalid types --DStructGDL* DStructGDL::AndOpS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::AndOpInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --// template<> --// DStructGDL* DStructGDL::AndOpInv( BaseGDL* r) --// { --// throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); --// return this; --// } - template<> - Data_* Data_::AndOpS( BaseGDL* r) - { -@@ -2147,7 +2273,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = (*this)[i] | (*right)[i]; // | Ty(1); - } - //C delete right; -@@ -2179,7 +2305,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*this)[i]=(*right)[i]; - } //C delete right; - return this; -@@ -2203,7 +2329,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*right)[i] != zero) (*this)[i] = (*right)[i]; - } //C delete right; - return this; -@@ -2228,7 +2354,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*this)[i]= (*right)[i]; - } //C delete right; - return this; -@@ -2252,22 +2378,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*right)[i] != zero) (*this)[i] = (*right)[i]; - } //C delete right; - return this; - } - // invalid types --DStructGDL* DStructGDL::OrOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::OrOpInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::OrOp( BaseGDL* r) - { -@@ -2322,7 +2438,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = (*this)[i] | s; - } //C delete right; - return this; -@@ -2355,7 +2471,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*this)[i] = s; - }} //C delete right; - return this; -@@ -2395,7 +2511,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*this)[i] = s; - }} //C delete right; - return this; -@@ -2429,22 +2545,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*this)[i] = s; - }} //C delete right; - return this; - } - // invalid types --DStructGDL* DStructGDL::OrOpS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::OrOpInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::OrOpS( BaseGDL* r) - { -@@ -2505,7 +2611,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] ^= s; - }} - } -@@ -2515,7 +2621,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] ^= (*right)[i]; - } } - //C delete right; -@@ -2534,11 +2640,6 @@ - throw GDLException("Cannot apply operation to datatype DOUBLE.",true,false); - return this; - } --DStructGDL* DStructGDL::XorOp( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::XorOp( BaseGDL* r) - { -@@ -2587,7 +2688,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] ^= s; - // (*this)[i] = (*this)[i] ^ s; - } //C delete right; -@@ -2609,11 +2710,6 @@ - return this; - } - // invalid types --DStructGDL* DStructGDL::XorOpS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::XorOpS( BaseGDL* r) - { -@@ -2645,1354 +2741,233 @@ - return this; - } - --// Add --// Adds right to itself, //C deletes right -+// LtMark -+// LtMarks right to itself, //C deletes right - // right must always have more or same number of elements - template --BaseGDL* Data_::Add( BaseGDL* r) -+Data_* Data_::LtMark( BaseGDL* r) - { - Data_* right=static_cast(r); - -- // ULong rEl=right->N_Elements(); -+ // ULong rEl=right->N_Elements(); - ULong nEl=N_Elements(); -- // assert( rEl); -+ // assert( rEl); - assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); - if( nEl == 1) - { -- (*this)[0] += (*right)[0]; -+ if( (*this)[0] > (*right)[0]) (*this)[0]=(*right)[0]; - return this; - } -- - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] += (*right)[i]; -+ for( OMPInt i=0; i < nEl; ++i) -+ if( (*this)[i] > (*right)[i]) (*this)[i]=(*right)[i]; - } //C delete right; - return this; - } --template --BaseGDL* Data_::AddInv( BaseGDL* r) -+// invalid types -+template<> -+Data_* Data_::LtMark( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::LtMark( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -+ return this; -+} -+template<> -+Data_* Data_::LtMark( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -+ return this; -+} -+template<> -+Data_* Data_::LtMark( BaseGDL* r) - { -- assert( this->Type() != GDL_OBJ); // should never be called via this -- return Add( r); -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; - } - template<> --BaseGDL* Data_::AddInv( BaseGDL* r) -+Data_* Data_::LtMark( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+template -+Data_* Data_::LtMarkS( BaseGDL* r) - { - Data_* right=static_cast(r); -- -- // ULong rEl=right->N_Elements(); -+ - ULong nEl=N_Elements(); -- // assert( rEl); - assert( nEl); - if( nEl == 1) - { -- (*this)[0] = (*right)[0] + (*this)[0]; -+ if( (*this)[0] > (*right)[0]) (*this)[0]=(*right)[0]; - return this; - } -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ Ty s = (*right)[0]; -+ // right->Scalar(s); - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] = (*right)[i] + (*this)[i]; -+ for( OMPInt i=0; i < nEl; ++i) -+ if( (*this)[i] > s) (*this)[i]=s; - } //C delete right; - return this; - } - // invalid types --DStructGDL* DStructGDL::Add( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::AddInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --BaseGDL* Data_::Add( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --BaseGDL* Data_::Add( BaseGDL* r) --{ -- // overload here -- Data_* self; -- DFun* plusOverload; -- -- ProgNodeP callingNode = interpreter->GetRetTree(); -- -- if( !Scalar()) -- { -- if( r->Type() == GDL_OBJ && r->Scalar()) -- { -- self = static_cast( r); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -- if( plusOverload == NULL) -- { -- throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -- } -- } -- else -- { -- throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -- } -- } -- else -- { -- // Scalar() -- self = static_cast( this); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -- if( plusOverload == NULL) -- { -- if( r->Type() == GDL_OBJ && r->Scalar()) -- { -- self = static_cast( r); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -- if( plusOverload == NULL) -- { -- throw GDLException(callingNode,"Cannot apply not overloaded operator to datatype OBJECT.",true, false); -- } -- } -- else -- { -- throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -- } -- } -- } -- -- assert( self->Scalar()); -- assert( plusOverload != NULL); -- -- // hidden SELF is counted as well -- int nParSub = plusOverload->NPar(); -- assert( nParSub >= 1); // SELF -- if( nParSub < 3) // (SELF), LEFT, RIGHT -- { -- throw GDLException( callingNode, plusOverload->ObjectName() + -- ": Incorrect number of arguments.", -- false, false); -- } -- EnvUDT* newEnv; -- Guard selfGuard; -- BaseGDL* thisP; -- // Dup() here is not optimal -- // avoid at least for internal overload routines (which do/must not change SELF or r) -- bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -- if( internalDSubUD) -- { -- thisP = this; -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -- newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -- } -- else -- { -- self = self->Dup(); -- selfGuard.Init( self); -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -- newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -- } -- -- -- // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -- StackGuard guard(interpreter->CallStack()); -- -- interpreter->CallStack().push_back( newEnv); -- -- // make the call -- BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -- -- if( !internalDSubUD && self != selfGuard.Get()) -- { -- // always put out warning first, in case of a later crash -- Warning( "WARNING: " + plusOverload->ObjectName() + -- ": Assignment to SELF detected (GDL session still ok)."); -- // assignment to SELF -> self was deleted and points to new variable -- // which it owns -- selfGuard.Release(); -- if( static_cast(self) != NullGDL::GetSingleInstance()) -- selfGuard.Reset(self); -- } -- return res; --} --// difference from above: Order of parameters in call --template<> --BaseGDL* Data_::AddInv( BaseGDL* r) --{ -- if( r->Type() == GDL_OBJ && r->Scalar()) -- { -- return r->Add( this); // for right order of parameters -- } -- -- // overload here -- Data_* self; -- DFun* plusOverload; -- -- ProgNodeP callingNode = interpreter->GetRetTree(); -- -- if( !Scalar()) -- { -- throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -- } -- else -- { -- // Scalar() -- self = static_cast( this); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOPlus)); -- if( plusOverload == NULL) -- { -- throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -- } -- } -- -- assert( self->Scalar()); -- assert( plusOverload != NULL); -- -- // hidden SELF is counted as well -- int nParSub = plusOverload->NPar(); -- assert( nParSub >= 1); // SELF -- if( nParSub < 3) // (SELF), LEFT, RIGHT -- { -- throw GDLException( callingNode, plusOverload->ObjectName() + -- ": Incorrect number of arguments.", -- false, false); -- } -- EnvUDT* newEnv; -- Guard selfGuard; -- BaseGDL* thisP; -- // Dup() here is not optimal -- // avoid at least for internal overload routines (which do/must not change SELF or r) -- bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -- if( internalDSubUD) -- { -- thisP = this; -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- // order different to Add -- newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -- newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -- } -- else -- { -- self = self->Dup(); -- selfGuard.Init( self); -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- // order different to Add -- newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -- newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -- } -- -- -- // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -- StackGuard guard(interpreter->CallStack()); -- -- interpreter->CallStack().push_back( newEnv); -- -- // make the call -- BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -- -- if( !internalDSubUD && self != selfGuard.Get()) -- { -- // always put out warning first, in case of a later crash -- Warning( "WARNING: " + plusOverload->ObjectName() + -- ": Assignment to SELF detected (GDL session still ok)."); -- // assignment to SELF -> self was deleted and points to new variable -- // which it owns -- selfGuard.Release(); -- if( static_cast(self) != NullGDL::GetSingleInstance()) -- selfGuard.Reset(self); -- } -- return res; --} -- --template --BaseGDL* Data_::AddS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- if( nEl == 1) -- { -- (*this)[0] += (*right)[0]; -- return this; -- } -- Ty s = (*right)[0]; -- // right->Scalar(s); -- // dd += s; -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] += s; -- } //C delete right; -- return this; --} --template --BaseGDL* Data_::AddInvS( BaseGDL* r) --{ -- return AddS( r); --} --template<> --BaseGDL* Data_::AddInvS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- if( nEl == 1) -- { -- (*this)[0] = (*right)[0] + (*this)[0] ; -- return this; -- } -- Ty s = (*right)[0]; -- // right->Scalar(s); -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] = s + (*this)[i]; -- } //C delete right; -- return this; --} -- --// invalid types --DStructGDL* DStructGDL::AddS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::AddInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --BaseGDL* Data_::AddS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --BaseGDL* Data_::AddS( BaseGDL* r) --{ -- return Add( r); --} --template<> --BaseGDL* Data_::AddInvS( BaseGDL* r) --{ -- return AddInv( r); --} -- --// Sub --// substraction: left=left-right --template --BaseGDL* Data_::Sub( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong rEl=right->N_Elements(); -- ULong nEl=N_Elements(); -- assert( rEl); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- if( nEl == rEl) -- dd -= right->dd; -- else -- { -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] -= (*right)[i]; -- }} //C delete right; -- return this; --} --// inverse substraction: left=right-left --template --BaseGDL* Data_::SubInv( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong rEl=right->N_Elements(); -- ULong nEl=N_Elements(); -- assert( rEl); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- /* if( nEl == rEl) -- dd = right->dd - dd; -- else*/ -- if( nEl == 1) -- { -- (*this)[0] = (*right)[0] - (*this)[0]; -- return this; -- } -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] = (*right)[i] - (*this)[i]; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::Sub( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::SubInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --BaseGDL* Data_::Sub( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --BaseGDL* Data_::SubInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --BaseGDL* Data_::Sub( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --BaseGDL* Data_::SubInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --BaseGDL* Data_::Sub( BaseGDL* r) --{ -- // overload here -- Data_* self; -- DFun* plusOverload; -- -- ProgNodeP callingNode = interpreter->GetRetTree(); -- -- if( !Scalar()) -- { -- if( r->Type() == GDL_OBJ && r->Scalar()) -- { -- self = static_cast( r); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -- if( plusOverload == NULL) -- { -- throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -- } -- } -- else -- { -- throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -- } -- } -- else -- { -- // Scalar() -- self = static_cast( this); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -- if( plusOverload == NULL) -- { -- if( r->Type() == GDL_OBJ && r->Scalar()) -- { -- self = static_cast( r); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -- if( plusOverload == NULL) -- { -- throw GDLException(callingNode,"Cannot apply not overloaded operator to datatype OBJECT.",true, false); -- } -- } -- else -- { -- throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -- } -- } -- } -- -- assert( self->Scalar()); -- assert( plusOverload != NULL); -- -- // hidden SELF is counted as well -- int nParSub = plusOverload->NPar(); -- assert( nParSub >= 1); // SELF -- if( nParSub < 3) // (SELF), LEFT, RIGHT -- { -- throw GDLException( callingNode, plusOverload->ObjectName() + -- ": Incorrect number of arguments.", -- false, false); -- } -- EnvUDT* newEnv; -- Guard selfGuard; -- BaseGDL* thisP; -- // Dup() here is not optimal -- // avoid at least for internal overload routines (which do/must not change SELF or r) -- bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -- if( internalDSubUD) -- { -- thisP = this; -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -- newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -- } -- else -- { -- self = self->Dup(); -- selfGuard.Init( self); -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -- newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -- } -- -- -- // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -- StackGuard guard(interpreter->CallStack()); -- -- interpreter->CallStack().push_back( newEnv); -- -- // make the call -- BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -- -- if( !internalDSubUD && self != selfGuard.Get()) -- { -- // always put out warning first, in case of a later crash -- Warning( "WARNING: " + plusOverload->ObjectName() + -- ": Assignment to SELF detected (GDL session still ok)."); -- // assignment to SELF -> self was deleted and points to new variable -- // which it owns -- selfGuard.Release(); -- if( static_cast(self) != NullGDL::GetSingleInstance()) -- selfGuard.Reset(self); -- } -- return res; --} --template<> --BaseGDL* Data_::SubInv( BaseGDL* r) --{ -- if( r->Type() == GDL_OBJ && r->Scalar()) -- { -- return r->Sub( this); // for right order of parameters -- } -- -- // overload here -- Data_* self; -- DFun* plusOverload; -- -- ProgNodeP callingNode = interpreter->GetRetTree(); -- -- if( !Scalar()) -- { -- throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -- } -- else -- { -- // Scalar() -- self = static_cast( this); -- plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -- if( plusOverload == NULL) -- { -- throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -- } -- } -- -- assert( self->Scalar()); -- assert( plusOverload != NULL); -- -- // hidden SELF is counted as well -- int nParSub = plusOverload->NPar(); -- assert( nParSub >= 1); // SELF -- if( nParSub < 3) // (SELF), LEFT, RIGHT -- { -- throw GDLException( callingNode, plusOverload->ObjectName() + -- ": Incorrect number of arguments.", -- false, false); -- } -- EnvUDT* newEnv; -- Guard selfGuard; -- BaseGDL* thisP; -- // Dup() here is not optimal -- // avoid at least for internal overload routines (which do/must not change SELF or r) -- bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -- if( internalDSubUD) -- { -- thisP = this; -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- // order different to Add -- newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -- newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -- } -- else -- { -- self = self->Dup(); -- selfGuard.Init( self); -- newEnv= new EnvUDT( callingNode, plusOverload, &self); -- // order different to Add -- newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -- newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -- } -- -- -- // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -- StackGuard guard(interpreter->CallStack()); -- -- interpreter->CallStack().push_back( newEnv); -- -- // make the call -- BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -- -- if( !internalDSubUD && self != selfGuard.Get()) -- { -- // always put out warning first, in case of a later crash -- Warning( "WARNING: " + plusOverload->ObjectName() + -- ": Assignment to SELF detected (GDL session still ok)."); -- // assignment to SELF -> self was deleted and points to new variable -- // which it owns -- selfGuard.Release(); -- if( static_cast(self) != NullGDL::GetSingleInstance()) -- selfGuard.Reset(self); -- } -- return res; --} --template --Data_* Data_::SubS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- if( nEl == 1) -- { -- (*this)[0] -= (*right)[0]; -- return this; -- } -- -- Ty s = (*right)[0]; -- // right->Scalar(s); -- // dd -= s; -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] -= s; -- } //C delete right; -- return this; --} --// inverse substraction: left=right-left --template --Data_* Data_::SubInvS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- -- if( nEl == 1) -- { -- (*this)[0] = (*right)[0] - (*this)[0]; -- return this; -- } -- -- Ty s = (*right)[0]; -- // right->Scalar(s); -- // dd = s - dd; -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] = s - (*this)[i]; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::SubS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::SubInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --Data_* Data_::SubS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --Data_* Data_::SubInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --Data_* Data_::SubS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --Data_* Data_::SubInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --Data_* Data_::SubS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} --template<> --Data_* Data_::SubInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} -- --// LtMark --// LtMarks right to itself, //C deletes right --// right must always have more or same number of elements --template --Data_* Data_::LtMark( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- // ULong rEl=right->N_Elements(); -- ULong nEl=N_Elements(); -- // assert( rEl); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- if( nEl == 1) -- { -- if( (*this)[0] > (*right)[0]) (*this)[0]=(*right)[0]; -- return this; -- } -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- if( (*this)[i] > (*right)[i]) (*this)[i]=(*right)[i]; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::LtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --Data_* Data_::LtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --Data_* Data_::LtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::LtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::LtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --Data_* Data_::LtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} --template --Data_* Data_::LtMarkS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- if( nEl == 1) -- { -- if( (*this)[0] > (*right)[0]) (*this)[0]=(*right)[0]; -- return this; -- } -- Ty s = (*right)[0]; -- // right->Scalar(s); -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- if( (*this)[i] > s) (*this)[i]=s; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::LtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --Data_* Data_::LtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --Data_* Data_::LtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::LtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::LtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --Data_* Data_::LtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} --// GtMark --// GtMarks right to itself, //C deletes right --// right must always have more or same number of elements --template --Data_* Data_::GtMark( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- // ULong rEl=right->N_Elements(); -- ULong nEl=N_Elements(); -- // assert( rEl); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- if( nEl == 1) -- { -- if( (*this)[0] < (*right)[0]) (*this)[0]=(*right)[0]; -- return this; -- } -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- if( (*this)[i] < (*right)[i]) (*this)[i]=(*right)[i]; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::GtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --Data_* Data_::GtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --Data_* Data_::GtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::GtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::GtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --Data_* Data_::GtMark( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} --template --Data_* Data_::GtMarkS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- if( nEl == 1) -- { -- if( (*this)[0] < (*right)[0]) (*this)[0]=(*right)[0]; -- return this; -- } -- -- Ty s = (*right)[0]; -- // right->Scalar(s); -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- if( (*this)[i] < s) (*this)[i]=s; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::GtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --template<> --Data_* Data_::GtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -- return this; --} --template<> --Data_* Data_::GtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::GtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -- return this; --} --template<> --Data_* Data_::GtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --Data_* Data_::GtMarkS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} -- --// Mult --// Mults right to itself, //C deletes right --// right must always have more or same number of elements --template --Data_* Data_::Mult( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- // ULong rEl=right->N_Elements(); -- ULong nEl=N_Elements(); -- // assert( rEl); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- if( nEl == 1) -- { -- (*this)[0] *= (*right)[0]; -- return this; -- } -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] *= (*right)[i]; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::Mult( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> --Data_* Data_::Mult( BaseGDL* r) -+Data_* Data_::LtMarkS( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype STRING.",true,false); - return this; - } - template<> --Data_* Data_::Mult( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -- return this; --} --template<> --Data_* Data_::Mult( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} -- --template --Data_* Data_::MultS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- if( nEl == 1) -- { -- (*this)[0] *= (*right)[0]; -- return this; -- } -- Ty s = (*right)[0]; -- // right->Scalar(s); -- // dd *= s; -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { --#pragma omp for -- for( int i=0; i < nEl; ++i) -- (*this)[i] *= s; -- } //C delete right; -- return this; --} --// invalid types --DStructGDL* DStructGDL::MultS( BaseGDL* r) -+Data_* Data_::LtMarkS( BaseGDL* r) - { -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> --Data_* Data_::MultS( BaseGDL* r) -+Data_* Data_::LtMarkS( BaseGDL* r) - { -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> --Data_* Data_::MultS( BaseGDL* r) -+Data_* Data_::LtMarkS( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype PTR.",true,false); - return this; - } - template<> --Data_* Data_::MultS( BaseGDL* r) -+Data_* Data_::LtMarkS( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); - return this; - } -- --// Div --// division: left=left/right -+// GtMark -+// GtMarks right to itself, //C deletes right -+// right must always have more or same number of elements - template --Data_* Data_::Div( BaseGDL* r) -+Data_* Data_::GtMark( BaseGDL* r) - { - Data_* right=static_cast(r); - - // ULong rEl=right->N_Elements(); - ULong nEl=N_Elements(); -- // assert( rEl); -+ // assert( rEl); - assert( nEl); - // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- -- SizeT i = 0; -- -- if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -+ if( nEl == 1) - { -- // TODO: Check if we can use OpenMP here (is longjmp allowed?) -- // if yes: need to run the full loop after the longjmp -- for( /*SizeT i=0*/; i < nEl; ++i) -- (*this)[i] /= (*right)[i]; -- //C delete right; -+ if( (*this)[0] < (*right)[0]) (*this)[0]=(*right)[0]; - return this; - } -- else -- { -- TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- // bool zeroEncountered = false; // until zero operation is already done. --#pragma omp for -- for( int ix=i; ix < nEl; ++ix) -- /* if( !zeroEncountered) -- { -- if( (*right)[ix] == this->zero) -- zeroEncountered = true; -- } -- else*/ -- if( (*right)[ix] != this->zero) (*this)[ix] /= (*right)[ix]; -- } //C delete right; -- return this; -- } --} --// inverse division: left=right/left --template --Data_* Data_::DivInv( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- // ULong rEl=right->N_Elements(); -- ULong nEl=N_Elements(); -- // assert( rEl); -- assert( nEl); -- -- SizeT i = 0; -- -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -- { -- for( /*SizeT i=0*/; i < nEl; ++i) -- (*this)[i] = (*right)[i] / (*this)[i]; -- //C delete right; -- return this; -- } -- else - { -- TRACEOMP( __FILE__, __LINE__) --#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- // bool zeroEncountered = false; // until zero operation is already done. - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -- /* if( !zeroEncountered) -- { -- if( (*this)[ix] == this->zero) -- { -- zeroEncountered = true; -- (*this)[ ix] = (*right)[i]; -- } -- } -- else*/ -- if( (*this)[ix] != this->zero) -- (*this)[ix] = (*right)[ix] / (*this)[ix]; -- else -- (*this)[ix] = (*right)[ix]; -- } //C delete right; -- return this; -- } --} --// invalid types --DStructGDL* DStructGDL::Div( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::DivInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ for( OMPInt i=0; i < nEl; ++i) -+ if( (*this)[i] < (*right)[i]) (*this)[i]=(*right)[i]; -+ } //C delete right; - return this; - } -+// invalid types - template<> --Data_* Data_::Div( BaseGDL* r) -+Data_* Data_::GtMark( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype STRING.",true,false); - return this; - } - template<> --Data_* Data_::DivInv( BaseGDL* r) -+Data_* Data_::GtMark( BaseGDL* r) - { -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> --Data_* Data_::Div( BaseGDL* r) -+Data_* Data_::GtMark( BaseGDL* r) - { -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> --Data_* Data_::DivInv( BaseGDL* r) -+Data_* Data_::GtMark( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype PTR.",true,false); - return this; - } - template<> --Data_* Data_::Div( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} --template<> --Data_* Data_::DivInv( BaseGDL* r) -+Data_* Data_::GtMark( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); - return this; - } - template --Data_* Data_::DivS( BaseGDL* r) -+Data_* Data_::GtMarkS( BaseGDL* r) - { - Data_* right=static_cast(r); - - ULong nEl=N_Elements(); - assert( nEl); -- Ty s = (*right)[0]; -- -- // remember: this is a template (must work for several types) -- // due to error handling the actual devision by 0 -- // has to be done -- // but if not 0, we save the expensive error handling -- if( s != this->zero) -- { -- for(SizeT i=0; i < nEl; ++i) -- { -- (*this)[i] /= s; -- } -- return this; -- } -- if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -+ if( nEl == 1) - { -- for(SizeT i=0; i < nEl; ++i) -- { -- (*this)[i] /= s; -- } -+ if( (*this)[0] < (*right)[0]) (*this)[0]=(*right)[0]; - return this; - } -- return this; --} - --// inverse division: left=right/left --template --Data_* Data_::DivInvS( BaseGDL* r) --{ -- Data_* right=static_cast(r); -- -- ULong nEl=N_Elements(); -- assert( nEl); -- // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -- -- // remember: this is a template (must work for several types) -- // due to error handling the actual devision by 0 -- // has to be done -- // but if not 0, we save the expensive error handling -- if( nEl == 1 && (*this)[0] != this->zero) -- { -- (*this)[0] = (*right)[0] / (*this)[0]; -- return this; -- } -- - Ty s = (*right)[0]; -- SizeT i=0; -- if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -- { -- // right->Scalar(s); -- for( /*SizeT i=0*/; i < nEl; ++i) -- (*this)[i] = s / (*this)[i]; -- //C delete right; -- return this; -- } -- else -+ // right->Scalar(s); -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { --// TRACEOMP( __FILE__, __LINE__) --// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) --// { --// // bool zeroEncountered = false; --// #pragma omp for -- // right->Scalar(s); -- for( SizeT ix=i; ix < nEl; ++ix) -- /* if( !zeroEncountered) -- { -- if( (*this)[ix] == this->zero) -- { -- zeroEncountered = true; -- (*this)[ix] = s; -- } -- } -- else*/ -- if( (*this)[ix] != this->zero) -- (*this)[ix] = s / (*this)[ix]; -- else -- (*this)[ix] = s; --// } //C delete right; -- return this; -- } --} --// invalid types --DStructGDL* DStructGDL::DivS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::DivInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ if( (*this)[i] < s) (*this)[i]=s; -+ } //C delete right; - return this; - } -+// invalid types - template<> --Data_* Data_::DivS( BaseGDL* r) -+Data_* Data_::GtMarkS( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype STRING.",true,false); - return this; - } - template<> --Data_* Data_::DivInvS( BaseGDL* r) -+Data_* Data_::GtMarkS( BaseGDL* r) - { -- throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> --Data_* Data_::DivS( BaseGDL* r) -+Data_* Data_::GtMarkS( BaseGDL* r) - { -- throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); - return this; - } - template<> --Data_* Data_::DivInvS( BaseGDL* r) -+Data_* Data_::GtMarkS( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype PTR.",true,false); - return this; - } - template<> --Data_* Data_::DivS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -- return this; --} --template<> --Data_* Data_::DivInvS( BaseGDL* r) -+Data_* Data_::GtMarkS( BaseGDL* r) - { - throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); - return this; - } - -+ - // Mod - // modulo division: left=left % right - template -@@ -4021,7 +2996,7 @@ - { - // bool zeroEncountered = false; - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - /* if( !zeroEncountered) - { - if( (*right)[i] == this->zero) -@@ -4066,7 +3041,7 @@ - { - // bool zeroEncountered = false; - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - /* if( !zeroEncountered) - { - if( (*this)[ix] == this->zero) -@@ -4105,7 +3080,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = Modulo((*this)[i],(*right)[i]); - } //C delete right; - return this; -@@ -4125,7 +3100,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = Modulo((*right)[i],(*this)[i]); - } //C delete right; - return this; -@@ -4152,7 +3127,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = DModulo((*this)[i],(*right)[i]); - } //C delete right; - return this; -@@ -4172,22 +3147,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = DModulo((*right)[i],(*this)[i]); - } //C delete right; - return this; - } - // invalid types --DStructGDL* DStructGDL::Mod( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::ModInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::Mod( BaseGDL* r) - { -@@ -4336,7 +3301,7 @@ - #pragma omp for - // bool zeroEncountered = false; - // right->Scalar(s); -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - /* if( !zeroEncountered) - { - if( (*this)[ix] == this->zero) -@@ -4368,7 +3333,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = Modulo((*this)[i],s); - } //C delete right; - return this; -@@ -4388,7 +3353,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = Modulo(s,(*this)[i]); - } //C delete right; - return this; -@@ -4406,7 +3371,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = DModulo((*this)[i],s); - } //C delete right; - return this; -@@ -4425,22 +3390,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = DModulo(s,(*this)[i]); - } //C delete right; - return this; - } - // invalid types --DStructGDL* DStructGDL::ModS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::ModInvS( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::ModS( BaseGDL* r) - -@@ -4545,7 +3500,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], (*right)[i]); // valarray - } //C delete right; - return this; -@@ -4568,7 +3523,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*right)[i], (*this)[i]); - } //C delete right; - return this; -@@ -4594,7 +3549,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], (*right)[i]); - } } - return this; -@@ -4607,11 +3562,6 @@ - assert( 0); - return this; - } --DStructGDL* DStructGDL::PowInt( BaseGDL* r) --{ -- assert( 0); -- return this; --} - // floats power of value with GDL_LONG: left=left ^ right - template<> - Data_* Data_::PowInt( BaseGDL* r) -@@ -4629,7 +3579,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], r0); - } return this; - } -@@ -4641,7 +3591,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[ i] = pow( s0, (*right)[ i]); - } return res; - } -@@ -4651,7 +3601,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], (*right)[i]); - } return this; - } -@@ -4662,7 +3612,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } return res; - } -@@ -4684,7 +3634,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], r0); - } return this; - } -@@ -4696,7 +3646,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[ i] = pow( s0, (*right)[ i]); - } return res; - } -@@ -4706,7 +3656,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], (*right)[i]); - } return this; - } -@@ -4717,7 +3667,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } return res; - } -@@ -4742,7 +3692,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*right)[i], (*this)[i]); - } //C delete right; - return this; -@@ -4767,7 +3717,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], (*right)[i]); - } //C delete right; - return this; -@@ -4792,7 +3742,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*right)[i], (*this)[i]); - } //C delete right; - return this; -@@ -4821,7 +3771,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], (*right)[i]); - } - #endif -@@ -4986,7 +3936,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*right)[i], (*this)[i]); - #endif - } //C delete right; -@@ -5016,7 +3966,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], (*right)[i]); - } - #endif -@@ -5183,7 +4133,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*right)[i], (*this)[i]); - } - #endif -@@ -5191,16 +4141,6 @@ - return this; - } - // invalid types --DStructGDL* DStructGDL::Pow( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} --DStructGDL* DStructGDL::PowInv( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return this; --} - template<> - Data_* Data_::Pow( BaseGDL* r) - { -@@ -5252,7 +4192,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( (*this)[i], s); - } - //C delete right; -@@ -5274,7 +4214,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*this)[i] = pow( s, (*this)[i]); - } //C delete right; - return this; -@@ -5293,7 +4233,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; iStrictScalar(s)) - { -@@ -5567,7 +4507,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i - Data_* Data_::PowS( BaseGDL* r) - { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_op_div.cpp gdl/src/basic_op_div.cpp ---- gdl-0.9.3/src/basic_op_div.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/basic_op_div.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -0,0 +1,292 @@ -+/*************************************************************************** -+ basic_op_div.cpp - GDL div (/) operators -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002 by Marc Schellens -+ email : m_schellens@users.sf.net -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+// to be included from datatypes.cpp -+#ifdef INCLUDE_BASIC_OP_CPP -+ -+// // header in datatypes.hpp -+// -+// //#include "datatypes.hpp" -+// //#include "dstructgdl.hpp" -+// //#include "arrayindex.hpp" -+// -+// //#include -+// #include "sigfpehandler.hpp" -+// -+// #ifdef _OPENMP -+// #include -+// #endif -+// -+// #include "typetraits.hpp" -+// -+// using namespace std; -+ -+// Div -+// division: left=left/right -+template -+Data_* Data_::Div( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ // ULong rEl=right->N_Elements(); -+ ULong nEl=N_Elements(); -+ // assert( rEl); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ -+ SizeT i = 0; -+ -+ if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -+ { -+ // TODO: Check if we can use OpenMP here (is longjmp allowed?) -+ // if yes: need to run the full loop after the longjmp -+ for( /*SizeT i=0*/; i < nEl; ++i) -+ (*this)[i] /= (*right)[i]; -+ //C delete right; -+ return this; -+ } -+ else -+ { -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+ // bool zeroEncountered = false; // until zero operation is already done. -+#pragma omp for -+ for( OMPInt ix=i; ix < nEl; ++ix) -+ /* if( !zeroEncountered) -+ { -+ if( (*right)[ix] == this->zero) -+ zeroEncountered = true; -+ } -+ else*/ -+ if( (*right)[ix] != this->zero) (*this)[ix] /= (*right)[ix]; -+ } //C delete right; -+ return this; -+ } -+} -+// inverse division: left=right/left -+template -+Data_* Data_::DivInv( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ // ULong rEl=right->N_Elements(); -+ ULong nEl=N_Elements(); -+ // assert( rEl); -+ assert( nEl); -+ -+ SizeT i = 0; -+ -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -+ { -+ for( /*SizeT i=0*/; i < nEl; ++i) -+ (*this)[i] = (*right)[i] / (*this)[i]; -+ //C delete right; -+ return this; -+ } -+ else -+ { -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+ // bool zeroEncountered = false; // until zero operation is already done. -+#pragma omp for -+ for( OMPInt ix=i; ix < nEl; ++ix) -+ /* if( !zeroEncountered) -+ { -+ if( (*this)[ix] == this->zero) -+ { -+ zeroEncountered = true; -+ (*this)[ ix] = (*right)[i]; -+ } -+ } -+ else*/ -+ if( (*this)[ix] != this->zero) -+ (*this)[ix] = (*right)[ix] / (*this)[ix]; -+ else -+ (*this)[ix] = (*right)[ix]; -+ } //C delete right; -+ return this; -+ } -+} -+// invalid types -+template<> -+Data_* Data_::Div( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::Div( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::Div( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+template -+Data_* Data_::DivS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ Ty s = (*right)[0]; -+ -+ // remember: this is a template (must work for several types) -+ // due to error handling the actual devision by 0 -+ // has to be done -+ // but if not 0, we save the expensive error handling -+ if( s != this->zero) -+ { -+ for(SizeT i=0; i < nEl; ++i) -+ { -+ (*this)[i] /= s; -+ } -+ return this; -+ } -+ if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -+ { -+ for(SizeT i=0; i < nEl; ++i) -+ { -+ (*this)[i] /= s; -+ } -+ return this; -+ } -+ return this; -+} -+ -+// inverse division: left=right/left -+template -+Data_* Data_::DivInvS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ -+ // remember: this is a template (must work for several types) -+ // due to error handling the actual devision by 0 -+ // has to be done -+ // but if not 0, we save the expensive error handling -+ if( nEl == 1 && (*this)[0] != this->zero) -+ { -+ (*this)[0] = (*right)[0] / (*this)[0]; -+ return this; -+ } -+ -+ Ty s = (*right)[0]; -+ SizeT i=0; -+ if( sigsetjmp( sigFPEJmpBuf, 1) == 0) -+ { -+ // right->Scalar(s); -+ for( /*SizeT i=0*/; i < nEl; ++i) -+ (*this)[i] = s / (*this)[i]; -+ //C delete right; -+ return this; -+ } -+ else -+ { -+// TRACEOMP( __FILE__, __LINE__) -+// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// // bool zeroEncountered = false; -+// #pragma omp for -+ // right->Scalar(s); -+ for( SizeT ix=i; ix < nEl; ++ix) -+ /* if( !zeroEncountered) -+ { -+ if( (*this)[ix] == this->zero) -+ { -+ zeroEncountered = true; -+ (*this)[ix] = s; -+ } -+ } -+ else*/ -+ if( (*this)[ix] != this->zero) -+ (*this)[ix] = s / (*this)[ix]; -+ else -+ (*this)[ix] = s; -+// } //C delete right; -+ return this; -+ } -+} -+// invalid types -+template<> -+Data_* Data_::DivS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::DivInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+ -+ -+ -+#endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_op_mult.cpp gdl/src/basic_op_mult.cpp ---- gdl-0.9.3/src/basic_op_mult.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/basic_op_mult.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -0,0 +1,146 @@ -+/*************************************************************************** -+ basic_op_mult.cpp - GDL mult (*) operators -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002 by Marc Schellens -+ email : m_schellens@users.sf.net -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+// to be included from datatypes.cpp -+#ifdef INCLUDE_BASIC_OP_CPP -+ -+// // header in datatypes.hpp -+// -+// //#include "datatypes.hpp" -+// //#include "dstructgdl.hpp" -+// //#include "arrayindex.hpp" -+// -+// //#include -+// #include "sigfpehandler.hpp" -+// -+// #ifdef _OPENMP -+// #include -+// #endif -+// -+// #include "typetraits.hpp" -+// -+// using namespace std; -+ -+// Mult -+// Mults right to itself, //C deletes right -+// right must always have more or same number of elements -+template -+Data_* Data_::Mult( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ // ULong rEl=right->N_Elements(); -+ ULong nEl=N_Elements(); -+ // assert( rEl); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ if( nEl == 1) -+ { -+ (*this)[0] *= (*right)[0]; -+ return this; -+ } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ mThis *= mRight; -+ return this; -+#else -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] *= (*right)[i]; -+ } //C delete right; -+ return this; -+#endif -+ -+} -+// invalid types -+template<> -+Data_* Data_::Mult( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::Mult( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::Mult( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+ -+template -+Data_* Data_::MultS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ if( nEl == 1) -+ { -+ (*this)[0] *= (*right)[0]; -+ return this; -+ } -+ Ty s = (*right)[0]; -+ // right->Scalar(s); -+ // dd *= s; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ mThis *= s; -+ return this; -+#else -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] *= s; -+ } //C delete right; -+ return this; -+#endif -+ -+} -+// invalid types -+template<> -+Data_* Data_::MultS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::MultS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::MultS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+ -+#endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_op_new.cpp gdl/src/basic_op_new.cpp ---- gdl-0.9.3/src/basic_op_new.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_op_new.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -54,7 +54,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] & (*right)[i]; // & Ty(1); - } - return res; -@@ -86,7 +86,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for ( int i=0; i < nEl; ++i ) -+ for ( OMPInt i=0; i < nEl; ++i ) - if ( (*right)[i] == zero ) (*res)[i] = zero; else (*res)[i] = (*this)[i]; - } - return res; -@@ -110,7 +110,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*res)[i] = (*right)[i]; else (*res)[i] = zero; - } - return res; -@@ -135,7 +135,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if ( (*right)[i] == zero ) (*res)[i] = zero; else (*res)[i] = (*this)[i]; - } - return res; -@@ -159,22 +159,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*res)[i] = (*right)[i]; else (*res)[i] = zero; - } - return res; - } - // invalid types --DStructGDL* DStructGDL::AndOpNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::AndOpInvNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::AndOpNew( BaseGDL* r) - { -@@ -245,7 +235,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared(s) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] & s; - } - return res; -@@ -291,7 +281,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*res)[i] = s; else (*res)[i] = zero; - } - return res; -@@ -332,29 +322,13 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*res)[i] = s; else (*res)[i] = zero; - } - return res; - } - } - // invalid types --DStructGDL* DStructGDL::AndOpSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::AndOpInvSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --// template<> --// DStructGDL* DStructGDL::AndOpInvNew( BaseGDL* r) --// { --// throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); --// return res; --// } - template<> - Data_* Data_::AndOpSNew( BaseGDL* r) - { -@@ -418,7 +392,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] | (*right)[i]; // | Ty(1); - } - //C delete right; -@@ -451,7 +425,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*res)[i] = (*right)[i]; else (*res)[i] = (*this)[i]; - } //C delete right; - return res; -@@ -475,7 +449,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*right)[i] != zero) (*res)[i] = (*right)[i]; else (*res)[i] = (*this)[i]; - } //C delete right; - return res; -@@ -501,7 +475,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*res)[i] = (*right)[i]; else (*res)[i] = (*this)[i]; - } //C delete right; - return res; -@@ -525,22 +499,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*right)[i] != zero) (*res)[i] = (*right)[i]; else (*res)[i] = (*this)[i]; - } //C delete right; - return res; - } - // invalid types --DStructGDL* DStructGDL::OrOpNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::OrOpInvNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::OrOpNew( BaseGDL* r) - { -@@ -595,7 +559,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] | s; - } //C delete right; - return res; -@@ -628,7 +592,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*res)[i] = s; else (*res)[i] = (*this)[i]; - } - return res; -@@ -664,7 +628,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*res)[i] = s; else (*res)[i] = zero; - } - return res; -@@ -691,7 +655,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] == zero) (*res)[i] = s; else (*res)[i] = (*this)[i]; - } - return res; -@@ -725,23 +689,13 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] != zero) (*res)[i] = s; else (*res)[i] = zero; - } - return res; - } - } - // invalid types --DStructGDL* DStructGDL::OrOpSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::OrOpInvSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::OrOpSNew( BaseGDL* r) - { -@@ -805,7 +759,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] ^ s; - } - return res; -@@ -817,7 +771,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] ^ (*right)[i]; - } - return res; -@@ -836,11 +790,6 @@ - throw GDLException("Cannot apply operation to datatype DOUBLE.",true,false); - return NULL; - } --DStructGDL* DStructGDL::XorOpNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::XorOpNew( BaseGDL* r) - { -@@ -893,7 +842,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] ^ s; - } - return res; -@@ -914,11 +863,6 @@ - return NULL; - } - // invalid types --DStructGDL* DStructGDL::XorOpSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::XorOpSNew( BaseGDL* r) - { -@@ -970,14 +914,24 @@ - return res; - } - -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mThis + mRight; -+ return res; -+#else -+ - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] + (*right)[i]; - } //C delete right; - return res; -+#endif - } - - template -@@ -1005,23 +959,13 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*right)[i] + (*this)[i]; - } //C delete right; - return res; - } - - // invalid types --DStructGDL* DStructGDL::AddNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::AddInvNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::AddNew( BaseGDL* r) - { -@@ -1055,14 +999,24 @@ - return res; - } - Ty s = (*right)[0]; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mThis + s; -+ return res; -+#else -+ - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] + s; - } //C delete right; - return res; -+#endif -+ - } - template - BaseGDL* Data_::AddInvSNew( BaseGDL* r) -@@ -1086,23 +1040,13 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = s + (*this)[i]; - } //C delete right; - return res; - } - - // invalid types --DStructGDL* DStructGDL::AddSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::AddInvSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::AddSNew( BaseGDL* r) - { -@@ -1145,25 +1089,44 @@ - Ty s; - if( right->StrictScalar(s)) - { -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mThis - s; -+ return res; -+#else - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] - s; - } -+ return res; -+#endif -+ - } - else - { -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mThis - mRight; -+ return res; -+#else - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] - (*right)[i]; - } -- } - return res; -+#endif -+ } - } - // inverse substraction: left=right-left - template -@@ -1181,26 +1144,25 @@ - (*res)[0] = (*right)[0] - (*this)[0]; - return res; - } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mRight - mThis; -+ return res; -+#else - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*right)[i] - (*this)[i]; - } - return res; -+#endif - } - // invalid types --DStructGDL* DStructGDL::SubNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::SubInvNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::SubNew( BaseGDL* r) - { -@@ -1253,15 +1215,24 @@ - } - - Ty s = (*right)[0]; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mThis - s; -+ return res; -+#else - - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] - s; - } - return res; -+#endif -+ - } - // inverse substraction: left=right-left - template -@@ -1282,26 +1253,25 @@ - Ty s = (*right)[0]; - // right->Scalar(s); - // dd = s - dd; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = s - mThis; -+ return res; -+#else - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = s - (*this)[i]; - } - return res; -+#endif -+ - } - // invalid types --DStructGDL* DStructGDL::SubSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::SubInvSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - BaseGDL* Data_::SubSNew( BaseGDL* r) - { -@@ -1359,17 +1329,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] > (*right)[i]) (*res)[i] = (*right)[i]; else (*res)[i] = (*this)[i]; - } //C delete right; - return res; - } - // invalid types --DStructGDL* DStructGDL::LtMarkNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::LtMarkNew( BaseGDL* r) - { -@@ -1421,17 +1386,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] > s) (*res)[i] = s; else (*res)[i] = (*this)[i]; - } //C delete right; - return res; - } - // invalid types --DStructGDL* DStructGDL::LtMarkSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::LtMarkSNew( BaseGDL* r) - { -@@ -1485,17 +1445,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] < (*right)[i]) (*res)[i] = (*right)[i]; else (*res)[i] = (*this)[i]; - } //C delete right; - return res; - } - // invalid types --DStructGDL* DStructGDL::GtMarkNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::GtMarkNew( BaseGDL* r) - { -@@ -1547,17 +1502,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - if( (*this)[i] < s) (*res)[i] = s; else (*res)[i] = (*this)[i]; - } ; - return res; - } - // invalid types --DStructGDL* DStructGDL::GtMarkSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::GtMarkSNew( BaseGDL* r) - { -@@ -1609,21 +1559,26 @@ - (*res)[0] = (*this)[0] * (*right)[0]; - return res; - } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mThis * mRight; -+ return res; -+#else - TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = (*this)[i] * (*right)[i]; - } //C delete right; - return res; -+#endif -+ - } - // invalid types --DStructGDL* DStructGDL::MultNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::MultNew( BaseGDL* r) - { -@@ -1659,21 +1614,25 @@ - return res; - } - Ty s = ( *right ) [0]; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mThis * s; -+ return res; -+#else - TRACEOMP ( __FILE__, __LINE__ ) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for ( int i=0; i < nEl; ++i ) -+ for ( OMPInt i=0; i < nEl; ++i ) - (*res ) [i] = (*this )[i] * s; - } - return res; -+#endif -+ - } - // invalid types --DStructGDL* DStructGDL::MultSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::MultSNew( BaseGDL* r) - { -@@ -1724,7 +1683,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - if( (*right)[ix] != this->zero) - (*res)[ix] = (*this)[ix] / (*right)[ix]; - else -@@ -1759,7 +1718,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - if( (*this)[ix] != this->zero) - (*res)[ix] = (*right)[ix] / (*this)[ix]; - else -@@ -1769,16 +1728,6 @@ - } - } - // invalid types --DStructGDL* DStructGDL::DivNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::DivInvNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::DivNew( BaseGDL* r) - { -@@ -1878,7 +1827,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - if( (*this)[ix] != this->zero) - (*res)[ix] = s / (*this)[ix]; - else -@@ -1888,16 +1837,6 @@ - } - } - // invalid types --DStructGDL* DStructGDL::DivSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::DivInvSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::DivSNew( BaseGDL* r) - { -@@ -1963,7 +1902,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - if( (*right)[ix] != this->zero) - (*res)[ix] = (*this)[ix] % (*right)[ix]; - else -@@ -1996,7 +1935,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - if( (*this)[ix] != this->zero) - (*res)[ix] = (*right)[ix] % (*this)[ix]; - else -@@ -2032,7 +1971,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo((*this)[i],(*right)[i]); - } - return res; -@@ -2058,7 +1997,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo((*right)[i],(*this)[i]); - } - return res; -@@ -2090,7 +2029,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo((*this)[i],(*right)[i]); - } - return res; -@@ -2116,22 +2055,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo((*right)[i],(*this)[i]); - } - return res; - } - // invalid types --DStructGDL* DStructGDL::ModNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::ModInvNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::ModNew( BaseGDL* r) - { -@@ -2260,7 +2189,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int ix=i; ix < nEl; ++ix) -+ for( OMPInt ix=i; ix < nEl; ++ix) - if( (*this)[ix] != this->zero) - (*res)[ix] = s % (*this)[ix]; - else -@@ -2289,7 +2218,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo((*this)[i],s); - } - return res; -@@ -2315,7 +2244,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo(s,(*this)[i]); - } - return res; -@@ -2340,7 +2269,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo((*this)[i],s); - } - return res; -@@ -2366,22 +2295,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = Modulo(s,(*this)[i]); - } - return res; - } - // invalid types --DStructGDL* DStructGDL::ModSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::ModInvSNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::ModSNew( BaseGDL* r) - -@@ -2491,7 +2410,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); // valarray - } //C delete right; - return res; -@@ -2515,7 +2434,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*right)[i], (*this)[i]); - } - return res; -@@ -2529,12 +2448,6 @@ - throw GDLException("Internal error: Data_::PowIntNew called.",true,false); - return NULL; - } --DStructGDL* DStructGDL::PowIntNew( BaseGDL* r) --{ -- assert( 0); -- throw GDLException("Internal error: DStructGDL::PowIntNew called.",true,false); -- return NULL; --} - // floats power of value with GDL_LONG: left=left ^ right - template<> - Data_* Data_::PowIntNew( BaseGDL* r) -@@ -2553,7 +2466,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], r0); - } return res; - } -@@ -2565,7 +2478,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[ i] = pow( s0, (*right)[ i]); - } return res; - } -@@ -2576,7 +2489,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } return res; - } -@@ -2587,7 +2500,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } return res; - } -@@ -2598,7 +2511,7 @@ - DLongGDL* right=static_cast(r); - - ULong rEl=right->N_Elements(); -- ULong nEl=N_Elements(); Data_* res = NewResult(); -+ ULong nEl=N_Elements(); - assert( rEl); - assert( nEl); - if( r->StrictScalar()) -@@ -2609,7 +2522,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], r0); - } return res; - } -@@ -2621,7 +2534,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[ i] = pow( s0, (*right)[ i]); - } return res; - } -@@ -2632,7 +2545,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } return res; - } -@@ -2643,7 +2556,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } return res; - } -@@ -2667,7 +2580,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } - return res; -@@ -2690,7 +2603,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*right)[i], (*this)[i]); - } //C delete right; - return res; -@@ -2713,7 +2626,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } - return res; -@@ -2737,7 +2650,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*right)[i], (*this)[i]); - } //C delete right; - return res; -@@ -2768,7 +2681,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } - return res; -@@ -2937,7 +2850,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*right)[i], (*this)[i]); - } - return res; -@@ -2967,7 +2880,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], (*right)[i]); - } - return res; -@@ -3131,22 +3044,12 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*right)[i], (*this)[i]); - } - return res; - } - // invalid types --DStructGDL* DStructGDL::PowNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} --DStructGDL* DStructGDL::PowInvNew( BaseGDL* r) --{ -- throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -- return NULL; --} - template<> - Data_* Data_::PowNew( BaseGDL* r) - { -@@ -3203,7 +3106,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( (*this)[i], s); - } - //C delete right; -@@ -3228,7 +3131,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = pow( s, (*this)[i]); - } //C delete right; - return res; -@@ -3257,7 +3160,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i - Data_* Data_::PowSNew( BaseGDL* r) - { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_op_sub.cpp gdl/src/basic_op_sub.cpp ---- gdl-0.9.3/src/basic_op_sub.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/basic_op_sub.cpp 2013-07-31 09:41:43.731246423 -0600 -@@ -0,0 +1,439 @@ -+/*************************************************************************** -+ basic_op_sub.cpp - GDL sub (-) operators -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002 by Marc Schellens -+ email : m_schellens@users.sf.net -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+// to be included from datatypes.cpp -+#ifdef INCLUDE_BASIC_OP_CPP -+ -+// // header in datatypes.hpp -+// -+// //#include "datatypes.hpp" -+// //#include "dstructgdl.hpp" -+// //#include "arrayindex.hpp" -+// -+// //#include -+// #include "sigfpehandler.hpp" -+// -+// #ifdef _OPENMP -+// #include -+// #endif -+// -+// #include "typetraits.hpp" -+// -+// using namespace std; -+ -+ -+// Sub -+// substraction: left=left-right -+template -+BaseGDL* Data_::Sub( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong rEl=right->N_Elements(); -+ ULong nEl=N_Elements(); -+ assert( rEl); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ if( nEl == 1) -+ { -+ (*this)[0] -= (*right)[0]; -+ return this; -+ } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ mThis -= mRight; -+ return this; -+#else -+ -+ if( nEl == rEl) -+ dd -= right->dd; -+ else -+ { -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] -= (*right)[i]; -+ }} //C delete right; -+ return this; -+#endif -+ -+} -+// inverse substraction: left=right-left -+template -+BaseGDL* Data_::SubInv( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong rEl=right->N_Elements(); -+ ULong nEl=N_Elements(); -+ assert( rEl); -+ assert( nEl); -+ // if( !rEl || !nEl) throw GDLException("Variable is undefined."); -+ /* if( nEl == rEl) -+ dd = right->dd - dd; -+ else*/ -+ if( nEl == 1) -+ { -+ (*this)[0] = (*right)[0] - (*this)[0]; -+ return this; -+ } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRight(&(*right)[0], nEl); -+ mThis = mRight - mThis; -+ return this; -+#else -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] = (*right)[i] - (*this)[i]; -+ } //C delete right; -+ return this; -+#endif -+ -+} -+// invalid types -+template<> -+BaseGDL* Data_::Sub( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+BaseGDL* Data_::SubInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+BaseGDL* Data_::Sub( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+BaseGDL* Data_::SubInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+BaseGDL* Data_::Sub( BaseGDL* r) -+{ -+ // overload here -+ Data_* self; -+ DSubUD* plusOverload; -+ -+ ProgNodeP callingNode = interpreter->GetRetTree(); -+ -+ if( !Scalar()) -+ { -+ if( r->Type() == GDL_OBJ && r->Scalar()) -+ { -+ self = static_cast( r); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -+ if( plusOverload == NULL) -+ { -+ throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -+ } -+ } -+ else -+ { -+ throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -+ } -+ } -+ else -+ { -+ // Scalar() -+ self = static_cast( this); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -+ if( plusOverload == NULL) -+ { -+ if( r->Type() == GDL_OBJ && r->Scalar()) -+ { -+ self = static_cast( r); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -+ if( plusOverload == NULL) -+ { -+ throw GDLException(callingNode,"Cannot apply not overloaded operator to datatype OBJECT.",true, false); -+ } -+ } -+ else -+ { -+ throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -+ } -+ } -+ } -+ -+ assert( self->Scalar()); -+ assert( plusOverload != NULL); -+ -+ // hidden SELF is counted as well -+ int nParSub = plusOverload->NPar(); -+ assert( nParSub >= 1); // SELF -+ if( nParSub < 3) // (SELF), LEFT, RIGHT -+ { -+ throw GDLException( callingNode, plusOverload->ObjectName() + -+ ": Incorrect number of arguments.", -+ false, false); -+ } -+ EnvUDT* newEnv; -+ Guard selfGuard; -+ BaseGDL* thisP; -+ // Dup() here is not optimal -+ // avoid at least for internal overload routines (which do/must not change SELF or r) -+ bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -+ if( internalDSubUD) -+ { -+ thisP = this; -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -+ newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -+ } -+ else -+ { -+ self = self->Dup(); -+ selfGuard.Init( self); -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -+ newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -+ } -+ -+ -+ // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -+ StackGuard guard(interpreter->CallStack()); -+ -+ interpreter->CallStack().push_back( newEnv); -+ -+ // make the call -+ BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -+ -+ if( !internalDSubUD && self != selfGuard.Get()) -+ { -+ // always put out warning first, in case of a later crash -+ Warning( "WARNING: " + plusOverload->ObjectName() + -+ ": Assignment to SELF detected (GDL session still ok)."); -+ // assignment to SELF -> self was deleted and points to new variable -+ // which it owns -+ selfGuard.Release(); -+ if( static_cast(self) != NullGDL::GetSingleInstance()) -+ selfGuard.Reset(self); -+ } -+ return res; -+} -+template<> -+BaseGDL* Data_::SubInv( BaseGDL* r) -+{ -+ if( r->Type() == GDL_OBJ && r->Scalar()) -+ { -+ return r->Sub( this); // for right order of parameters -+ } -+ -+ // overload here -+ Data_* self; -+ DSubUD* plusOverload; -+ -+ ProgNodeP callingNode = interpreter->GetRetTree(); -+ -+ if( !Scalar()) -+ { -+ throw GDLException( callingNode, "Cannot apply operation to non-scalar datatype OBJECT.", true, false); -+ } -+ else -+ { -+ // Scalar() -+ self = static_cast( this); -+ plusOverload = static_cast(GDLInterpreter::GetObjHeapOperator( (*self)[0], OOMinus)); -+ if( plusOverload == NULL) -+ { -+ throw GDLException( callingNode, "Cannot apply not overloaded operator to datatype OBJECT.", true, false); -+ } -+ } -+ -+ assert( self->Scalar()); -+ assert( plusOverload != NULL); -+ -+ // hidden SELF is counted as well -+ int nParSub = plusOverload->NPar(); -+ assert( nParSub >= 1); // SELF -+ if( nParSub < 3) // (SELF), LEFT, RIGHT -+ { -+ throw GDLException( callingNode, plusOverload->ObjectName() + -+ ": Incorrect number of arguments.", -+ false, false); -+ } -+ EnvUDT* newEnv; -+ Guard selfGuard; -+ BaseGDL* thisP; -+ // Dup() here is not optimal -+ // avoid at least for internal overload routines (which do/must not change SELF or r) -+ bool internalDSubUD = plusOverload->GetTree()->IsWrappedNode(); -+ if( internalDSubUD) -+ { -+ thisP = this; -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ // order different to Add -+ newEnv->SetNextParUnchecked( &r); // RVALUE parameter, as reference to prevent cleanup in newEnv -+ newEnv->SetNextParUnchecked( &thisP); // LEFT parameter, as reference to prevent cleanup in newEnv -+ } -+ else -+ { -+ self = self->Dup(); -+ selfGuard.Init( self); -+ newEnv= new EnvUDT( callingNode, plusOverload, &self); -+ // order different to Add -+ newEnv->SetNextParUnchecked( r->Dup()); // RIGHT parameter, as value -+ newEnv->SetNextParUnchecked( this->Dup()); // LEFT parameter, as value -+ } -+ -+ -+ // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack -+ StackGuard guard(interpreter->CallStack()); -+ -+ interpreter->CallStack().push_back( newEnv); -+ -+ // make the call -+ BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); -+ -+ if( !internalDSubUD && self != selfGuard.Get()) -+ { -+ // always put out warning first, in case of a later crash -+ Warning( "WARNING: " + plusOverload->ObjectName() + -+ ": Assignment to SELF detected (GDL session still ok)."); -+ // assignment to SELF -> self was deleted and points to new variable -+ // which it owns -+ selfGuard.Release(); -+ if( static_cast(self) != NullGDL::GetSingleInstance()) -+ selfGuard.Reset(self); -+ } -+ return res; -+} -+template -+Data_* Data_::SubS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ if( nEl == 1) -+ { -+ (*this)[0] -= (*right)[0]; -+ return this; -+ } -+ -+ Ty s = (*right)[0]; -+ // right->Scalar(s); -+ // dd -= s; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ mThis -= s; -+ return this; -+#else -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] -= s; -+ } //C delete right; -+ return this; -+#endif -+ -+} -+// inverse substraction: left=right-left -+template -+Data_* Data_::SubInvS( BaseGDL* r) -+{ -+ Data_* right=static_cast(r); -+ -+ ULong nEl=N_Elements(); -+ assert( nEl); -+ -+ if( nEl == 1) -+ { -+ (*this)[0] = (*right)[0] - (*this)[0]; -+ return this; -+ } -+ -+ Ty s = (*right)[0]; -+ // right->Scalar(s); -+ // dd = s - dd; -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mThis(&(*this)[0], nEl); -+ mThis = s - mThis; -+ return this; -+#else -+ TRACEOMP( __FILE__, __LINE__) -+#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+#pragma omp for -+ for( OMPInt i=0; i < nEl; ++i) -+ (*this)[i] = s - (*this)[i]; -+ } //C delete right; -+ return this; -+#endif -+ -+} -+// invalid types -+template<> -+Data_* Data_::SubS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::SubInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRING.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::SubS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::SubInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype PTR.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::SubS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+template<> -+Data_* Data_::SubInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype OBJECT.",true,false); -+ return this; -+} -+ -+ -+#endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_pro.cpp gdl/src/basic_pro.cpp ---- gdl-0.9.3/src/basic_pro.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_pro.cpp 2013-07-31 09:41:43.741246388 -0600 -@@ -19,6 +19,9 @@ - - #include "includefirst.hpp" - -+#include -+#include -+ - #include - #include - #include -@@ -80,57 +83,70 @@ - static int vectorEableIx = e->KeywordIx( "VECTOR_ENABLE"); - - bool reset = e->KeywordSet( resetIx); -+ bool restore = e->KeywordSet( restoreIx); -+ if ((reset) && (restore)) e->Throw("Conflicting keywords."); -+ - bool vectorEnable = e->KeywordSet( vectorEableIx); - -+ DLong NbCOREs=1; -+#ifdef _OPENMP -+ NbCOREs=omp_get_num_procs(); -+#endif -+ - DLong locCpuTPOOL_NTHREADS=CpuTPOOL_NTHREADS; - DLong locCpuTPOOL_MIN_ELTS=CpuTPOOL_MIN_ELTS; - DLong locCpuTPOOL_MAX_ELTS=CpuTPOOL_MAX_ELTS; - -+ // reading the Tag Index of the variable parts in !CPU - DStructGDL* cpu = SysVar::Cpu(); -- - static unsigned NTHREADSTag = cpu->Desc()->TagIndex( "TPOOL_NTHREADS"); - static unsigned TPOOL_MIN_ELTSTag = cpu->Desc()->TagIndex( "TPOOL_MIN_ELTS"); - static unsigned TPOOL_MAX_ELTSTag = cpu->Desc()->TagIndex( "TPOOL_MAX_ELTS"); - - if( reset) -- { --#ifdef _OPENMP -- locCpuTPOOL_NTHREADS = omp_get_num_procs(); --#endif -+ { -+ locCpuTPOOL_NTHREADS = NbCOREs; - locCpuTPOOL_MIN_ELTS = DefaultTPOOL_MIN_ELTS; - locCpuTPOOL_MAX_ELTS = DefaultTPOOL_MAX_ELTS; -- } -+ } - else if( e->KeywordPresent( restoreIx)) -- { -+ { - DStructGDL* restoreCpu = e->GetKWAs( restoreIx); -- -+ - if( restoreCpu->Desc() != cpu->Desc()) -- e->Throw("RESTORE must be set to an instance with the same struct layout as {!CPU}"); -- -+ e->Throw("RESTORE must be set to an instance with the same struct layout as {!CPU}"); -+ - locCpuTPOOL_NTHREADS = (*(static_cast( restoreCpu->GetTag( NTHREADSTag, 0))))[0]; - locCpuTPOOL_MIN_ELTS = (*(static_cast( restoreCpu->GetTag( TPOOL_MIN_ELTSTag, 0))))[0]; - locCpuTPOOL_MAX_ELTS= (*(static_cast( restoreCpu->GetTag( TPOOL_MAX_ELTSTag, 0))))[0]; -- } -+ } - else -- { -- if( e->KeywordPresent(nThreadsIx)) -- { -- e->AssureLongScalarKW(nThreadsIx, locCpuTPOOL_NTHREADS); -- } -- if( e->KeywordPresent(min_eltsIx)) -- { -- e->AssureLongScalarKW(min_eltsIx, locCpuTPOOL_MIN_ELTS); -- } -- if( e->KeywordPresent(max_eltsIx)) -- { -- e->AssureLongScalarKW(max_eltsIx, locCpuTPOOL_MAX_ELTS); -- } -- } -- -- // update here all together in case of error -+ { -+ if( e->KeywordPresent(nThreadsIx)) -+ { -+ e->AssureLongScalarKW(nThreadsIx, locCpuTPOOL_NTHREADS); -+ } -+ if( e->KeywordPresent(min_eltsIx)) -+ { -+ e->AssureLongScalarKW(min_eltsIx, locCpuTPOOL_MIN_ELTS); -+ } -+ if( e->KeywordPresent(max_eltsIx)) -+ { -+ e->AssureLongScalarKW(max_eltsIx, locCpuTPOOL_MAX_ELTS); -+ } -+ } - -+ // update here all together in case of error -+ - #ifdef _OPENMP -- CpuTPOOL_NTHREADS=locCpuTPOOL_NTHREADS; -+ //cout < 0) { -+ CpuTPOOL_NTHREADS=locCpuTPOOL_NTHREADS; -+ } else { -+ CpuTPOOL_NTHREADS=NbCOREs; -+ } -+ if (CpuTPOOL_NTHREADS > NbCOREs) -+ Warning("CPU : Warning: Using more threads ("+i2s(CpuTPOOL_NTHREADS)+") than the number of CPUs in the system ("+i2s(NbCOREs)+") will degrade performance."); - #else - CpuTPOOL_NTHREADS=1; - #endif -@@ -170,32 +186,86 @@ - return; - } - os.width(10); -- os << par->TypeStr() << right; -- -- if( !doIndentation) os << "= "; -- -+ bool doTypeString = true; -+ - // Data display - if( par->Type() == GDL_STRUCT) - { -- DStructGDL* s = static_cast( par); -+ os << par->TypeStr() << right; -+ if( !doIndentation) os << "= "; -+ doTypeString = false; -+ -+ DStructGDL* s = static_cast( par); - os << "-> "; - os << (s->Desc()->IsUnnamed()? "" : s->Desc()->Name()); - os << " "; - } - else if( par->Dim( 0) == 0) -+ { -+ if (par->Type() == GDL_STRING) - { -- if (par->Type() == GDL_STRING) -- { -- // trim string larger than 45 characters -- DString dataString = (*static_cast(par))[0]; -- os << "'" << StrMid( dataString,0,45,0) << "'"; -- if( dataString.length() > 45) os << "..."; -- } -- else -- { -- par->ToStream( os); -+ os << par->TypeStr() << right; -+ if( !doIndentation) os << "= "; -+ doTypeString = false; -+ -+ // trim string larger than 45 characters -+ DString dataString = (*static_cast(par))[0]; -+ os << "'" << StrMid( dataString,0,45,0) << "'"; -+ if( dataString.length() > 45) os << "..."; -+ } -+ else if (par->Type() == GDL_OBJ && par->StrictScalar()) -+ { -+ DObj s = (*static_cast(par))[0]; // is StrictScalar() -+ if( s != 0) // no overloads for null object -+ { -+ DStructGDL* oStructGDL= GDLInterpreter::GetObjHeapNoThrow( s); -+ if( oStructGDL != NULL) // if object not valid -> default behaviour -+ { -+ DStructDesc* desc = oStructGDL->Desc(); -+ static DString listName("LIST"); -+ if( desc->IsParent(listName)) -+ { -+ os << desc->Name(); -+ -+ unsigned nListTag = desc->TagIndex( "NLIST"); -+ DLong nList = (*static_cast(oStructGDL->GetTag( nListTag, 0)))[0]; -+ os << left; -+ os << ""; -+ -+ doTypeString = false; -+ } -+ static DString hashName("HASH"); -+ if( desc->IsParent(hashName)) -+ { -+ os << desc->Name(); -+ -+ unsigned nListTag = desc->TagIndex( "TABLE_COUNT"); -+ DLong nList = (*static_cast(oStructGDL->GetTag( nListTag, 0)))[0]; -+ os << left; -+ os << ""; -+ -+ doTypeString = false; -+ } - } -+ } -+ } -+ if( doTypeString) -+ { -+ os << par->TypeStr() << right; -+ if( !doIndentation) os << "= "; -+ doTypeString = false; -+ -+ par->ToStream( os); - } -+ } -+ -+ if( doTypeString) -+ { -+ os << par->TypeStr() << right; -+ if( !doIndentation) os << "= "; -+ } - - // Dimension display - if( par->Dim( 0) != 0) os << par->Dim(); -@@ -237,10 +307,113 @@ - return recall_commands_internal(); - } - -- void help( EnvT* e) -+ void help_path_cached() // showing HELP, /path_cache - { -+ DIR *dirp; -+ struct dirent *dp; -+ const char *ProSuffix=".pro"; -+ int ProSuffixLen = strlen(ProSuffix); -+ int NbProFilesInCurrentDir; -+ string tmp_fname; -+ size_t found; -+ -+ StrArr path=SysVar::GDLPath(); -+ -+ cout << "!PATH (no cache managment in GDL, "<< path.size() << " directories)" << endl; -+ -+ for( StrArr::iterator CurrentDir=path.begin(); CurrentDir != path.end(); CurrentDir++) -+ { -+ NbProFilesInCurrentDir=0; -+ dirp = opendir((*CurrentDir).c_str()); -+ while ((dp = readdir(dirp)) != NULL){ -+ tmp_fname=dp->d_name; -+ found = tmp_fname.rfind(ProSuffix); -+ if (found!=std::string::npos) { -+ if ((found+ProSuffixLen) == tmp_fname.length()) NbProFilesInCurrentDir++; -+ } -+ } -+ cout << *CurrentDir << " (" << NbProFilesInCurrentDir << " files)" << endl; -+ } -+ } -+ -+ void help( EnvT* e) -+ { - bool kw = false; -+ //if LAST_MESSAGE is present, it is the only otput. All other kw are ignored. -+ static int lastmKWIx = e->KeywordIx("LAST_MESSAGE"); -+ bool lastmKW = e->KeywordPresent( lastmKWIx); -+ if( lastmKW) -+ { -+ DStructGDL* errorState = SysVar::Error_State(); -+ static unsigned msgTag = errorState->Desc()->TagIndex( "MSG"); -+ cout << (*static_cast( errorState->GetTag( msgTag)))[0]<< endl; -+ return; -+ } -+ -+ static int helpKWIx = e->KeywordIx("HELP"); -+ bool helpKW= e->KeywordPresent(helpKWIx); -+ if( helpKW) { -+ string inline_help[]={"Usage: "+e->GetProName()+", expr1, ..., exprN,", -+ " /BRIEF, /CALLS, /FUNCTIONS, /HELP, /INFO,", -+ " /INTERNAL_LIB_GDL, /LAST_MESSAGE, /LIB, /MEMORY,", -+ " /OUTPUT, /PATH_CACHE, /PREFERENCES, /PROCEDURES,", -+ " /RECALL_COMMANDS, /ROUTINES, /SOURCE_FILES, /STRUCTURES,"}; -+ int size_of_s = sizeof(inline_help) / sizeof(inline_help[0]); -+ e->Help(inline_help, size_of_s); -+ } -+ -+ static int pathKWIx = e->KeywordIx("PATH_CACHE"); -+ bool pathKW= e->KeywordPresent(pathKWIx); -+ if( pathKW) { -+ help_path_cached(); -+ return; -+ } -+ -+ static int sourceFilesKWIx = e->KeywordIx("SOURCE_FILES"); -+ bool sourceFilesKW = e->KeywordPresent( sourceFilesKWIx); -+ if( sourceFilesKW) -+ { -+ vector sourceFiles; -+ -+ for(FunListT::iterator i=funList.begin(); i != funList.end(); ++i) -+ { -+ string funFile = (*i)->GetFilename(); -+ bool alreadyInList = false; -+ for(vector::iterator i2=sourceFiles.begin(); i2 != sourceFiles.end(); ++i2) -+ { -+ if( funFile == *i2) -+ { -+ alreadyInList = true; -+ break; -+ } -+ } -+ if( !alreadyInList) -+ sourceFiles.push_back(funFile); -+ } -+ for(ProListT::iterator i=proList.begin(); i != proList.end(); ++i) -+ { -+ string proFile = (*i)->GetFilename(); -+ bool alreadyInList = false; -+ for(vector::iterator i2=sourceFiles.begin(); i2 != sourceFiles.end(); ++i2) -+ { -+ if( proFile == *i2) -+ { -+ alreadyInList = true; -+ break; -+ } -+ } -+ if( !alreadyInList) -+ sourceFiles.push_back(proFile); -+ } -+ // sourceFiles now contains a uniqe list of all file names. -+ sort( sourceFiles.begin(), sourceFiles.end()); - -+ SizeT nSourceFiles = sourceFiles.size(); -+ cout << "Source files (" << nSourceFiles <<"):" << endl; -+ for( SizeT i = 0; iKeywordIx("CALLS"); - bool callsKW = e->KeywordPresent( callsKWIx); - if( callsKW) -@@ -253,18 +426,22 @@ - - DStringGDL* retVal = new DStringGDL( dimension( level-1), BaseGDL::NOZERO); - SizeT rIx = 0; -- for( EnvStackT::reverse_iterator r = cS.rbegin()+1; r != cS.rend(); ++r) -+// for( EnvStackT::reverse_iterator r = cS.rbegin()+1; r != cS.rend(); ++r) -+ for( long ix = cS.size()-2; ix >= 0; --ix) - { -+ EnvUDT** r = &cS[ ix]; - EnvBaseT* actEnv = *r; - assert( actEnv != NULL); - - DString actString = actEnv->GetProName(); - DSubUD* actSub = dynamic_cast(actEnv->GetPro()); -- if( (r+1) != cS.rend() && actSub != NULL) -+// if( (r+1) != cS.rend() && actSub != NULL) -+ if( (ix-1) >= 0 && actSub != NULL) - { - actString += " <"+actSub->GetFilename() + "("; -- if( (*(r-1))->CallingNode() != NULL) -- actString += i2s( (*(r-1))->CallingNode()->getLine(), 4); -+ EnvUDT** r_1 = &cS[ ix+1]; -+ if( (*(r_1))->CallingNode() != NULL) -+ actString += i2s( (*(r_1))->CallingNode()->getLine(), 4); - else - actString += " ?"; - actString += ")>"; -@@ -294,7 +471,7 @@ - { - kw = true; - -- deque subList; -+ vector subList; - SizeT nPro = libProList.size(); - for( SizeT i = 0; iKeywordSet( "LIB_GDL_INTERNAL"); -+ bool kwLibInternal = e->KeywordSet( "INTERNAL_LIB_GDL"); - if( kwLibInternal) - { - kw = true; - -- deque subList; -+ vector subList; - SizeT nPro = libProList.size(); - for( SizeT i = 0; i pList; -- deque fList; -+ vector pList; -+ vector fList; - - // If OUTPUT keyword set then set up output string array (outputKW) - BaseGDL** outputKW = NULL; -@@ -998,11 +1175,11 @@ - - BaseGDL* p= e->GetParDefined( 0); - -- DObjGDL* op= dynamic_cast(p); -- if( op == NULL) -+ if( p->Type() != GDL_OBJ) - e->Throw( "Parameter must be an object in" - " this context: "+ - e->GetParString(0)); -+ DObjGDL* op= static_cast(p); - - SizeT nEl=op->N_Elements(); - for( SizeT i=0; i(e->Interpreter()->CallStack().back()); - EnvT* newEnv = e->NewEnv( libProList[ proIx], 1); -- auto_ptr guard( newEnv); -+ Guard guard( newEnv); - static_cast(newEnv->GetPro())->Pro()(newEnv); - } - else -@@ -1071,7 +1248,7 @@ - if( method == NULL) - e->Throw( "Method not found: "+callP); - -- e->PushNewEnvUD( method, 2, &e->GetPar( 1)); -+ e->PushNewEnvUD( method, 2,(DObjGDL**) &e->GetPar( 1)); - - // the call - e->Interpreter()->call_pro( method->GetTree()); -@@ -1218,14 +1395,14 @@ - " Unit: "+i2s( lun)+", File: "+fileUnits[ lun-1].Name(); - - if( !errorKeyword) -- throw GDLIOException( e->CallingNode(), errorMsg); -+ throw GDLIOException( ex.ErrorCode(), e->CallingNode(), errorMsg); - - BaseGDL** err = &e->GetKW( errorIx); - -- GDLDelete((*err)); -+ GDLDelete(*err); - // if( *err != e->Caller()->Object()) delete (*err); - -- *err = new DLongGDL( 1); -+ *err = new DLongGDL( ex.ErrorCode()); - return; - } - -@@ -1510,6 +1687,17 @@ - p->Write( *os, swapEndian, compress, xdrs); - } - } -+ -+ BaseGDL* p = e->GetParDefined( nParam-1); -+ SizeT cc=p->Dim(0); -+ BaseGDL** tcKW=NULL; -+ static int tcIx = e->KeywordIx( "TRANSFER_COUNT"); -+ if( e->KeywordPresent( tcIx)) { -+ BaseGDL* p = e->GetParDefined( nParam-1); -+ tcKW = &e->GetKW( tcIx); -+ GDLDelete((*tcKW)); -+ *tcKW= new DLongGDL(p->N_Elements()); -+ } - } - - void readu( EnvT* e) -@@ -1668,6 +1856,17 @@ - recvBuf->erase(0, pos); - } - } -+ -+ BaseGDL* p = e->GetParDefined( nParam-1); -+ SizeT cc=p->Dim(0); -+ BaseGDL** tcKW=NULL; -+ static int tcIx = e->KeywordIx( "TRANSFER_COUNT"); -+ if( e->KeywordPresent( tcIx)) { -+ BaseGDL* p = e->GetParDefined( nParam-1); -+ tcKW = &e->GetKW( tcIx); -+ GDLDelete((*tcKW)); -+ *tcKW= new DLongGDL(p->N_Elements()); -+ } - } - - void on_error( EnvT* e) -@@ -1677,11 +1876,11 @@ - - void catch_pro( EnvT* e) - { -- static bool warned = false; -- if (!warned) { -- Warning("CATCH: feature not implemented yet (FIXME!)."); -- warned = true; -- } -+// static bool warned = false; -+// if (!warned) { -+// Warning("CATCH: feature not implemented yet (FIXME!)."); -+// warned = true; -+// } - e->Catch(); - } - -@@ -1689,11 +1888,12 @@ - { - SizeT nParam = e->NParam( 2); - -- DStringGDL* dest = dynamic_cast( e->GetParGlobal( 0)); -- if( dest == NULL) -+ BaseGDL* p0 = e->GetParGlobal( 0); -+ if( p0->Type() != GDL_STRING) - e->Throw( "String expression required in this context: "+ - e->GetParString(0)); -- -+ DStringGDL* dest = static_cast( p0); -+ - DString source; - e->AssureStringScalarPar( 1, source); - -@@ -1709,7 +1909,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; iThrow( "Conflicting definition for "+sysVarNameFull+"."); - - // if struct -> assure equal descriptors -- DStructGDL *oldStruct = dynamic_cast( oldVar); -- if( oldStruct != NULL) -+ if( oldVar->Type() == GDL_STRUCT) - { -+ DStructGDL *oldStruct = static_cast( oldVar); - // types are same -> static cast - DStructGDL *newStruct = static_cast( newVar); - -@@ -1827,8 +2027,6 @@ - { - SizeT nParam = e->NParam(); - -- if( nParam == 0) return; -- - static int continueIx = e->KeywordIx( "CONTINUE"); - static int infoIx = e->KeywordIx( "INFORMATIONAL"); - static int ioerrorIx = e->KeywordIx( "IOERROR"); -@@ -1836,6 +2034,7 @@ - static int noprefixIx = e->KeywordIx( "NOPREFIX"); - static int noprintIx = e->KeywordIx( "NOPRINT"); - static int resetIx = e->KeywordIx( "RESET"); -+ static int reissueIx = e->KeywordIx( "REISSUE_LAST"); - - bool continueKW = e->KeywordSet( continueIx); - bool info = e->KeywordSet( infoIx); -@@ -1844,6 +2043,43 @@ - bool noprefix = e->KeywordSet( noprefixIx); - bool noprint = e->KeywordSet( noprintIx); - bool reset = e->KeywordSet( resetIx); -+ bool reissue = e->KeywordSet( reissueIx); -+ -+ if( reset) -+ { -+ DStructGDL* errorState = SysVar::Error_State(); -+ static unsigned nameTag = errorState->Desc()->TagIndex( "NAME"); -+ static unsigned blockTag = errorState->Desc()->TagIndex( "BLOCK"); -+ static unsigned codeTag = errorState->Desc()->TagIndex( "CODE"); -+ static unsigned rangeTag = errorState->Desc()->TagIndex( "RANGE"); -+ static unsigned sys_code_typeTag = errorState->Desc()->TagIndex( "SYS_CODE_TYPE"); -+ static unsigned msgTag = errorState->Desc()->TagIndex( "MSG"); -+ static unsigned sys_msgTag = errorState->Desc()->TagIndex( "SYS_MSG"); -+ static unsigned msg_prefixTag = errorState->Desc()->TagIndex( "MSG_PREFIX"); -+ -+ (*static_cast( errorState->GetTag( nameTag)))[0] = "IDL_M_SUCCESS"; -+ (*static_cast( errorState->GetTag( blockTag)))[0] = "IDL_MBLK_CORE"; -+ (*static_cast( errorState->GetTag( codeTag)))[0] = 0; -+ (*static_cast( errorState->GetTag( rangeTag)))[0] = 0; -+ (*static_cast( errorState->GetTag( rangeTag)))[1] = 0; -+ (*static_cast( errorState->GetTag( sys_code_typeTag)))[0] = ""; -+ (*static_cast( errorState->GetTag( msgTag)))[0] = ""; -+ (*static_cast( errorState->GetTag( sys_msgTag)))[0] = ""; -+ (*static_cast( errorState->GetTag( msg_prefixTag)))[0] = "% "; -+ -+ SysVar::SetErr_String( ""); -+ SysVar::SetErrError( 0); -+ } -+ -+ if( reissue ) -+ { -+ DStructGDL* errorState = SysVar::Error_State(); -+ static unsigned msgTag = errorState->Desc()->TagIndex( "MSG"); -+ if( !info || (SysVar::Quiet() == 0)) cout << (*static_cast( errorState->GetTag( msgTag)))[0]<< endl; -+ return; -+ } -+ -+ if( nParam == 0) return; - - DString msg; - e->AssureScalarPar( 0, msg); -@@ -1852,14 +2088,17 @@ - msg = e->Caller()->GetProName() + ": " + msg; - - if( !info) -- { -- DStructGDL* errorState = SysVar::Error_State(); -- static unsigned msgTag = errorState->Desc()->TagIndex( "MSG"); -- (*static_cast( errorState->GetTag( msgTag)))[0] = msg; -- -- SysVar::SetErr_String( msg); -- } -- -+ { -+ DStructGDL* errorState = SysVar::Error_State(); -+ static unsigned codeTag = errorState->Desc()->TagIndex( "CODE"); -+ (*static_cast( errorState->GetTag( codeTag)))[0] = 0; -+ static unsigned msgTag = errorState->Desc()->TagIndex( "MSG"); -+ (*static_cast( errorState->GetTag( msgTag)))[0] = msg; -+ -+ SysVar::SetErr_String( msg); -+ SysVar::SetErrError( -1); -+ } -+ - if( noprint) - msg = ""; - -@@ -1998,47 +2237,6 @@ - swapSz = 4; - - byteorderDo( e, par, swapSz, p); -- --/* if( par->Type() == GDL_STRING) -- e->Throw( "STRING type not allowed in this context: "+e->GetParString(p)); -- if( par->Type() == GDL_OBJ) -- e->Throw( "Object type not allowed in this context: "+e->GetParString(p)); -- if( par->Type() == GDL_PTR) -- e->Throw( "PTR type not allowed in this context: "+e->GetParString(p)); -- if( par->Type() == GDL_STRUCT) -- { -- if( static_cast( par)->Desc()->ContainsStringPtrObject()) -- e->Throw( "Structs must not contain PTR, OBJECT or STRING tags: "+e->GetParString(p)); -- -- if( par->N_Elements() == 1) -- { -- DStructGDL* dS = static_cast(par); -- for( SizeT t=0; tNTags(); ++t) -- { -- BaseGDL* actTag = dS->GetTag( t); -- } -- } -- } -- // e->Throw( "PTR type not allowed in this context: "+e->GetParString(p)); -- -- SizeT nBytes = par->NBytes(); -- if( nBytes % swapSz != 0) -- e->Throw( "Operand's size must be a multiple of swap " -- "datum size: " + e->GetParString(p)); -- -- SizeT nSwap = nBytes / swapSz; -- -- char* addr = static_cast(par->DataAddr()); -- -- for( SizeT i=0; iGetParString(2)); - - SizeT d1; -- int ret = p2->Scalar2index( d1); -+ int ret = p2->Scalar2Index( d1); - if( d1 < 1 || d1 > p0->Rank()) - e->Throw( "D1 (3rd) argument is out of range: "+ - e->GetParString(2)); -@@ -2461,7 +2659,7 @@ - if( !p4->StrictScalar()) - e->Throw( "Expression must be a scalar in this context: "+ - e->GetParString(4)); -- ret = p4->Scalar2index( d2); -+ ret = p4->Scalar2Index( d2); - if( d2 < 1 || d2 > p0->Rank()) - e->Throw( "D5 (5th) argument is out of range: "+ - e->GetParString(4)); -@@ -2470,7 +2668,7 @@ - } - - // ArrayIndexVectorT* ixList = new ArrayIndexVectorT(); --// auto_ptr< ArrayIndexVectorT> ixList_guard( ixList); -+// Guard< ArrayIndexVectorT> ixList_guard( ixList); - ArrayIndexVectorT ixList; - // BaseGDL* loc1 = p3->Dup(); - // loc1->SetDim (dimension( loc1->N_Elements())); -@@ -2484,7 +2682,7 @@ - ixList.push_back( new CArrayIndexScalar( (*p3)[ i]));//p3->NewIx(i))); - ArrayIndexListT* ixL; - MakeArrayIndex( &ixList, &ixL); -- auto_ptr< ArrayIndexListT> ixL_guard( ixL); -+ Guard< ArrayIndexListT> ixL_guard( ixL); - ixL->AssignAt( p0, p1); - return; - } -@@ -2499,10 +2697,10 @@ - // static int no_recompileIx = e->KeywordIx( "NO_RECOMPILE"); - - BaseGDL* p0 = e->GetParDefined( 0); -- DStringGDL* p0S = dynamic_cast( p0); -- if( p0S == NULL) -+ if( p0->Type() != GDL_STRING) - e->Throw( "Expression must be a string in this context: "+ - e->GetParString(0)); -+ DStringGDL* p0S = static_cast( p0); - - static StrArr openFiles; - -@@ -2577,6 +2775,8 @@ - //BaseGDL** ret[nParam - 1]; - BaseGDL*** ret; - ret = (BaseGDL***)malloc((nParam-1)*sizeof(BaseGDL**)); -+ GDLGuard retGuard( ret, free); -+ - for (int i = nParam - 2; i >= 0; i--) if (global[i]) - { - ret[i] = &e->GetPar(i + 1); -@@ -2656,7 +2856,138 @@ - if (global[6 - 1]) - (*static_cast(*ret[6 - 1]))[i] = F * 86400; - } -- free((void *)ret); -+ // now guarded. s. a. -+// free((void *)ret); -+ } -+ -+ bool dateToJD(DDouble &jd, DLong &day, DLong &month, DLong &year, DLong &hour, DLong &minute, DDouble &second) -+ { -+ if (year < -4716 || year > 5000000 || year==0 ) return false; -+ if (month < 1 || month > 12) return false; -+ if (day < 0 || day > 31) return false; -+ -+ // the following tests seem to be NOT active ... -+ -+ // if (hour < 0 || hour > 24) return false; -+ // if (minute < 0 || minute > 60) return false; -+ // if (second < 0 || second > 60) return false; -+ -+// fprintf(stderr,"Day %d, Month %d Year %d, Hour %d Minute %d Second %f\n", -+// day, month, year, hour, minute, second); -+ DDouble a,y,b,c; -+ DLong m; -+ y=(year>0)?year:year+1; //formula below is for *astronomical calendar* where year 0 exists. -+ // but it appears that we use here a calendar with no year 0 -+ m=month; -+ b=0.0; -+ c=0.0; -+ if (month <= 2) -+ { -+ y=y-1.0; -+ m=m+12; -+ } -+ if (y < 0) -+ { -+ c=-0.75; -+ } else { -+ if (year > 1582 || (year == 1582 && (month > 10 || -+ (month == 10 && day > 14)))) { -+ a=floor(y/100.0); -+ b=2.0-a+floor(a/4.0); -+ } else if (year == 1582 && month == 10 && day >= 5 && day <= 14) { -+ jd= 2299161; //date does not move -+ return true; -+ } -+ } -+ jd=ceil(365.25*y+c)+floor(30.6001*(m+1))+day+(hour*1.0)/24.0+(minute*1.0)/1440.0+ -+ (second*1.0)/86400.0+1720994.50+b; -+ -+ // cout << "jd :" << jd << endl; -+ return true; - } - -+ BaseGDL* julday(EnvT* e) -+ { -+ if ((e->NParam() < 3 || e->NParam() > 6)) {e->Throw("Incorrect number of arguments.");} -+ -+ DLongGDL *Month, *Day, *Year, *Hour, *Minute; -+ DDoubleGDL* Second; -+ DDouble jd; -+ DLong h=12; -+ DLong m=0; -+ DDouble s=0.0; -+ SizeT nM,nD,nY,nH,nMi,nS,finalN=1,minsizePar; -+ dimension finalDim; -+ //behaviour: minimum set of dimensions of arrays. singletons expanded to dimension, -+ //keep array trace. -+ SizeT nEl,maxEl=1,minEl; -+ for (int i=0; iNParam() ; ++i) { -+ nEl = e->GetPar(i)->N_Elements() ; -+ if (nEl > 1 && nEl > maxEl) { -+ maxEl=nEl; -+ finalN = maxEl; -+ finalDim = e->GetPar(i)->Dim(); -+ } -+ } //first max - but we need first min: -+ minEl=maxEl; -+ for (int i=0; iNParam() ; ++i) { -+ nEl = e->GetPar(i)->N_Elements() ; -+ if ( (nEl > 1) && (nEl < minEl)) { -+ minEl=nEl; -+ finalN = minEl; -+ finalDim = e->GetPar(i)->Dim(); -+ } -+ } //min not singleton -+ Month = e->GetParAs(0); -+ nM = Month->N_Elements(); -+ Day = e->GetParAs(1); -+ nD = Day->N_Elements(); -+ Year = e->GetParAs(2); -+ nY = Year->N_Elements(); -+ -+ if (e->NParam() == 3 ) { -+ DLongGDL *ret = new DLongGDL(finalDim, BaseGDL::NOZERO); -+ for (SizeT i=0; i< finalN; ++i) { -+ if (dateToJD(jd,(*Day)[i%nD],(*Month)[i%nM],(*Year)[i%nY],h,m,s)) { (*ret)[i]=(long)jd;} -+ else e->Throw("Invalid Calendar Date input."); -+ } -+ return ret; -+ } -+ -+ DDoubleGDL *ret = new DDoubleGDL(finalDim, BaseGDL::NOZERO); -+ -+ if (e->NParam() >= 4) { -+ Hour = e->GetParAs(3); -+ nH = Hour->N_Elements(); -+ } -+ if (e->NParam() == 4) { -+ for (SizeT i=0; i< finalN; ++i) { -+ if (dateToJD(jd,(*Day)[i%nD],(*Month)[i%nM],(*Year)[i%nY],(*Hour)[i%nH], m, s)) {(*ret)[i]=jd;} -+ else e->Throw("Invalid Calendar Date input."); -+ return ret; -+ } -+ } -+ -+ if (e->NParam() >= 5) { -+ Minute = e->GetParAs(4); -+ nMi = Minute->N_Elements(); -+ } -+ if (e->NParam() == 5) { -+ for (SizeT i=0; i< finalN; ++i) { -+ if (dateToJD(jd,(*Day)[i%nD],(*Month)[i%nM],(*Year)[i%nY],(*Hour)[i%nH], (*Minute)[i%nMi], s)) (*ret)[i]=jd; -+ else e->Throw("Invalid Calendar Date input."); -+ return ret; -+ } -+ } -+ -+ if (e->NParam() == 6) { -+ Second = e->GetParAs(5); -+ nS = Second->N_Elements(); -+ for (SizeT i=0; i< finalN; ++i) { -+ if (dateToJD(jd,(*Day)[i%nD],(*Month)[i%nM],(*Year)[i%nY],(*Hour)[i%nH],(*Minute)[i%nMi],(*Second)[i%nS])) {(*ret)[i]=jd;} -+ else e->Throw("Invalid Calendar Date input."); -+ } -+ return ret; -+ } -+ } - } // namespace -Only in gdl-0.9.3/src: .#basic_pro.cpp.1.103 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_pro.hpp gdl/src/basic_pro.hpp ---- gdl-0.9.3/src/basic_pro.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_pro.hpp 2013-07-31 09:41:43.743246381 -0600 -@@ -20,6 +20,7 @@ - - namespace lib { - -+ - // control !CPU settings - void cpu( EnvT* e); - -@@ -101,8 +102,9 @@ - // the following by Sylwester Arabas - // (slayoo@igf.fuw.edu.pl) - void caldat(EnvT* e); -+ BaseGDL* julday(EnvT* e); - void pm(EnvT* e); - --} // namespace -+ } // namespace - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/basic_pro_jmg.cpp gdl/src/basic_pro_jmg.cpp ---- gdl-0.9.3/src/basic_pro_jmg.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/basic_pro_jmg.cpp 2013-08-04 20:25:18.730700435 -0600 -@@ -271,15 +271,20 @@ - } - - // CALL_EXTERNAL by Christoph Fuchs -+ //AC #ifdef USE_EIGEN -+ //AC SizeT defaultAlign = 16; -+ //AC #else - typedef struct { - char c; - long long l; - } testAlign; - SizeT defaultAlign = (SizeT)( sizeof(testAlign)-sizeof(long long) ); -- -+ //AC #endif -+ - BaseGDL* call_external( EnvT* e) - { - DString image, entry; -+ static std::string s; - SizeT myAlign = defaultAlign; - DType myReturnType = GDL_UNDEF; - -@@ -341,10 +346,11 @@ - e->Throw("Conflicting keywords ALL_VALUE and ALL_GDL"); - } - -- short* byValue = (short*) malloc( (nParam-2) * sizeof(short) ); -- if (byValue == NULL) { -- e->Throw("Internal error allocating memory for byValue"); -- } -+// short* byValue = (short*) malloc( (nParam-2) * sizeof(short) ); -+// if (byValue == NULL) { -+// e->Throw("Internal error allocating memory for byValue"); -+// } -+ vector byValue(nParam-2,0); - - for (SizeT i=0; iAssureStringScalarPar( (SizeT)1, entry); - - int argc = nParam-2; -+ // must be void** for dl... stuff - void **argv = (void**)malloc((nParam-2) * sizeof(void*) ); - if (argv == NULL) { - e->Throw("Internal error allocating memory for argv"); - } -- -+ GDLGuard argvGuard(argv, free); -+ - // Fill argv with the parameters - - for(SizeT i =2; i < nParam; i++){ -@@ -386,13 +394,13 @@ - ); - } - -- if (IsNumericType[pType]) { -+ if (NumericType(pType)) { - if (par->Sizeof() > sizeof(void*)) { - e->Throw("Parameter is larger than pointer: " - + e->GetParString(i) - ); - } -- memcpy(argv+i-2, (void*) par->DataAddr(), par->Sizeof()); -+ memcpy(&argv[i-2], (void*) par->DataAddr(), par->Sizeof()); - } - else if (pType == GDL_STRING) { - argv[i-2] = (void*) (*(DStringGDL*)(par))[0].c_str(); -@@ -407,7 +415,7 @@ - argv[i-2] = (void*) par; - } - else { // By reference (default) -- if (IsNumericType[pType] || pType == GDL_PTR || pType == GDL_OBJ ) { -+ if (NumericType(pType) || pType == GDL_PTR || pType == GDL_OBJ ) { - argv[i-2] = (void*) par->DataAddr(); - } - else if (pType == GDL_STRING) { -@@ -477,7 +485,7 @@ - break; - case GDL_ULONG64: ret.d_ulong64 = ((DULong64(*)(int, void**))func)(argc, argv); - break; -- case GDL_STRING: ret.d_string = ((char*(*) (int, void**))func)(argc, argv); -+ case GDL_STRING: ret.d_string = ((char*(*) (int, void**))func)(argc, argv); - break; - default: e->Throw("Return type not supported: " + myReturnType ); - break; -@@ -490,22 +498,24 @@ - while (! dlclose(handle) ) {} - #endif - } -- -+// necessary since struct is freed below, i do not see how??? (FIXME) -+ if (myReturnType == GDL_STRING) {s=ret.d_string;} - // Copy strings and structures back to GDL, free memory - -- for(SizeT i = nParam-1; i >= 2; i--){ -+ for (SizeT i = nParam - 1; i >= 2; i--) { - if (byValue[i-2] != 0) {continue;} -- BaseGDL* par = e->GetParDefined(i); -- SizeT pType = par->Type(); -- if (pType == GDL_STRING) { -- ce_StringIDLtoGDL((EXTERN_STRING*) argv[i-2], par, 1); -- } -- else if (pType == GDL_STRUCT) { -- ce_StructIDLtoGDL( e, argv[i-2], par, 1, myAlign); -- } -+ BaseGDL* par = e->GetParDefined(i); -+ SizeT pType = par->Type(); -+ if (pType == GDL_STRING) { -+ ce_StringIDLtoGDL((EXTERN_STRING*) argv[i - 2], par, 1); -+ } -+ else if (pType == GDL_STRUCT) { -+ ce_StructIDLtoGDL(e, argv[i - 2], par, 1, myAlign); -+ } - } - -- free(argv); -+ // now guarded. s. a. -+ //free(argv); - - // Return the return value - -@@ -528,7 +538,7 @@ - break; - case GDL_ULONG64: return new DULong64GDL(ret.d_ulong64); - break; -- case GDL_STRING: return new DStringGDL(ret.d_string); -+ case GDL_STRING: return new DStringGDL(s); - break; - } - -@@ -606,7 +616,7 @@ - SizeT sizeOf; - void* source; - int doFree = 0; -- if (IsNumericType[pType] || pType == GDL_PTR || pType == GDL_OBJ) { -+ if (NumericType(pType) || pType == GDL_PTR || pType == GDL_OBJ) { - source = (void*) member->DataAddr(); - length = member->NBytes(); - sizeOf = member->Sizeof(); -@@ -658,7 +668,7 @@ - SizeT length; - SizeT sizeOf; - void* dest; -- if (IsNumericType[pType]) { -+ if (NumericType(pType)) { - sizeOf = member->Sizeof(); - } - else { -@@ -670,7 +680,7 @@ - p += space; - } - -- if (IsNumericType[pType] || pType == GDL_PTR || pType == GDL_OBJ) { -+ if (NumericType(pType) || pType == GDL_PTR || pType == GDL_OBJ) { - length = member->NBytes(); - dest = (void*) member->DataAddr(); - memcpy(dest, p, length); -@@ -709,7 +719,9 @@ - for (SizeT iTag=0; iTag < nTags; iTag++) { - BaseGDL* member = s->GetTag(iTag); - DType pType = member->Type(); -- if (IsNumericType[pType] || pType == GDL_PTR || pType == GDL_OBJ) { -+ // there is probably no point transfering PTR and OBJ -+ // but if it fits why restrict it? They should never be used though -+ if (NumericType(pType) || pType == GDL_PTR || pType == GDL_OBJ) { - totalSize += member->NBytes(); - sizeOf = member->Sizeof(); - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/CFMTLexer.cpp gdl/src/CFMTLexer.cpp ---- gdl-0.9.3/src/CFMTLexer.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/CFMTLexer.cpp 2013-07-08 12:39:21.278400434 -0600 -@@ -1,6 +1,7 @@ --/* $ANTLR 2.7.7 (20110618): "cformat.g" -> "CFMTLexer.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "cformat.g" -> "CFMTLexer.cpp"$ */ - - #include "includefirst.hpp" -+#include - - #include "CFMTLexer.hpp" - #include -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/CFMTLexer.hpp gdl/src/CFMTLexer.hpp ---- gdl-0.9.3/src/CFMTLexer.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/CFMTLexer.hpp 2013-07-08 12:39:21.281400398 -0600 -@@ -2,7 +2,7 @@ - #define INC_CFMTLexer_hpp_ - - #include --/* $ANTLR 2.7.7 (20110618): "cformat.g" -> "CFMTLexer.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "cformat.g" -> "CFMTLexer.hpp"$ */ - #include - #include - #include -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/CFMTTokenTypes.hpp gdl/src/CFMTTokenTypes.hpp ---- gdl-0.9.3/src/CFMTTokenTypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/CFMTTokenTypes.hpp 2013-07-08 12:39:21.282400386 -0600 -@@ -1,7 +1,7 @@ - #ifndef INC_CFMTTokenTypes_hpp_ - #define INC_CFMTTokenTypes_hpp_ - --/* $ANTLR 2.7.7 (20110618): "cformat.g" -> "CFMTTokenTypes.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "cformat.g" -> "CFMTTokenTypes.hpp"$ */ - - #ifndef CUSTOM_API - # define CUSTOM_API -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/CFMTTokenTypes.txt gdl/src/CFMTTokenTypes.txt ---- gdl-0.9.3/src/CFMTTokenTypes.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/CFMTTokenTypes.txt 2013-07-08 12:39:21.284400362 -0600 -@@ -1,4 +1,4 @@ --// $ANTLR 2.7.7 (20110618): cformat.g -> CFMTTokenTypes.txt$ -+// $ANTLR 2.7.7 (20120518): cformat.g -> CFMTTokenTypes.txt$ - CFMT // output token vocab name - ALL=4 - CSTR=5 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/cformat.g gdl/src/cformat.g ---- gdl-0.9.3/src/cformat.g 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/cformat.g 2013-07-08 12:39:21.545397270 -0600 -@@ -17,6 +17,7 @@ - - header "pre_include_cpp" { - #include "includefirst.hpp" -+#include - } - - header { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/CMakeLists.txt gdl/src/CMakeLists.txt ---- gdl-0.9.3/src/CMakeLists.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/CMakeLists.txt 2013-07-31 09:41:43.605246862 -0600 -@@ -133,6 +133,8 @@ - gsl_matrix.cpp - gsl_matrix.hpp - gzstream.hpp -+hash.cpp -+hash.hpp - hdf5_fun.cpp - hdf5_fun.hpp - hdf_fun.cpp -@@ -155,6 +157,8 @@ - libinit_jmg.cpp - libinit_mes.cpp - libinit_ng.cpp -+list.cpp -+list.hpp - magick_cl.cpp - magick_cl.hpp - math_fun.cpp -@@ -169,6 +173,8 @@ - math_fun_ng.hpp - math_utl.cpp - math_utl.hpp -+matrix_cholesky.cpp -+matrix_cholesky.hpp - mpi.cpp - mpi.hpp - ncdf_att_cl.cpp -@@ -199,6 +205,7 @@ - plotting_plot.cpp - plotting_plots.cpp - plotting_polyfill.cpp -+plotting_shade_surf.cpp - plotting_surface.cpp - plotting_windows.cpp - plotting_xyouts.cpp -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/convert2.cpp gdl/src/convert2.cpp ---- gdl-0.9.3/src/convert2.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/convert2.cpp 2013-03-21 14:04:04.000000000 -0600 -@@ -447,7 +447,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=i2s((*this)[i],8); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -617,7 +617,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=i2s((*this)[i],8); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -790,7 +790,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=i2s((*this)[i],12); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -963,7 +963,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=i2s((*this)[i],12); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1034,7 +1034,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2DByte((*this)[i]); - } //(*dest)[i]=Real2DByte((*this)[i]); - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1055,7 +1055,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1096,7 +1096,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1139,7 +1139,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1187,7 +1187,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=float2string((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1259,7 +1259,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2DByte((*this)[i]); - //(*dest)[i]=Double2DByte((*this)[i]); - } -@@ -1282,7 +1282,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1325,7 +1325,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1368,7 +1368,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1416,7 +1416,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=double2string((*this)[i]); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1502,7 +1502,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - SizeT basePtr = i*maxLen; - -@@ -1521,7 +1521,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1550,7 +1550,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1579,7 +1579,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1608,7 +1608,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1637,7 +1637,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1666,7 +1666,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1695,7 +1695,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1724,7 +1724,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1754,7 +1754,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1784,7 +1784,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) shared( errorFlag, mode) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - { - const char* cStart=(*this)[i].c_str(); - char* cEnd; -@@ -1846,7 +1846,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2DByte(real((*this)[i])); - } //(*dest)[i]=Real2DByte(real((*this)[i])); - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1868,7 +1868,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int(real((*this)[i])); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1911,7 +1911,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int(real((*this)[i])); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -1954,7 +1954,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int(real((*this)[i])); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -2030,7 +2030,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]="("+i2s(real((*this)[i]))+","+i2s(imag((*this)[i]))+")"; - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -2090,7 +2090,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2DByte(real((*this)[i])); - } //(*dest)[i]=Double2DByte(real((*this)[i])); - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -2112,7 +2112,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int(real((*this)[i])); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -2155,7 +2155,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int(real((*this)[i])); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -2198,7 +2198,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=Real2Int(real((*this)[i])); - if( (mode & BaseGDL::CONVERT) != 0) delete this; - } -@@ -2274,7 +2274,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]="("+i2s(real((*this)[i]))+","+i2s(imag((*this)[i]))+")"; - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -2445,7 +2445,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=i2s((*this)[i],22); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -@@ -2617,7 +2617,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*dest)[i]=i2s((*this)[i],22); - } - if( (mode & BaseGDL::CONVERT) != 0) delete this; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/convol.cpp gdl/src/convol.cpp ---- gdl-0.9.3/src/convol.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/convol.cpp 2013-07-31 09:41:43.757246332 -0600 -@@ -15,6 +15,7 @@ - * * - ***************************************************************************/ - -+ - // optimized version - - // to be included from datatypes.cpp (twice) -@@ -27,33 +28,87 @@ - - #endif //#define CONVOL_COMMON__ - -+ -+ -+using namespace std; -+ -+ - #ifdef CONVOL_BYTE__ -+ - template<> --BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode) -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) - { -- Data_* kernel = static_cast*>( kIn); -- DInt scale = (*static_cast*>( scaleIn))[0]; -+ Data_* kernel = static_cast*>( kIn); -+ DLong scale = (*static_cast*>( scaleIn))[0]; - // the result to be returned - Data_* res = New( dim, BaseGDL::ZERO); - DInt* ker = static_cast( kernel->DataAddr()); -+ // DLong* biasd=static_cast( bias); -+ Data_* biast=static_cast*>( bias); -+ DLong* biasd = static_cast( biast->DataAddr()); - #else -+ -+#ifdef CONVOL_UINT__ -+ -+template<> -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) -+{ -+ Data_* kernel = static_cast( kIn); -+ DLong scale = (*static_cast*>( scaleIn))[0]; -+ // the result to be returned -+ Data_* res = New( dim, BaseGDL::ZERO); -+ // DLong* ker = static_cast( kernel->DataAddr()); -+ Ty* ker = &(*kernel)[0]; -+ // DLongGDL* biasd=static_cast( bias); -+ Data_* biast=static_cast( bias); -+ Ty* biasd = &(*biast)[0]; -+#else -+ -+ - template --BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode) -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) - { - Data_* kernel = static_cast( kIn); - Ty scale = (*static_cast( scaleIn))[0]; - // the result to be returned - Data_* res = New( this->dim, BaseGDL::ZERO); - Ty* ker = &(*kernel)[0]; -+ Data_* biast=static_cast( bias); -+ Ty* biasd = &(*biast)[0]; -+#endif - #endif -+ - if( scale == this->zero) scale = 1; - - SizeT nA = N_Elements(); - SizeT nK = kernel->N_Elements(); - -- // general case (look at kernel rank == 1 later) -+ if(normalize) -+ { -+ -+ DDouble tmp=0; -+ for ( SizeT ind=0; ind255) -+ biasd[0]=255; -+#endif -+ -+ } -+ - SizeT nDim = this->Rank(); // number of dimension to run over - - SizeT kStride[MAXRANK+1]; -@@ -108,7 +163,8 @@ - SizeT kDim0 = kernel->Dim( 0); - SizeT kDim0_nDim = kDim0 * nDim; - --#define INCLUDE_CONVOL_INC_CPP -+#define INCLUDE_CONVOL_INC_CPP -+ - if( edgeMode == 0) - { - #include "convol_inc0.cpp" -@@ -121,10 +177,147 @@ - { - #include "convol_inc2.cpp" - } -+ -+ - #undef INCLUDE_CONVOL_INC_CPP - -+ -+ if(biasd[0]!=this->zero) -+ { -+ for(SizeT indi=0;indiNParam( 2); -+ -+ /************************************Checking_parameters************************************************/ -+ -+ BaseGDL* p0 = e->GetNumericParDefined( 0); -+ if( p0->Rank() == 0) -+ e->Throw( "Expression must be an array in this context: "+ -+ e->GetParString(0)); -+ -+ BaseGDL* p1 = e->GetNumericParDefined( 1); -+ if( p1->Rank() == 0) -+ e->Throw( "Expression must be an array in this context: "+ -+ e->GetParString(1)); -+ -+ if( p0->N_Elements() < p1->N_Elements()) -+ e->Throw( "Incompatible dimensions for Array and Kernel."); -+ -+ // rank 1 for kernel works always -+ if( p1->Rank() != 1) -+ { -+ SizeT rank = p0->Rank(); -+ if( rank != p1->Rank()) -+ e->Throw( "Incompatible dimensions for Array and Kernel."); -+ -+ for( SizeT r=0; rDim( r) < p1->Dim( r)) -+ e->Throw( "Incompatible dimensions for Array and Kernel."); -+ } -+ -+ -+ /***************************************Preparing_matrices*************************************************/ -+ // convert kernel to array type -+ Guard p1Guard; -+ if( p0->Type() == GDL_BYTE) -+ { -+ if( p1->Type() != GDL_INT) -+ { -+ p1 = p1->Convert2( GDL_INT, BaseGDL::COPY); -+ p1Guard.Reset( p1); -+ } -+ } -+ else if( p0->Type() != p1->Type()) -+ { -+ p1 = p1->Convert2( p0->Type(), BaseGDL::COPY); -+ p1Guard.Reset( p1); -+ } -+ -+ BaseGDL* scale; -+ Guard scaleGuard; -+ if( nParam > 2) -+ { -+ scale = e->GetParDefined( 2); -+ if( scale->Rank() > 0) -+ e->Throw( "Expression must be a scalar in this context: "+ -+ e->GetParString(2)); -+ -+ // p1 here handles GDL_BYTE case also -+ if( p1->Type() != scale->Type()) -+ { -+ scale = scale->Convert2( p1->Type(),BaseGDL::COPY); -+ scaleGuard.Reset( scale); -+ } -+ } -+ else -+ { -+ scale = p1->New( dimension(), BaseGDL::ZERO); -+ } -+ /********************************************Arguments_treatement***********************************/ -+ bool center = true; -+ static int centerIx = e->KeywordIx( "CENTER"); -+ if( e->KeywordPresent( centerIx)) -+ { -+ DLong c; -+ e->AssureLongScalarKW( centerIx, c); -+ center = (c != 0); -+ } -+ -+ // overrides EDGE_TRUNCATE -+ static int edge_wrapIx = e->KeywordIx( "EDGE_WRAP"); -+ bool edge_wrap = e->KeywordSet( edge_wrapIx); -+ static int edge_truncateIx = e->KeywordIx( "EDGE_TRUNCATE"); -+ bool edge_truncate = e->KeywordSet( edge_truncateIx); -+ -+ int edgeMode = 0; -+ if( edge_wrap) -+ edgeMode = 1; -+ else if( edge_truncate) -+ edgeMode = 2; -+ -+ // p0, p1 and scale have same type -+ // p1 has rank of 1 or same rank as p0 with each dimension smaller than p0 -+ // scale is a scalar -+ -+ /***********************************Parameter_BIAS**************************************/ -+ static int biasIx = e->KeywordIx("BIAS"); -+ bool statusBias = e->KeywordPresent( biasIx ); -+ // DLong bias=0; -+ BaseGDL* bias; -+ if(statusBias) -+ { -+ bias=e->GetKW( biasIx); -+ -+ if( p0->Type() != bias->Type()) -+ { -+ bias = bias->Convert2( p0->Type(), BaseGDL::COPY); -+ } -+ } -+ else bias=p1->New( 1,BaseGDL::ZERO); -+ -+ /***********************************Parameter_Normalize**********************************/ -+ -+ static int normalIx = e->KeywordIx( "NORMALIZE"); -+ bool normalize = e->KeywordPresent( normalIx); -+ -+ return p0->Convol( p1, scale, bias, center, normalize, edgeMode); -+ } //end of convol_fun - -+ -+ }//end of namespace -+ -+#endif -+ -+#endif // #ifdef INCLUDE_CONVOL_CPP -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/convol.hpp gdl/src/convol.hpp ---- gdl-0.9.3/src/convol.hpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/convol.hpp 2013-07-17 15:08:27.000000000 -0600 -@@ -0,0 +1,36 @@ -+/*************************************************************************** -+ convol.hpp - Convolution GDL library function -+ ------------------- -+ begin : Jun 21 2013 -+ copyright : (C) 2013 -+ email : -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+ #ifdef HAVE_CONFIG_H -+ #include -+ #endif -+ -+ -+#ifndef CONVOL_HPP_ -+#define CONVOL_HPP_ -+ -+#include "datatypes.hpp" -+#include "envt.hpp" -+ -+namespace lib { -+ -+ BaseGDL* convol_fun( EnvT* e); -+ -+} // namespace -+ -+ -+#endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/convol.opt.cpp gdl/src/convol.opt.cpp ---- gdl-0.9.3/src/convol.opt.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/convol.opt.cpp 2004-12-09 08:10:19.000000000 -0700 -@@ -0,0 +1,682 @@ -+/*************************************************************************** -+ convol.cpp - convol function -+ ------------------- -+ begin : Sep 19 2004 -+ copyright : (C) 2004 by Marc Schellens -+ email : m_schellens@users.sourceforge.net -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+// optimized version -+ -+// to be included from datatypes.cpp (twice) -+#ifdef INCLUDE_CONVOL_CPP -+ -+#ifndef CONVOL_COMMON__ -+#define CONVOL_COMMON__ -+ -+// common used functions -+ -+#endif //#define CONVOL_COMMON__ -+ -+#ifdef CONVOL_BYTE__ -+template<> -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ bool center, int edgeMode) -+{ -+ Data_* kernel = static_cast*>( kIn); -+ DInt scale = (*static_cast*>( scaleIn))[0]; -+ // the result to be returned -+ Data_* res = New( dim, BaseGDL::ZERO); -+ DInt* ker = static_cast( kernel->DataAddr()); -+#else -+template -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ bool center, int edgeMode) -+{ -+ Data_* kernel = static_cast( kIn); -+ Ty scale = static_cast( scaleIn)->dd[0]; -+ // the result to be returned -+ Data_* res = New( dim, BaseGDL::ZERO); -+ Ty* ker = &kernel->dd[0]; -+#endif -+ if( scale == zero) scale = 1; -+ -+ SizeT nA = N_Elements(); -+ SizeT nK = kernel->N_Elements(); -+ -+ // general case (look at kernel rank == 1 later) -+ SizeT nDim = Rank(); // number of dimension to run over -+ -+ SizeT kStride[MAXRANK+1]; -+ kernel->Dim().Stride( kStride, nDim); -+ -+ // setup kIxArr[ nDim * nK] the offset array -+ // this handles center -+ long* kIxArr = new long[ nDim * nK]; -+ ArrayGuard kIxArrGuard( kIxArr); // guard it -+ for( SizeT k=0; kDim( 0)); -+ if( center) kIxArr[ k * nDim + 0] = -(kIxArr[ k * nDim + 0] + -+ kernel->Dim( 0) / 2); -+ for( SizeT kSp=1; kSpDim( kSp); -+ if( kDim == 0) kDim = 1; -+ kIxArr[ k * nDim + kSp] = -((k / kStride[kSp]) % kDim); -+ if( center) kIxArr[ k * nDim + kSp] = -(kIxArr[ k * nDim + kSp] + -+ kDim / 2); -+ } -+ } -+ -+ SizeT aStride[ MAXRANK + 1]; -+ dim.Stride( aStride, nDim); -+ -+ long aInitIx[ MAXRANK+1]; -+ for( SizeT aSp=0; aSp<=nDim; ++aSp) aInitIx[ aSp] = 0; -+ -+ bool regArr[ MAXRANK]; -+ -+ long aBeg[ MAXRANK]; -+ long aEnd[ MAXRANK]; -+ for( SizeT aSp=0; aSpDim(aSp)/2 : kernel->Dim(aSp)-1; // >= -+ regArr[ aSp] = !aBeg[ aSp]; -+ aEnd[ aSp] = (center) ? dim[aSp]-(kernel->Dim(aSp)-1)/2 : dim[aSp]; // < -+ // cout << "aEnd[" << aSp << "]=" << aEnd[ aSp] << endl; -+ } -+ -+ Ty* ddP = &dd[0]; -+ -+ // some loop constants -+ SizeT dim0 = dim[0]; -+ SizeT dim0_1 = dim0 - 1; -+ SizeT dim0_aEnd0 = dim0 - aEnd[0]; -+ SizeT kDim0 = kernel->Dim( 0); -+ SizeT kDim0_nDim = kDim0 * nDim; -+ -+ // for all result elements -+ for( SizeT a=0; a= aBeg[aSp] && aInitIx[aSp] < aEnd[ aSp]; -+ -+ if( regular) -+ for(; aSp 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ } -+ else if( edgeMode == 2) //edge_truncate -+ { -+ // 0-dim beginning -+ for( long aInitIx0 = 0; aInitIx0 < aBeg[0]; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long m_aInitIx0 = -aInitIx0; -+ long* kIx = kIxArr; -+ for( SizeT k=0; k 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ } -+ else { a += aBeg[0];} // update a -+ -+// // 0-dim regular -+// for( long aInitIx0 = aBeg[0]; aInitIx0 < aEnd[0]; ++aInitIx0, ++a) -+// { -+// #ifdef CONVOL_BYTE__ -+// DInt res_a = 0; -+// #else -+// Ty& res_a = (*res)[ a]; -+// #endif -+// long* kIx = kIxArr; -+// for( SizeT k=0; k 0) -+// if( res_a < 255) -+// (*res)[ a] = res_a; -+// else -+// (*res)[ a] = 255; -+// else -+// (*res)[ a] = 0; -+// #endif -+// } -+ -+ -+ // 0-dim regular -+ if( center) -+ { -+ for( long aInitIx0 = aBeg[0]; aInitIx0 < aEnd[0]; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ -+ long* kIx = kIxArr; -+ for( SizeT k=0; k 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ } -+ else -+ { -+ for( long aInitIx0 = aBeg[0]; aInitIx0 < aEnd[0]; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ -+ long* kIx = kIxArr; -+ for( SizeT k=0; k 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ } -+ -+ -+ -+ if( edgeMode == 1) //edge_wrap -+ { -+ // 0-dim end -+ for( long aInitIx0 = aEnd[0]; aInitIx0 < dim0; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim0) aLonIx -= dim0; -+ for( SizeT rSp=1; rSp 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ -+ } -+ else if( edgeMode == 2) //edge_truncate -+ { -+ // 0-dim end -+ for( long aInitIx0 = aEnd[0]; aInitIx0 < dim0; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim0) aLonIx = dim0_1; -+ for( SizeT rSp=1; rSp 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ } -+ else { a += dim0_aEnd0;} // update a -+ } // if( regular) // (dim 1-n) -+ else -+ { // necessary because of update of 'a' -+ -+ // non-regular in dim 1-n -+ if( edgeMode == 1) //edge_wrap -+ { -+ // 0-dim beginning -+ for( long aInitIx0 = 0; aInitIx0 < aBeg[0]; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long m_aInitIx0 = -aInitIx0; -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim[ rSp]) -+ aIx -= dim[ rSp]; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ -+#ifdef CONVOL_BYTE__ -+ if( res_a > 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ // 0-dim regular -+ for( long aInitIx0 = aBeg[0]; aInitIx0 < aEnd[0]; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim[ rSp]) -+ aIx -= dim[ rSp]; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ -+#ifdef CONVOL_BYTE__ -+ if( res_a > 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ // 0-dim end -+ for( long aInitIx0 = aEnd[0]; aInitIx0 < dim0; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim0) aLonIx -= dim0; -+ for( SizeT rSp=1; rSp= dim[ rSp]) -+ aIx -= dim[ rSp]; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ -+#ifdef CONVOL_BYTE__ -+ if( res_a > 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ -+ } -+ else if( edgeMode == 2) //edge_truncate -+ { -+ // 0-dim beginning -+ for( long aInitIx0 = 0; aInitIx0 < aBeg[0]; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long m_aInitIx0 = -aInitIx0; -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim[ rSp]) -+ aIx = dim[ rSp] - 1; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ -+#ifdef CONVOL_BYTE__ -+ if( res_a > 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ // 0-dim regular -+ for( long aInitIx0 = aBeg[0]; aInitIx0 < aEnd[0]; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim[ rSp]) -+ aIx = dim[ rSp] - 1; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ -+#ifdef CONVOL_BYTE__ -+ if( res_a > 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ // 0-dim end -+ for( long aInitIx0 = aEnd[0]; aInitIx0 < dim0; ++aInitIx0, ++a) -+ { -+#ifdef CONVOL_BYTE__ -+ DInt res_a = 0; -+#else -+ Ty& res_a = (*res)[ a]; -+#endif -+ long* kIx = kIxArr; -+ for( SizeT k=0; k= dim0) -+ aLonIx = dim0_1; -+ -+ for( SizeT rSp=1; rSp= dim[ rSp]) -+ aIx = dim[ rSp] - 1; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ -+#ifdef CONVOL_BYTE__ -+ if( res_a > 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ } -+ else { a += dim0;} // update a -+ -+ } // if( regular) else -+ } // for(...) -+ -+ return res; -+} -+ -+#endif // #ifdef INCLUDE_CONVOL_CPP -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/convol.sav.cpp gdl/src/convol.sav.cpp ---- gdl-0.9.3/src/convol.sav.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/convol.sav.cpp 2004-12-09 08:10:19.000000000 -0700 -@@ -0,0 +1,221 @@ -+/*************************************************************************** -+ convol.cpp - convol function -+ ------------------- -+ begin : Apr 19 2004 -+ copyright : (C) 2004 by Marc Schellens -+ email : m_schellens@users.sourceforge.net -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+// this version is simplyfied, but much shorter and easier to understand -+// than the optimized version -+ -+// to be included from datatypes.cpp (twice) -+#ifdef INCLUDE_CONVOL_CPP -+ -+#ifndef CONVOL_COMMON__ -+#define CONVOL_COMMON__ -+ -+// common used functions -+ -+#endif //#define CONVOL_COMMON__ -+ -+#ifdef CONVOL_BYTE__ -+template<> -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ bool center, int edgeMode) -+{ -+ Data_* kernel = static_cast*>( kIn); -+ DInt scale = (*static_cast*>( scaleIn))[0]; -+ // the result to be returned -+ Data_* res = New( dim, BaseGDL::NOZERO); -+ DInt* ker = static_cast( kernel->DataAddr()); -+#else -+template -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ bool center, int edgeMode) -+{ -+ Data_* kernel = static_cast( kIn); -+ Ty scale = static_cast( scaleIn)->dd[0]; -+ // the result to be returned -+ Data_* res = New( dim, BaseGDL::ZERO); -+ Ty* ker = &kernel->dd[0]; -+#endif -+ if( scale == zero) scale = 1; -+ -+ SizeT nA = N_Elements(); -+ SizeT nK = kernel->N_Elements(); -+ -+ // general case (look at kernel rank == 1 later) -+ SizeT nDim = Rank(); // number of dimension to run over -+ -+ SizeT kStride[MAXRANK+1]; -+ kernel->Dim().Stride( kStride, nDim); -+ -+ // setup kIxArr[ nDim * nK] the offset array -+ // this handles center -+ long* kIxArr = new long[ nDim * nK]; -+ long* kIxEnd = &kIxArr[ (nK-1) * nDim]; -+ ArrayGuard kIxArrGuard( kIxArr); // guard it -+ for( SizeT k=0; kDim( 0)); -+ if( center) kIxArr[ k * nDim + 0] = -(kIxArr[ k * nDim + 0] + -+ kernel->Dim( 0) / 2); -+ for( SizeT kSp=1; kSpDim( kSp); -+ if( kDim == 0) kDim = 1; -+ kIxArr[ k * nDim + kSp] = -((k / kStride[kSp]) % kDim); -+ if( center) kIxArr[ k * nDim + kSp] = -(kIxArr[ k * nDim + kSp] + -+ kDim / 2); -+ } -+ } -+ -+ SizeT aStride[ MAXRANK + 1]; -+ dim.Stride( aStride, nDim); -+ -+ long aInitIx[ MAXRANK+1]; -+ for( SizeT aSp=0; aSp<=nDim; ++aSp) aInitIx[ aSp] = 0; -+ -+ bool regArr[ MAXRANK]; -+ -+ long aBeg[ MAXRANK]; -+ long aEnd[ MAXRANK]; -+ for( SizeT aSp=0; aSpDim(aSp)/2 : kernel->Dim(aSp)-1; // >= -+ regArr[ aSp] = !aBeg[ aSp]; -+ aEnd[ aSp] = (center) ? dim[aSp]-(kernel->Dim(aSp)-1)/2 : dim[aSp]; // < -+ } -+ -+ Ty* ddP = &dd[0]; -+ -+ // for all result elements -+ for( SizeT a=0; a= aBeg[aSp] && aInitIx[aSp] < aEnd[ aSp]; -+ -+ if( regular) -+ for(; aSp= dim[ rSp]) -+ aIx -= dim[ rSp]; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ // res_a += dd[ aLonIx] * (*kernel)[ k]; -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ // advance kIx -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ } -+ else if( edgeMode == 2) //edge_truncate -+ { -+ long* kIx = kIxArr; -+ for( SizeT k=0; k nDim index of k'th element -+ -+ SizeT aLonIx=0; -+ for( SizeT rSp=0; rSp= dim[ rSp]) -+ aIx = dim[ rSp] - 1; -+ -+ aLonIx += aIx * aStride[ rSp]; -+ } -+ -+ // res_a += dd[ aLonIx] * (*kernel)[ k]; -+ res_a += ddP[ aLonIx] * ker[ k]; -+ -+ // advance kIx -+ kIx += nDim; -+ } -+ -+ res_a /= scale; -+ } -+ -+#ifdef CONVOL_BYTE__ -+ if( res_a > 0) -+ if( res_a < 255) -+ (*res)[ a] = res_a; -+ else -+ (*res)[ a] = 255; -+ else -+ (*res)[ a] = 0; -+#endif -+ } -+ -+ return res; -+} -+ -+#endif // #ifdef INCLUDE_CONVOL_CPP -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/datalistt.hpp gdl/src/datalistt.hpp ---- gdl-0.9.3/src/datalistt.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/datalistt.hpp 2013-07-31 09:41:43.766246301 -0600 -@@ -30,7 +30,7 @@ - void NullP() { p = NULL;} - void NullPP() { pp = NULL;} - -- bool IsSet() { return (p != NULL || pp != NULL);} -+ bool IsSet() const { return (p != NULL || pp != NULL);} - - bool IsP() const { return p != NULL;} - bool IsPP() const { return pp != NULL;} -@@ -44,9 +44,9 @@ - BaseGDL* P() const { return p;} - BaseGDL** PP() const { return pp;} - BaseGDL*& PRef() { return p;} -- BaseGDL**& PPRef() { return pp;} -+// BaseGDL**& PPRef() { return pp;} - BaseGDL* const& PRefConst() const { return p;} -- BaseGDL** const& PPRefConst() const { return pp;} -+// BaseGDL** const& PPRefConst() const { return pp;} - - private: - BaseGDL* p; -@@ -310,13 +310,13 @@ - return NULL; - } - -- // finds the local variable pp points to -- int FindLocal( BaseGDL** pp) -- { -- for( SizeT i=0; i(i); -- return -1; -- } -+// // finds the local variable pp points to -+// int FindLocal( BaseGDL** pp) -+// { -+// for( SizeT i=0; i(i); -+// return -1; -+// } - - // finds the gloabl variable pp - int FindGlobal( BaseGDL** pp) -@@ -337,11 +337,11 @@ - return NULL; - } - -- BaseGDL* Loc( SizeT ix) -+ BaseGDL* Loc( SizeT ix) const - { - return env[ ix].P(); - } -- BaseGDL** Env( SizeT ix) -+ BaseGDL** Env( SizeT ix) const - { - return env[ ix].PP(); - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/datatypes.cpp gdl/src/datatypes.cpp ---- gdl-0.9.3/src/datatypes.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/datatypes.cpp 2013-07-31 09:41:43.783246241 -0600 -@@ -41,11 +41,20 @@ - #ifdef __cplusplus - extern "C" { - #endif --#define isnan( x ) ( ( sizeof ( x ) == sizeof(double) ) ? \ -- __isnand ( x ) : \ -- ( sizeof ( x ) == sizeof( float) ) ? \ -- __isnanf ( x ) : \ -- __isnan ( x ) ) -+// #define isnan( x ) ( ( sizeof ( x ) == sizeof(double) ) ? \ -+// __isnand ( x ) : \ -+// ( sizeof ( x ) == sizeof( float) ) ? \ -+// __isnanf ( x ) : \ -+// __isnan ( x ) ) -+namespace std { -+ -+ template -+ bool isnan( T x) { return ( ( sizeof ( x ) == sizeof(double) ) ? -+ __isnand ( x ) : -+ ( sizeof ( x ) == sizeof( float) ) ? -+ __isnanf ( x ) : -+ __isnan ( x ) );} -+} - #ifdef __cplusplus - } - #endif -@@ -53,9 +62,13 @@ - - #ifdef _MSC_VER - #define isfinite _finite -+#define std__isnan isnan -+#else -+#define std__isnan std::isnan - #endif - --using namespace std; -+//using namespace std; -+//using std::isnan; - - // this (ugly) including of other sourcefiles has to be done, because - // on Mac OS X a template instantiation request (see bottom of file) -@@ -98,8 +111,21 @@ - #define isinfinite _isinfinite - #endif - -+ -+#ifdef TESTTG -+ -+#include "test_template_grouping.cpp" -+template -+void Data_::TestTemplateGrouping() -+{ -+// Ty ty = Test1(); -+ bool b = Test2(); -+} -+ -+#endif -+ - template --deque< void*> Data_::freeList; -+FreeListT Data_::freeList; - - #ifdef GDLARRAY_CACHE - -@@ -241,20 +267,46 @@ - - if( freeList.size() > 0) - { -- void* res = freeList.back(); -- freeList.pop_back(); -- return res; -+ return freeList.pop_back(); -+// void* res = freeList.back(); -+// freeList.pop_back(); -+// return res; - } - - const size_t newSize = multiAlloc - 1; - -- freeList.resize( newSize); -- char* res = static_cast< char*>( malloc( sizeof( Data_) * multiAlloc)); // one more than newSize -- for( size_t i=0; i= sizeof( char*) -+ const size_t realSizeOfType = sizeof( Data_); -+ const SizeT exceed = realSizeOfType % alignmentInBytes; -+ const size_t sizeOfType = realSizeOfType + (alignmentInBytes - exceed); -+ char* res = static_cast< char*>( Eigen::internal::aligned_malloc( sizeOfType * multiAlloc)); // one more than newSize -+#else -+ const size_t sizeOfType = sizeof( Data_); -+ char* res = static_cast< char*>( malloc( sizeOfType * multiAlloc)); // one more than newSize -+#endif -+ -+ res = freeList.Init( newSize, res, sizeOfType); -+// freeList[0] = NULL; -+// for( size_t i=1; i<=newSize; ++i) -+// { -+// freeList[ i] = res; -+// res += sizeOfType; -+// } - - // the one more - return res; -@@ -488,6 +540,7 @@ - // } - - -+ - template - BaseGDL* Data_::Log() - { -@@ -1384,7 +1437,7 @@ - { - // SA: based on total_over_dim_template() - // static Data_* tmp = new Data_(dimension(1), BaseGDL::NOZERO); -- //auto_ptr tmp_guard(tmp); -+ //Guard tmp_guard(tmp); - SizeT nEl = N_Elements(); - SizeT revStride = this->dim.Stride(dim); - SizeT outerStride = this->dim.Stride(dim + 1); -@@ -1411,7 +1464,7 @@ - { - // SA: based on total_over_dim_template() - Data_* res = new Data_(this->dim, BaseGDL::NOZERO); -- auto_ptr res_guard(res); -+ Guard res_guard(res); - SizeT nEl = N_Elements(); - SizeT revStride = this->dim.Stride(dim); - SizeT outerStride = this->dim.Stride(dim + 1); -@@ -1439,7 +1492,7 @@ - { - // SA: based on total_over_dim_template() - Data_* res = new Data_(this->dim, BaseGDL::NOZERO); -- auto_ptr res_guard(res); -+ Guard res_guard(res); - SizeT nEl = N_Elements(); - SizeT revStride = this->dim.Stride(dim); - SizeT outerStride = this->dim.Stride(dim + 1); -@@ -1467,7 +1520,7 @@ - { - // SA: based on total_over_dim_template() - Data_* res = new Data_(this->dim, BaseGDL::NOZERO); -- auto_ptr res_guard(res); -+ Guard res_guard(res); - SizeT nEl = N_Elements(); - SizeT revStride = this->dim.Stride(dim); - SizeT outerStride = this->dim.Stride(dim + 1); -@@ -1732,7 +1785,7 @@ - - template< class Sp> - bool Data_::EqType( const BaseGDL* r) const --{ return (Sp::t == r->Type());} -+{ return (this->Type() == r->Type());} - - template< class Sp> - void* Data_::DataAddr()// SizeT elem) -@@ -1760,6 +1813,42 @@ - template< class Sp> - SizeT Data_::N_Elements() const - { return dd.size();} -+ -+template<> -+SizeT Data_::N_Elements() const -+{ -+ if( !this->StrictScalar()) -+ return dd.size(); -+ -+ DObj s = dd[0]; // is StrictScalar() -+ if( s == 0) // no overloads for null object -+ return 1; -+ -+ DStructGDL* oStructGDL= GDLInterpreter::GetObjHeapNoThrow( s); -+ if( oStructGDL == NULL) // if object not valid -> default behaviour -+ return 1; -+ -+ DStructDesc* desc = oStructGDL->Desc(); -+ -+ if( desc->IsParent("LIST")) -+ { -+ // no static here, might vary in derived object -+ unsigned nListTag = desc->TagIndex( "NLIST"); -+ SizeT listSize = (*static_cast(oStructGDL->GetTag( nListTag, 0)))[0]; -+ return listSize; -+ } -+ if( desc->IsParent("HASH")) -+ { -+ // no static here, might vary in derived object -+ unsigned nListTag = desc->TagIndex( "TABLE_COUNT"); -+ SizeT listSize = (*static_cast(oStructGDL->GetTag( nListTag, 0)))[0]; -+ return listSize; -+ } -+ -+ return 1; -+} -+ -+ - template< class Sp> - SizeT Data_::Size() const - { return dd.size();} -@@ -1774,106 +1863,141 @@ - /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i = 0; i - void Data_::Construct() --{} --template<> --void Data_::Construct() - { -+ // note that this is not possible in cases where an operation -+ // (here: 'new' which is ok) isn't defined for any POD -+ // (although this code never executes and should be optimized away anyway) -+ const bool isPOD = Sp::IS_POD; -+ // do nothing for POD -+ if( !isPOD) -+ { - SizeT nEl = dd.size(); - // for( SizeT i = 0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i = 0; i --void Data_::Construct() -+void Data_::Construct() - { - SizeT nEl = dd.size(); - // for( SizeT i = 0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDString>::Construct() --{ -+void Data_::Construct() -+{ - SizeT nEl = dd.size(); - // for( SizeT i = 0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDComplex>::Construct() --{ -- SizeT nEl = dd.size(); -- /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDComplexDbl>::Construct() --{ -- SizeT nEl = dd.size(); -- /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- #pragma omp for*/ -- for( int i = 0; i -+// void Data_< SpDString>::Construct() -+// { -+// SizeT nEl = dd.size(); -+// // for( SizeT i = 0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( SizeT i = 0; i -+// void Data_< SpDComplex>::Construct() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( SizeT i = 0; i -+// void Data_< SpDComplexDbl>::Construct() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( SizeT i = 0; i - void Data_::ConstructTo0() - { -+ if( Sp::IS_POD) -+ { - SizeT nEl = dd.size(); - /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDString>::ConstructTo0() --{ -- SizeT nEl = dd.size(); -- /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDComplex>::ConstructTo0() --{ -- SizeT nEl = dd.size(); -- /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDComplexDbl>::ConstructTo0() --{ -+ for( SizeT i = 0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i = 0; i -+// void Data_< SpDString>::ConstructTo0() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( int i = 0; i -+// void Data_< SpDComplex>::ConstructTo0() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( int i = 0; i -+// void Data_< SpDComplexDbl>::ConstructTo0() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( int i = 0; i - void Data_::Destruct() - { - // no destruction for POD -+ if( !Sp::IS_POD) -+ { -+ SizeT nEl = dd.size(); -+ /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ { -+ #pragma omp for*/ -+ for( SizeT i = 0; i - void Data_< SpDPtr>::Destruct() -@@ -1885,36 +2009,36 @@ - { - GDLInterpreter::DecRefObj( this); - } --template<> --void Data_< SpDString>::Destruct() --{ -- SizeT nEl = dd.size(); -- /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDComplex>::Destruct() --{ -- SizeT nEl = dd.size(); -- /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- #pragma omp for*/ -- for( int i = 0; i --void Data_< SpDComplexDbl>::Destruct() --{ -- SizeT nEl = dd.size(); -- /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -- #pragma omp for*/ -- for( int i = 0; i -+// void Data_< SpDString>::Destruct() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( SizeT i = 0; i -+// void Data_< SpDComplex>::Destruct() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( SizeT i = 0; i -+// void Data_< SpDComplexDbl>::Destruct() -+// { -+// SizeT nEl = dd.size(); -+// /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+// { -+// #pragma omp for*/ -+// for( SizeT i = 0; i - BaseGDL* Data_::SetBuffer( const void* b) -@@ -1944,7 +2068,7 @@ - /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i=0; i -+DDouble Data_::HashValue() const -+{ -+ return static_cast((*this)[0]); -+} -+template<> -+DDouble Data_::HashValue() const -+{ -+ return real((*this)[0]); -+} -+template<> -+DDouble Data_::HashValue() const -+{ -+ return real((*this)[0]); -+} -+template<> -+DDouble Data_::HashValue() const -+{ -+ throw GDLException("STRING expression not allowed as index. Please report."); -+ return 0; // get rid of warning -+} -+template<> -+DDouble Data_::HashValue() const -+{ -+ throw GDLException("PTR expression not allowed as index. Please report."); -+ return 0; // get rid of warning -+} -+ -+template<> -+DDouble Data_::HashValue() const -+{ -+ throw GDLException("Object expression not allowed as index. Please report."); -+ return 0; // get rid of warning -+} -+ -+ -+// -1 -> p2 is greater -+// 0 -> equal -+// 1 -> this is greater -+ -+// note: this is for internal use only (for HASH objects) -+// this should not be called on non-numeric types (also for p2) -+template -+int Data_::HashCompare( BaseGDL* p2) const -+{ -+ assert( dd.size() == 1); -+ assert( p2->N_Elements() == 1); -+ if( p2->Type() == GDL_STRING) -+ return 1; // strings 1st (smallest) -+ -+ assert( NumericType(p2->Type())); -+ -+ if( this->IS_INTEGER) -+ { -+ if( IntType( p2->Type())) // make full use of data type -+ { -+ RangeT thisValue = this->LoopIndex(); -+ RangeT p2Value = p2->LoopIndex(); -+ if( thisValue == p2Value) -+ return 0; -+ if( thisValue < p2Value) -+ return -1; -+ return 1; -+ } -+ } -+ DDouble thisValue = this->HashValue(); -+ DDouble p2Value = p2->HashValue(); -+ if( thisValue == p2Value) -+ return 0; -+ if( thisValue < p2Value) -+ return -1; -+ return 1; -+} -+ -+template<> -+int Data_::HashCompare( BaseGDL* p2) const -+{ -+ assert( dd.size() == 1); -+ assert( p2->N_Elements() == 1); -+ if( p2->Type() != this->Type()) -+ return -1; // strings 1st (smallest) -+ -+ Data_* p2String = static_cast(p2); -+ if( dd[0].length() == (*p2String)[0].length()) -+ { -+ if( dd[0] == (*p2String)[0]) -+ return 0; -+ if( dd[0] < (*p2String)[0]) -+ return -1; -+ return 1; -+ } -+ else if( dd[0].length() < (*p2String)[0].length()) -+ { -+ return -1; -+ } -+ return 1; -+} -+ -+ -+// Scalar2Index - // used by the interpreter - // -2 < 0 array - // -1 < 0 scalar -@@ -2052,7 +2276,7 @@ - // 1 scalar - // 2 one-element array - template --int Data_::Scalar2index( SizeT& st) const -+int Data_::Scalar2Index( SizeT& st) const - { - if( dd.size() != 1) return 0; - -@@ -2086,7 +2310,7 @@ - } - - template<> --int Data_::Scalar2index( SizeT& st) const -+int Data_::Scalar2Index( SizeT& st) const - { - if( dd.size() != 1) return 0; - float r=real((*this)[0]); -@@ -2107,7 +2331,7 @@ - } - - template<> --int Data_::Scalar2index( SizeT& st) const -+int Data_::Scalar2Index( SizeT& st) const - { - if( dd.size() != 1) return 0; - double r=real((*this)[0]); -@@ -2129,7 +2353,7 @@ - - - template<> --int Data_::Scalar2index( SizeT& st) const -+int Data_::Scalar2Index( SizeT& st) const - { - if( dd.size() != 1) return 0; - -@@ -2169,19 +2393,9 @@ - return 1; - } - --int DStructGDL::Scalar2index( SizeT& st) const --{ -- throw GDLException("STRUCT expression not allowed in this context."); -- return 0; // get rid of warning --} --int DStructGDL::Scalar2RangeT( RangeT& st) const --{ -- throw GDLException("STRUCT expression not allowed in this context."); -- return 0; // get rid of warning --} - - template<> --int Data_::Scalar2index( SizeT& st) const -+int Data_::Scalar2Index( SizeT& st) const - { - throw GDLException("PTR expression not allowed in this context."); - return 0; // get rid of warning -@@ -2194,7 +2408,7 @@ - } - - template<> --int Data_::Scalar2index( SizeT& st) const -+int Data_::Scalar2Index( SizeT& st) const - { - throw GDLException("Object expression not allowed in this context."); - return 0; // get rid of warning -@@ -2206,6 +2420,11 @@ - return 0; // get rid of warning - } - -+ -+ -+ -+ -+ - // for FOR loop *indices* - template - RangeT Data_::LoopIndex() const -@@ -2277,11 +2496,6 @@ - } - return ix; - } --RangeT DStructGDL::LoopIndex() const --{ -- throw GDLException("STRUCT expression not allowed in this context."); -- return 0; // get rid of warning --} - - template<> - RangeT Data_::LoopIndex() const -@@ -2378,17 +2592,35 @@ - // - // DFun* isTrueOverload = static_cast(desc->GetOperator( OOIsTrue)); - -- DFun* isTrueOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOIsTrue)); -+ DSubUD* isTrueOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOIsTrue)); - if( isTrueOverload == NULL) - return true; // not overloaded, false case for default already returned (s. a.) - - ProgNodeP callingNode = interpreter->GetRetTree(); - -- BaseGDL* self = this->Dup(); -- Guard selfGuard( self); -- EnvUDT* newEnv= new EnvUDT( callingNode, isTrueOverload, &self); -+// BaseGDL* self = this->Dup(); -+// Guard selfGuard( self); -+// EnvUDT* newEnv= new EnvUDT( callingNode, isTrueOverload, &self); - // no parameters - -+ EnvUDT* newEnv; -+ DObjGDL* self; -+ Guard selfGuard; -+ // Dup() here is not optimal -+ // avoid at least for internal overload routines (which do/must not change SELF or r) -+ bool internalDSubUD = isTrueOverload->GetTree()->IsWrappedNode(); -+ if( internalDSubUD) -+ { -+ self = this; -+ newEnv= new EnvUDT( callingNode, isTrueOverload, &self); -+ } -+ else -+ { -+ self = this->Dup(); -+ selfGuard.Init( self); -+ newEnv= new EnvUDT( callingNode, isTrueOverload, &self); -+ } -+ - StackGuard guard(interpreter->CallStack()); - - interpreter->CallStack().push_back( newEnv); -@@ -2396,7 +2628,7 @@ - // make the call - BaseGDL* res=interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); - -- if( self != selfGuard.Get()) -+ if( !internalDSubUD && self != selfGuard.Get()) - { - // always put out warning first, in case of a later crash - Warning( "WARNING: " + isTrueOverload->ObjectName() + -@@ -2404,24 +2636,24 @@ - // assignment to SELF -> self was deleted and points to new variable - // which it owns - selfGuard.Release(); -- if( self != NullGDL::GetSingleInstance()) -+ if( (BaseGDL*)self != NullGDL::GetSingleInstance()) - selfGuard.Reset(self); - } - if( NullGDL::IsNULLorNullGDL( res)) -- { -- throw GDLException( isTrueOverload->ObjectName() + " returned an undefined value.",true,false); -- } -+ { -+ throw GDLException( isTrueOverload->ObjectName() + " returned an undefined value.",true,false); -+ } - - Guard resGuard( res); - - // prevent recursion - if( res->Type() == GDL_OBJ) -- { -- ostringstream os; -- res->ToStream(os); -- throw GDLException( isTrueOverload->ObjectName() + ": Object reference expression not allowed in this context: " + -- os.str(),true,false); -- } -+ { -+ ostringstream os; -+ res->ToStream(os); -+ throw GDLException( isTrueOverload->ObjectName() + ": Object reference expression not allowed in this context: " + -+ os.str(),true,false); -+ } - - return res->LogTrue(); - } -@@ -2464,12 +2696,6 @@ - return 0; - } - --int DStructGDL::Sgn() // -1,0,1 --{ -- throw GDLException("Struct expression not allowed in this context."); -- return 0; --} -- - template<> - int Data_::Sgn() // -1,0,1 - { -@@ -2564,12 +2790,6 @@ - return false; - } - --bool DStructGDL::EqualNoDelete( const BaseGDL* r) const --{ -- throw GDLException("Struct expression not allowed in this context."); -- return false; --} -- - // For array_equal r must be of same type - template - bool Data_::ArrayEqual( BaseGDL* rIn) -@@ -2833,7 +3053,7 @@ - { - Data_* rConv = static_cast(srcIn->Convert2( this->Type(), BaseGDL::COPY_BYTE_AS_INT)); - // Data_* rConv = static_cast(srcIn->Convert2( this->Type(), BaseGDL::COPY)); -- auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - (*this)[ix] = (*rConv)[0]; - } - else -@@ -2845,7 +3065,7 @@ - { - Data_* rConv = static_cast(srcIn->Convert2( this->Type(), BaseGDL::COPY_BYTE_AS_INT)); - // Data_* rConv = static_cast(srcIn->Convert2( this->Type(), BaseGDL::COPY)); -- auto_ptr conv_guard( rConv); -+ Guard conv_guard( rConv); - (*this)[ixR] = (*rConv)[0]; - } - else -@@ -3725,6 +3945,8 @@ - template<> - bool Data_::LogTrue() - { -+ // ::_overloadIsTrue is handled in True() -+ - return this->True(); - } - // structs are not allowed -@@ -4050,7 +4272,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; -+ if (!std__isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4060,7 +4282,7 @@ - - for (i = i_min; i < stop; i += step) { - if (omitNaN) { -- if (isnan((*this)[i]) || !isfinite((*this)[i])) continue; -+ if (std__isnan((*this)[i]) || !isfinite((*this)[i])) continue; - } - if ((*this)[i] > maxV) maxV = (*this)[maxEl = i]; - } -@@ -4082,7 +4304,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; -+ if (!std__isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4092,7 +4314,7 @@ - - for (i = i_min; i < stop; i+= step) { - if (omitNaN) { -- if (isnan((*this)[i]) || !isfinite((*this)[i])) continue; -+ if (std__isnan((*this)[i]) || !isfinite((*this)[i])) continue; - } - if ((*this)[i] < minV) minV = (*this)[minEl = i]; - } -@@ -4114,7 +4336,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; -+ if (!std__isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4124,7 +4346,7 @@ - - for (i = i_min; i < stop; i+= step) { - if (omitNaN){ -- if (isnan((*this)[i]) || !isfinite((*this)[i])) continue; -+ if (std__isnan((*this)[i]) || !isfinite((*this)[i])) continue; - } - if ((*this)[i] > maxV) maxV = (*this)[maxEl = i]; - else if( (*this)[i] < minV) minV = (*this)[minEl = i]; -@@ -4163,7 +4385,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; -+ if (!std__isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4173,7 +4395,7 @@ - - for (i = i_min; i < stop; i += step) { - if (omitNaN) { -- if (isnan((*this)[i]) || !isfinite((*this)[i])) continue; -+ if (std__isnan((*this)[i]) || !isfinite((*this)[i])) continue; - } - if ((*this)[i] > maxV) maxV = (*this)[maxEl = i]; - } -@@ -4195,7 +4417,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; -+ if (!std__isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4205,7 +4427,7 @@ - - for (i = i_min; i < stop; i += step) { - if (omitNaN) { -- if (isnan((*this)[i]) || !isfinite((*this)[i])) continue; -+ if (std__isnan((*this)[i]) || !isfinite((*this)[i])) continue; - } - if ((*this)[i] < minV) minV = (*this)[minEl = i]; - } -@@ -4227,7 +4449,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; -+ if (!std__isnan((*this)[i]) && isfinite((*this)[i])) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4237,7 +4459,7 @@ - - for (i = i_min; i < stop; i+= step) { - if (omitNaN){ -- if (isnan((*this)[i]) || !isfinite((*this)[i])) continue; -+ if (std__isnan((*this)[i]) || !isfinite((*this)[i])) continue; - } - if ((*this)[i] > maxV) maxV = (*this)[maxEl = i]; - else if( (*this)[i] < minV) minV = (*this)[minEl = i]; -@@ -4449,7 +4671,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i].real()) && isfinite((*this)[i].real())) flag = 0; -+ if (!std__isnan((*this)[i].real()) && isfinite((*this)[i].real())) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4459,7 +4681,7 @@ - - for (i = i_min; i < stop; i += step) { - if (omitNaN) { -- if (isnan((*this)[i].real()) || !isfinite((*this)[i].real())) continue; -+ if (std__isnan((*this)[i].real()) || !isfinite((*this)[i].real())) continue; - } - if ((*this)[i].real() > maxV) maxV = (*this)[maxEl = i].real(); - } -@@ -4481,7 +4703,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i].real()) && isfinite((*this)[i].real())) flag = 0; -+ if (!std__isnan((*this)[i].real()) && isfinite((*this)[i].real())) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4491,7 +4713,7 @@ - - for (i = i_min; i < stop; i += step) { - if (omitNaN) { -- if (isnan((*this)[i].real()) || !isfinite((*this)[i].real())) continue; -+ if (std__isnan((*this)[i].real()) || !isfinite((*this)[i].real())) continue; - } - if ((*this)[i].real() < minV) minV = (*this)[minEl = i].real(); - } -@@ -4513,7 +4735,7 @@ - i = start; - int flag = 1; - while (flag == 1) { -- if (!isnan((*this)[i].real()) && isfinite((*this)[i].real())) flag = 0; -+ if (!std__isnan((*this)[i].real()) && isfinite((*this)[i].real())) flag = 0; - if (i + step >= stop) flag = 0; - i += step; - } -@@ -4523,7 +4745,7 @@ - - for (i = i_min; i < stop; i += step) { - if (omitNaN){ -- if (isnan((*this)[i].real()) || !isfinite((*this)[i].real())) continue; -+ if (std__isnan((*this)[i].real()) || !isfinite((*this)[i].real())) continue; - } - if ((*this)[i].real() > maxV) maxV = (*this)[maxEl = i].real(); - else if( (*this)[i].real() < minV) minV = (*this)[minEl = i].real(); -@@ -4544,19 +4766,43 @@ - - } - --void DStructGDL::MinMax( DLong* minE, DLong* maxE, -- BaseGDL** minVal, BaseGDL** maxVal, bool omitNaN, -- SizeT start, SizeT stop, SizeT step, DLong valIx) --{ -- throw GDLException("Struct expression not allowed in this context."); --} - - template<> - BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode) -+ BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) - { - throw GDLException("String expression not allowed in this context."); - } -+template<> -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) -+{ -+ throw GDLException("Object expression not allowed in this context."); -+} -+template<> -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) -+{ -+ throw GDLException("Pointer expression not allowed in this context."); -+} -+ -+template<> -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) -+{ -+ throw GDLException("ULONG expression not allowed in this context."); -+} -+template<> -+BaseGDL* Data_::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -+ BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) -+{ -+ throw GDLException("ULONG64 expression not allowed in this context."); -+} - - #define INCLUDE_CONVOL_CPP 1 - #define CONVOL_BYTE__ -@@ -4565,6 +4811,12 @@ - - #undef CONVOL_BYTE__ - -+#define CONVOL_UINT__ -+ -+#include "convol.cpp" -+ -+#undef CONVOL_UINT__ -+ - #include "convol.cpp" - - template<> -@@ -5127,15 +5379,18 @@ - template - void Data_::Assign( BaseGDL* src, SizeT nEl) - { -- Data_* srcT = dynamic_cast( src); -+ Data_* srcT; // = dynamic_cast( src); - -- auto_ptr< Data_> srcTGuard; -- if( srcT == NULL) -+ Guard< Data_> srcTGuard; -+ if( src->Type() != Data_::t) - { - srcT = static_cast( src->Convert2( Data_::t, BaseGDL::COPY)); -- srcTGuard.reset( srcT); -+ srcTGuard.Init( srcT); - } -- -+ else -+ { -+ srcT = static_cast( src); -+ } - /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -@@ -5151,7 +5406,7 @@ - - // return a new type of itself (only for one dimensional case) - template --Data_* Data_::NewIx( SizeT ix) -+BaseGDL* Data_::NewIx( SizeT ix) - { - return new Data_( (*this)[ ix]); - } -@@ -5228,7 +5483,7 @@ - SizeT nElem = ix->N_Elements(); - - Data_* res = New( ix->Dim(), BaseGDL::NOZERO); -- auto_ptr guard( res); -+ Guard guard( res); - - SizeT upper = dd.size() - 1; - Ty upperVal = (*this)[ upper]; -@@ -5279,7 +5534,7 @@ - SizeT Data_::GetAsIndexStrict( SizeT i) const - { - if( (*this)[i] < 0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript (at index: " + i2s(i) + ").",true,false); - return (*this)[i]; - } -@@ -5294,7 +5549,7 @@ - SizeT Data_::GetAsIndexStrict( SizeT i) const - { - if( (*this)[i] < 0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript (at index: " + i2s(i) + ").",true,false); - return (*this)[i]; - } -@@ -5309,7 +5564,7 @@ - SizeT Data_::GetAsIndexStrict( SizeT i) const - { - if( (*this)[i] < 0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript (at index: " + i2s(i) + ").",true,false); - return (*this)[i]; - } -@@ -5324,7 +5579,7 @@ - SizeT Data_::GetAsIndexStrict( SizeT i) const - { - if( (*this)[i] <= -1.0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript (at index: " + i2s(i) + ").",true,false); - if( (*this)[i] <= 0.0) - return 0; -@@ -5341,7 +5596,7 @@ - SizeT Data_::GetAsIndexStrict( SizeT i) const - { - if( (*this)[i] <= -1.0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript (at index: " + i2s(i) + ").",true,false); - if( (*this)[i] <= 0.0) - return 0; -@@ -5374,7 +5629,7 @@ - return 0; - } - if( l < 0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript.",true,false); - return l; - } -@@ -5390,7 +5645,7 @@ - SizeT Data_::GetAsIndexStrict( SizeT i) const - { - if( real((*this)[i]) <= -1.0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript (at index: " + i2s(i) + ").",true,false); - if( real((*this)[i]) <= 0.0) - return 0; -@@ -5407,7 +5662,7 @@ - SizeT Data_::GetAsIndexStrict( SizeT i) const - { - if( real((*this)[i]) <= -1.0) -- throw GDLException(NULL,"Array used to subscript array " -+ throw GDLException(-1,NULL,"Array used to subscript array " - "contains out of range (<0) subscript (at index: " + i2s(i) + ").",true,false); - if( real((*this)[i]) <= 0.0) - return 0; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/datatypes.hpp gdl/src/datatypes.hpp ---- gdl-0.9.3/src/datatypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/datatypes.hpp 2013-07-31 09:41:43.786246231 -0600 -@@ -26,8 +26,9 @@ - #include - - //#include --#include -+// #include - -+// #include - #include "typedefs.hpp" - #include "basegdl.hpp" - #include "typetraits.hpp" -@@ -37,11 +38,28 @@ - #pragma interface - #endif - -+ -+// for each group we need one definition -+// usage: GDL_DEFINE_INTEGER_FUNCTION(retType) fName( arg list) { definition} -+#define GDL_DEFINE_INTEGER_FUNCTION( retType ) templatetemplate< typename U> typename U::template IfInteger< retType >::type Data_:: -+#define GDL_DEFINE_FLOAT_FUNCTION( retType ) templatetemplate< typename U> typename U::template IfFloat< retType >::type Data_:: -+#define GDL_DEFINE_COMPLEX_FUNCTION( retType ) templatetemplate< typename U> typename U::template IfComplex< retType >::type Data_:: -+#define GDL_DEFINE_OTHER_FUNCTION( retType ) templatetemplate< typename U> typename U::template IfOther< retType >::type Data_:: -+ - const size_t multiAlloc = 256; - - template - class Data_: public Sp - { -+ -+// save some typing. Declares function "fName" for all four groups (with return type "retType") -+#define GDL_DECLARE_FUNCTION( retType, fName, ... ) \ -+template< typename U = Sp > typename U::template IfInteger< retType >::type fName( __VA_ARGS__); \ -+template< typename U = Sp > typename U::template IfFloat< retType >::type fName( __VA_ARGS__); \ -+template< typename U = Sp > typename U::template IfComplex< retType >::type fName( __VA_ARGS__); \ -+template< typename U = Sp > typename U::template IfOther< retType >::type fName( __VA_ARGS__) -+ -+ - public: - typedef typename Sp::Ty Ty; - typedef Sp Traits; -@@ -53,11 +71,44 @@ - #endif - - typedef typename Sp::DataT DataT; -+#ifdef USE_EIGEN -+ EIGEN_ALIGN16 DataT dd; // the data -+#else - DataT dd; // the data -+#endif -+ -+public: -+ -+// #define TESTTG // TEST TEMPLATE GROUPING -+ -+#ifdef TESTTG -+ -+void TestTemplateGrouping(); -+ -+// #define GDL_TEMPLATE_Integer( retType ) template< typename U = Sp > typename U::template IfInteger< retType >::type -+// #define GDL_TEMPLATE_IntegerDef( retType ) templatetemplate< typename U> typename U::template IfInteger< retType >::type Data_:: -+ -+ -+GDL_DECLARE_FUNCTION(bool,Test2); -+ -+// template< typename U = Sp > -+//typename U::template IfInteger::type -+// GDL_TEMPLATE_Integer(bool) Test2(); -+// template< typename U = Sp > -+// typename U::template IfFloat::type -+// Test2(); -+// template< typename U = Sp > -+// typename U::template IfComplex::type -+// Test2(); -+// template< typename U = Sp > -+// typename U::template IfOther::type -+// Test2(); -+ -+#endif - - public: - // memory management optimization --static std::deque< void*> freeList; -+static FreeListT freeList; - - // operator new and delete - static void* operator new( size_t bytes); -@@ -138,10 +189,12 @@ - SizeT ToTransfer() const; // IO transfer count - SizeT Sizeof() const; - -+ int HashCompare( BaseGDL* p2) const; -+ - void Clear(); - void Construct(); // construction (for DStructGDL) - void ConstructTo0(); // construction (for DStructGDL) -- void Destruct(); // destruction (for DStructGDL) -+ void Destruct(); // destruction (for DStructGDL) - - BaseGDL* SetBuffer( const void* b); - void SetBufferSize( SizeT s); -@@ -153,9 +206,10 @@ - std::istream& FromStream(std::istream& i); - - // used by the interpreter -- int Scalar2index( SizeT& st) const; -+ int Scalar2Index( SizeT& st) const; - int Scalar2RangeT( RangeT& st) const; - RangeT LoopIndex() const; -+ DDouble HashValue() const; - - // used for indexing of arrays - SizeT GetAsIndex( SizeT i) const; -@@ -235,8 +289,8 @@ - - BaseGDL* Abs() const; - -- BaseGDL* Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode); -+ BaseGDL* Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode); - BaseGDL* Rebin( const dimension& newDim, bool sample); - - void Assign( BaseGDL* src, SizeT nEl); -@@ -255,13 +309,23 @@ - // operators - BaseGDL* UMinus(); // UMinus for SpDString returns float - Data_* NotOp(); -+// GDL_DECLARE_FUNCTION( Data_*, AndOp, BaseGDL* r); - Data_* AndOp( BaseGDL* r); - Data_* AndOpInv( BaseGDL* r); - Data_* OrOp( BaseGDL* r); - Data_* OrOpInv( BaseGDL* r); - Data_* XorOp( BaseGDL* r); -+ - BaseGDL* Add( BaseGDL* r); - BaseGDL* AddInv( BaseGDL* r); -+ BaseGDL* AddS( BaseGDL* r); -+ BaseGDL* AddInvS( BaseGDL* r); -+ -+ BaseGDL* AddNew( BaseGDL* r); // implemented -+ BaseGDL* AddInvNew( BaseGDL* r); // implemented -+ BaseGDL* AddSNew( BaseGDL* r); // implemented -+ BaseGDL* AddInvSNew( BaseGDL* r); // implemented -+ - // Data_* AddNew( BaseGDL* r); - // Data_* AddInvNew( BaseGDL* r); - BaseGDL* Sub( BaseGDL* r); -@@ -278,7 +342,8 @@ - Data_* PowInv( BaseGDL* r); - Data_* PowInt( BaseGDL* r); - // Data_* PowIntNew( BaseGDL* r); -- Data_* MatrixOp( BaseGDL* r, bool transpose, bool transposeResult, bool strassen); -+ -+ Data_* MatrixOp( BaseGDL* r, bool atranspose, bool btranspose); - - // operators with scalar - Data_* AndOpS( BaseGDL* r); -@@ -286,8 +351,6 @@ - Data_* OrOpS( BaseGDL* r); - Data_* OrOpInvS( BaseGDL* r); - Data_* XorOpS( BaseGDL* r); -- BaseGDL* AddS( BaseGDL* r); -- BaseGDL* AddInvS( BaseGDL* r); - // Data_* AddSNew( BaseGDL* r); - // Data_* AddInvSNew( BaseGDL* r); - Data_* SubS( BaseGDL* r); -@@ -315,8 +378,6 @@ - // Data_* GeOpNew( BaseGDL* r); - // Data_* LtOpNew( BaseGDL* r); - // Data_* GtOpNew( BaseGDL* r); -- BaseGDL* AddNew( BaseGDL* r); // implemented -- BaseGDL* AddInvNew( BaseGDL* r); // implemented - BaseGDL* SubNew( BaseGDL* r); - BaseGDL* SubInvNew( BaseGDL* r); - Data_* LtMarkNew( BaseGDL* r); -@@ -336,8 +397,6 @@ - Data_* OrOpSNew( BaseGDL* r); - Data_* OrOpInvSNew( BaseGDL* r); - Data_* XorOpSNew( BaseGDL* r); -- BaseGDL* AddSNew( BaseGDL* r); // implemented -- BaseGDL* AddInvSNew( BaseGDL* r); // implemented - BaseGDL* SubSNew( BaseGDL* r); - BaseGDL* SubInvSNew( BaseGDL* r); - Data_* LtMarkSNew( BaseGDL* r); -@@ -384,7 +443,7 @@ - Data_* Index( ArrayIndexListT* ixList); - - // return a new type of itself -- Data_* NewIx( SizeT ix); -+ BaseGDL* NewIx( SizeT ix); - Data_* NewIx( BaseGDL* ix, bool strict); - Data_* NewIx( AllIxBaseT* ix, const dimension* dIn); - Data_* NewIxFrom( SizeT s); -@@ -403,7 +462,8 @@ - int prec, char fill, BaseGDL::IOMode oM = BaseGDL::FIXED); - SizeT OFmtI( std::ostream* os, SizeT offs, SizeT num, int width, - int minN, char fill, BaseGDL::IOMode oM = BaseGDL::DEC); -- -+ SizeT OFmtCal( std::ostream* os, SizeT offs, SizeT num, int width, -+ int minN, char fill, BaseGDL::Cal_IOMode oM = BaseGDL::DEFAULT); - // formatting input functions - SizeT IFmtA( std::istream* is, SizeT offset, SizeT num, int width); - SizeT IFmtF( std::istream* is, SizeT offs, SizeT num, int width); -@@ -425,6 +485,10 @@ - // used for concatenation, called from CatArray - // assumes that everything is checked (see CatInfo) - void CatInsert( const Data_* srcArr, const SizeT atDim, SizeT& at); -+ -+ // only to be used here -+#undef GDL_DECLARE_FUNCTION -+ - }; - - // template<> Data_::Data_(const Ty& d_); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/datatypesref.cpp gdl/src/datatypesref.cpp ---- gdl-0.9.3/src/datatypesref.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/datatypesref.cpp 2013-07-31 09:41:43.788246224 -0600 -@@ -18,6 +18,7 @@ - // to be included from datatypes.cpp - #ifdef INCLUDE_DATATYPESREF_CPP - #undef INCLUDE_DATATYPESREF_CPP -+#include "nullgdl.hpp" - - // reference counting for INIT - template<> -@@ -31,7 +32,7 @@ - /*#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for*/ -- for( int i=0; i - void Data_::Assign( BaseGDL* src, SizeT nEl) - { -- Data_* srcT = dynamic_cast( src); -+// Data_* srcT = dynamic_cast( src); -+// -+// Guard< Data_> srcTGuard; -+// if( srcT == NULL) -+// { -+// srcT = static_cast( src->Convert2( Data_::t, BaseGDL::COPY)); -+// srcTGuard.Reset( srcT); -+// } -+ Data_* srcT; // = dynamic_cast( src); - -- auto_ptr< Data_> srcTGuard; -- if( srcT == NULL) -+ Guard< Data_> srcTGuard; -+ if( src->Type() != Data_::t) - { - srcT = static_cast( src->Convert2( Data_::t, BaseGDL::COPY)); -- srcTGuard.reset( srcT); -+ srcTGuard.Init( srcT); - } -+ else -+ { -+ srcT = static_cast( src); -+ } - - //#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { -@@ -1182,14 +1195,26 @@ - template<> - void Data_::Assign( BaseGDL* src, SizeT nEl) - { -- Data_* srcT = dynamic_cast( src); -+// Data_* srcT = dynamic_cast( src); -+// -+// Guard< Data_> srcTGuard; -+// if( srcT == NULL) -+// { -+// srcT = static_cast( src->Convert2( Data_::t, BaseGDL::COPY)); -+// srcTGuard.Reset( srcT); -+// } -+ Data_* srcT; // = dynamic_cast( src); - -- auto_ptr< Data_> srcTGuard; -- if( srcT == NULL) -+ Guard< Data_> srcTGuard; -+ if( src->Type() != Data_::t) - { - srcT = static_cast( src->Convert2( Data_::t, BaseGDL::COPY)); -- srcTGuard.reset( srcT); -+ srcTGuard.Init( srcT); - } -+ else -+ { -+ srcT = static_cast( src); -+ } - - //#pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { -@@ -1208,7 +1233,7 @@ - - // return a new type of itself (only for one dimensional case) - template<> --Data_* Data_::NewIx( SizeT ix) -+BaseGDL* Data_::NewIx( SizeT ix) - { - Ty b = (*this)[ ix]; - GDLInterpreter::IncRef( b); -@@ -1217,11 +1242,107 @@ - - // return a new type of itself (only for one dimensional case) - template<> --Data_* Data_::NewIx( SizeT ix) -+BaseGDL* Data_::NewIx( SizeT ix) - { -- Ty b = (*this)[ ix]; -- GDLInterpreter::IncRefObj( b); -- return new Data_( (*this)[ ix]); -+ if( !this->StrictScalar()) -+ { -+ Ty b = (*this)[ ix]; -+ GDLInterpreter::IncRefObj( b); -+ return new Data_( (*this)[ ix]); -+ } -+ -+ DObj s = dd[0]; // is StrictScalar() -+ if( s == 0) // no overloads for null object -+ return new Data_( 0); -+ -+ DStructGDL* oStructGDL= GDLInterpreter::GetObjHeapNoThrow( s); -+ if( oStructGDL == NULL) // if object not valid -> default behaviour -+ return new Data_( 0); -+ -+ DStructDesc* desc = oStructGDL->Desc(); -+ -+ if( desc->IsParent("LIST")) -+ { -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ // because of .RESET_SESSION, we cannot use static here -+ DStructDesc* containerDesc=structDesc::GDL_CONTAINER_NODE; -+ -+ // no static here, might vary in derived object -+// unsigned pHeadTag = desc->TagIndex( "PHEAD"); -+ static unsigned pTailTag = desc->TagIndex( "PTAIL"); -+ -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+// unsigned nListTag = desc->TagIndex( "NLIST"); -+// SizeT listSize = (*static_cast(oStructGDL->GetTag( nListTag, 0)))[0]; -+ -+ DPtr actP = (*static_cast(oStructGDL->GetTag( pTailTag, 0)))[0]; -+ for( SizeT elIx = 0; elIx < ix; ++elIx) -+ { -+ BaseGDL* actPHeap = BaseGDL::interpreter->GetHeap( actP); -+ if( actPHeap->Type() != GDL_STRUCT) -+ throw GDLException( "LIST node must be a STRUCT."); -+ DStructGDL* actPStruct = static_cast( actPHeap); -+ if( actPStruct->Desc() != containerDesc) -+ throw GDLException( "LIST node must be a GDL_CONTAINER_NODE STRUCT."); -+ -+ actP = (*static_cast( actPStruct->GetTag( pNextTag, 0)))[0]; -+ } -+ -+ BaseGDL* actPHeap = BaseGDL::interpreter->GetHeap( actP); -+ if( actPHeap->Type() != GDL_STRUCT) -+ throw GDLException( "LIST node must be a STRUCT."); -+ DStructGDL* actPStruct = static_cast( actPHeap); -+ if( actPStruct->Desc() != containerDesc) -+ throw GDLException( "LIST node must be a GDL_CONTAINER_NODE STRUCT."); -+ -+ actP = (*static_cast(actPStruct->GetTag( pDataTag, 0)))[0]; -+ -+ BaseGDL* result = BaseGDL::interpreter->GetHeap( actP); -+ if( result == NULL) -+ return NullGDL::GetSingleInstance(); -+ return result->Dup(); -+ } -+ if( desc->IsParent("HASH")) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned nForEachTag = structDesc::HASH->TagIndex( "TABLE_FOREACH"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ DPtr pHashTable = (*static_cast( oStructGDL->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+ DLong validIx = 0; -+ DLong i = 0; -+ for(; iN_Elements(); ++i) -+ { -+ DPtr pKey = (*static_cast(hashTable->GetTag( pKeyTag, i)))[0]; -+ if( pKey != 0) -+ { -+ if( validIx == ix) -+ break; -+ ++validIx; -+ } -+ } -+ assert( iN_Elements()); -+ -+ DPtr pValue = (*static_cast(hashTable->GetTag( pValueTag, i)))[0]; -+ DPtr pKey = (*static_cast(hashTable->GetTag( pKeyTag, i)))[0]; -+ -+ (*static_cast( oStructGDL->GetTag( nForEachTag, 0)))[0] = pKey; -+ -+ BaseGDL* result = BaseGDL::interpreter->GetHeap( pValue); -+ if( result == NULL) -+ return NullGDL::GetSingleInstance(); -+ return result->Dup(); -+ } -+ -+ return new Data_( s); - } - - -@@ -1459,7 +1580,7 @@ - SizeT nElem = ix->N_Elements(); - - Data_* res = New( ix->Dim(), BaseGDL::NOZERO); -- auto_ptr guard( res); -+ Guard guard( res); - - SizeT upper = dd.size() - 1; - Ty upperVal = (*this)[ upper]; -@@ -1497,7 +1618,7 @@ - SizeT nElem = ix->N_Elements(); - - Data_* res = New( ix->Dim(), BaseGDL::NOZERO); -- auto_ptr guard( res); -+ Guard guard( res); - - SizeT upper = dd.size() - 1; - Ty upperVal = (*this)[ upper]; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dcommon.cpp gdl/src/dcommon.cpp ---- gdl-0.9.3/src/dcommon.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dcommon.cpp 2013-07-08 12:39:21.585396797 -0600 -@@ -35,7 +35,7 @@ - - DCommon::~DCommon() - { -- Purge( var); -+ PurgeContainer( var); - } - - void DCommon::AddVar(const string& v) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dcommon.hpp gdl/src/dcommon.hpp ---- gdl-0.9.3/src/dcommon.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dcommon.hpp 2013-07-31 09:41:43.789246221 -0600 -@@ -90,8 +90,8 @@ - DVar* Var(unsigned ix); - }; - --typedef std::deque CommonBaseListT; --typedef std::deque CommonListT; -+typedef std::vector CommonBaseListT; -+typedef std::vector CommonListT; - - class DCommon_contains_var: public std::unary_function - { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dcompiler.cpp gdl/src/dcompiler.cpp ---- gdl-0.9.3/src/dcompiler.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dcompiler.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -410,7 +410,7 @@ - - // must be compiled here - ARRAYDEFNode* c = new ARRAYDEFNode( n); -- auto_ptr< ARRAYDEFNode> guard( c); -+ Guard< ARRAYDEFNode> guard( c); - assert( c->ConstantArray()); - - // cout << "ProgNodeP:" << endl; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/default_io.cpp gdl/src/default_io.cpp ---- gdl-0.9.3/src/default_io.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/default_io.cpp 2013-07-31 09:41:43.800246182 -0600 -@@ -25,6 +25,8 @@ - //#include "io.hpp" - #include "ofmt.hpp" - #include "gdljournal.hpp" -+#include "list.hpp" -+#include "hash.hpp" - - using namespace std; - -@@ -826,17 +828,68 @@ - return o; - } - // obj --inline void ObjHeapVarString(ostream& o, DObj obj) -+void ObjHeapVarString(ostream& o, DObj obj) - { - if( obj != 0) -- o << ""; -+ { -+ DStructGDL* oStructGDL= GDLInterpreter::GetObjHeapNoThrow( obj); -+ if( oStructGDL != NULL) -+ { -+ o << "Desc()->Name() <<")>"; -+ } -+ else -+ o << ""; -+ } - else - o << ""; - } - template<> - ostream& Data_::ToStream(ostream& o, SizeT w, SizeT* actPosPtr) - { -- SizeT nElem=N_Elements(); -+ static bool recursive = false; -+ if( this->StrictScalar() && !recursive) -+ { -+ DObj s = dd[0]; // is StrictScalar() -+ if( s != 0) // no overloads for null object -+ { -+ DStructGDL* oStructGDL= GDLInterpreter::GetObjHeapNoThrow( s); -+ if( oStructGDL != NULL) // if object not valid -> default behaviour -+ { -+ DStructDesc* desc = oStructGDL->Desc(); -+ -+ if( desc->IsParent("LIST")) -+ { -+ recursive = true; -+ try{ -+ LIST__ToStream(oStructGDL,o,w,actPosPtr); -+ recursive = false; -+ } catch( ...) -+ { -+ recursive = false; -+ throw; -+ } -+ -+ return o; -+ } -+ if( desc->IsParent("HASH")) -+ { -+ recursive = true; -+ try{ -+ HASH__ToStream(oStructGDL,o,w,actPosPtr); -+ recursive = false; -+ } catch( ...) -+ { -+ recursive = false; -+ throw; -+ } -+ -+ return o; -+ } -+ } -+ } -+ } -+ -+ SizeT nElem=this->Size(); - if( nElem == 0) - throw GDLException("Variable is undefined."); - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/deviceps.hpp gdl/src/deviceps.hpp ---- gdl-0.9.3/src/deviceps.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/deviceps.hpp 2013-07-08 12:39:21.586396785 -0600 -@@ -16,12 +16,15 @@ - ***************************************************************************/ - - #ifndef DEVICEPS_HPP_ --# define DEVICEPS_HPP_ -+#define DEVICEPS_HPP_ -+ -+#include "gdlpsstream.hpp" -+#include "plotting.hpp" // get_axis_crange for TV() -+#include "initsysvar.hpp" -+#include // GSL_CONST_MKSA_INCH -+ -+#include "objects.hpp" - --# include "gdlpsstream.hpp" --# include "plotting.hpp" // get_axis_crange for TV() --# include "initsysvar.hpp" --# include // GSL_CONST_MKSA_INCH - - # ifdef USE_PSLIB - # include // tmpnam -@@ -35,6 +38,14 @@ - # define SETOPT setopt - # endif - -+#ifdef _MSC_VER -+#define cm2in (.01 / GSL_CONST_MKSA_INCH); // This is not good, but works -+#define dpi 72.0 //in dpi; -+#else -+ static const float cm2in = .01 / GSL_CONST_MKSA_INCH; -+ static const PLFLT dpi = 72.0 ; //in dpi; -+#endif -+ - class DevicePS: public Graphics - { - std::string fileName; -@@ -49,12 +60,7 @@ - bool encapsulated; - float scale; - -- static const int dpi = 72; --#ifdef _MSC_VER --#define cm2in (.01 / GSL_CONST_MKSA_INCH); // This is not good, but works --#else -- static const float cm2in = .01 / GSL_CONST_MKSA_INCH; --#endif -+ GDLStream *psUnit; - - void InitStream() - { -@@ -66,56 +72,74 @@ - - if( nx <= 0) nx = 1; - if( ny <= 0) ny = 1; -- -- actStream = new GDLPSStream( nx, ny, SysVar::GetPFont(), encapsulated); -+ actStream = new GDLPSStream( nx, ny, (int)SysVar::GetPFont(), encapsulated, color); - - actStream->sfnam( fileName.c_str()); - -+ // trying to solve bug report 3611898 -+ // AC 29-Avril-2013: the way I found to link GDLPSStream* and GDLStream* -+ DLong lun=GetLUN(); -+ psUnit = &fileUnits[ lun-1]; -+ psUnit->Open(fileName,fstream::out,false,false,false, -+ defaultStreamWidth,false,false); -+ (*static_cast( dStruct->GetTag(dStruct->Desc()->TagIndex("UNIT"))))[0]=lun; -+ - // zeroing offsets (xleng and yleng are the default ones but they need to be specified - // for the offsets to be taken into account by spage(), works with plplot >= 5.9.9) -- actStream->spage(dpi, dpi, 540, 720, 0, 0); -+ actStream->spage(dpi, dpi, 540, 720, 0, 0); //plplot default: portrait! - - // as setting the offsets and sizes with plPlot is (extremely) tricky, and some of these setting - // are hardcoded into plplot (like EPS header, and offsets in older versions of plplot) - // here we only specify the aspect ratio - size an offset are handled by pslib when device,/close is called --// char as[32]; --// sprintf(as, "%f", XPageSize / YPageSize); --// actStream->SETOPT( "a", as); -- std::string as = i2s( XPageSize / YPageSize); -- actStream->SETOPT( "a", as.c_str()); - -+ // patch 3611949 by Joanna, 29 Avril 2013 -+ PLFLT pageRatio=XPageSize/YPageSize; -+ std::string as = i2s( pageRatio); -+ actStream->SETOPT( "a", as.c_str()); -+ - // plot orientation -- actStream->sori(orient_portrait ? 1 : 2); -- -+ //std::cout << "orientation : " << orient_portrait<< std::endl; -+ -+ actStream->sdiori(orient_portrait ? 1 : 2); -+ - // no pause on destruction - actStream->spause( false); - - // extended fonts - actStream->fontld( 1); -- -- // set color map -+ -+ // avoid to set color map 0 -- makes plplot very slow (?) - PLINT r[ctSize], g[ctSize], b[ctSize]; - actCT.Get( r, g, b); -- // actStream->scmap0( r, g, b, ctSize); -- actStream->scmap1( r, g, b, ctSize); -- actStream->scolbg(255,255,255); // white background -- -+// actStream->scmap0( r, g, b, ctSize); -+ actStream->scmap1( r, g, b, ctSize); - // default: black+white (IDL behaviour) -- //actStream->scolor( color); // has no effect -- if (color == 0) -- actStream->SETOPT( "drvopt","text=0,color=0"); -- else -- actStream->SETOPT( "drvopt","text=0,color=1"); -- color=0; -+ if (color == 0) -+ { -+ actStream->SETOPT( "drvopt","text=0,color=0"); -+ } -+ else -+ { -+ actStream->SETOPT( "drvopt","text=0,color=1"); //need to pass all options with the same 'setopt' command. -+ } -+ actStream->scolbg(255,255,255); // start with a white background - - actStream->Init(); - -+ // need to be called initially. permit to fix things -+ actStream->ssub(1,1); -+ actStream->adv(0); - // load font - actStream->font( 1); -+ actStream->vpor(0,1,0,1); -+ actStream->wind(0,1,0,1); - actStream->DefaultCharSize(); -+ //in case these are not initalized, here is a good place to do it. -+ if (actStream->updatePageInfo()==true) -+ { -+ actStream->GetPlplotDefaultCharSize(); //initializes everything in fact.. - -- // (*pMulti)[ 0] = 0; -- actStream->adv(0); -+ } - } - - private: -@@ -123,7 +147,7 @@ - { - # ifndef USE_PSLIB - Warning("Warning: pslib support is mandatory for the PostScript driver to handle the following"); -- Warning(" keywords: [X,Y]SIZE, [X,Y]OFFSET, SCALE_FACTOR, LANDSCAPE, PORTRAIT, ENCAPSULATED"); -+ Warning(" keywords: [X,Y]OFFSET, SCALE_FACTOR, ENCAPSULATED"); - # else - PSDoc *ps = PS_new(); - GDLGuard psGuard( ps, PS_delete); -@@ -163,13 +187,45 @@ - tmp = (login == NULL ? "?" : login) + string("@") + uts.nodename; - PS_set_info(ps, "Author", tmp.c_str()); - } -+ //bug: PSLIB does not return the correct boundingbox, it forgets offx and offy. Try to get it -+ //back (using pslib own code!)! -+ char *bb; -+ FILE *feps; -+ char buffer[1024]; //largely sufficient -+ int nbytes; -+ feps=fopen(fileName.c_str(), "r"); -+ nbytes=fread(buffer,sizeof(char),1023,feps); -+ fclose(feps); -+ buffer[1023]=0; -+ bb = strstr(buffer, "%%BoundingBox:"); -+ float offx, offy, width, height; -+ if(bb) { -+ bb += 15; -+ sscanf(bb, "%f %f %f %f", &offx, &offy, &width, &height); -+ } else { -+ offx=0; -+ offy=0; -+ width=500; -+ height=500; //silly values, will be replaced afterwards hopefully. -+ } - - // TODO - //psfont = PS_findfont(ps, "Helvetica", "", 0); - //PS_setfont(ps, psfont, 8.0); - -+ char bbstr [20], offstr [20]; -+ int bbXSize, bbYSize; - { -- PS_begin_page(ps, XPageSize * cm2in * dpi, YPageSize * cm2in * dpi); -+ -+ int bbXoff = XOffset*cm2in*dpi; -+ int bbYoff = YOffset*cm2in*dpi; -+ bbXSize = orient_portrait ? bbXoff + XPageSize*cm2in*dpi*scale : bbXoff + YPageSize*cm2in*dpi*scale; -+ bbYSize = orient_portrait ? bbYoff + YPageSize*cm2in*dpi*scale : bbYoff + XPageSize*cm2in*dpi*scale; -+ sprintf(bbstr,"%i %i %i %i",bbXoff,bbYoff,bbXSize,bbYSize); -+ sprintf(offstr,"%i %i",bbXoff,bbYoff); -+ -+ PS_set_info(ps,"BoundingBox",bbstr); -+ PS_begin_page(ps, bbXSize, bbYSize); - { - int psimage = PS_open_image_file(ps, "eps", fileName.c_str(), NULL, 0); - if (psimage == 0) -@@ -177,14 +233,14 @@ - Warning("Warning: pslib failed to load plPlot output file."); - goto cleanup; - } -- -- float scl = orient_portrait -- ? (XPageSize * cm2in * dpi) / (PS_get_value(ps, "imagewidth", (float) psimage)) -- : (YPageSize * cm2in * dpi) / (PS_get_value(ps, "imagewidth", (float) psimage)); -+ -+ float scl = 0.98*min((bbXSize-bbXoff) / (width-offx), (bbYSize-bbYoff) / (height-offy) ); -+ int margx = ((bbXSize-bbXoff) - scl*(width-offx))/2; -+ int margy = ((bbYSize-bbYoff) - scl*(height-offy))/2; - PS_place_image(ps, psimage, -- XOffset * cm2in * dpi, -- YOffset * cm2in * dpi, -- scale * scl -+ bbXoff-offx*scl + margx, -+ bbYoff-offy*scl + margy, -+ scl - ); - PS_close_image(ps, psimage); - } -@@ -192,7 +248,7 @@ - PS_close(ps); - } - -- // write contents to fileName -+ // Replace PageBoundingBox and CropBox and write contents to fileName - { - rewind(fp); - FILE *fp_plplot = fopen(fileName.c_str(), "w"); -@@ -202,12 +258,50 @@ - Warning("Warning: failed to open plPlot-generated file"); - goto cleanup; - } -- const size_t buflen=4096; -- unsigned char buff[buflen]; -+ -+ // When multiple pages are supported, PageBoundingBox and the cropbox -+ // will appear more than once. Then this section will need to be redone. -+ -+ // Edit: change the two 0's after the PageBoundingBox -+ string pbstr=string("%%PageBoundingBox: ")+offstr; -+ // edits will be in the first 12288 bytes; add the length of offstr-3 -+ const size_t buflen=12288 + pbstr.length()-22; -+ //const size_t buflen=4096; -+ char buff[buflen]; -+ -+ //do the first read: -+ size_t cnt = fread(&buff, 1, 12288, fp); -+ string sbuff; -+ sbuff = string(buff); -+ -+ // find the PageBoundingBox statement -+ size_t pos = sbuff.find("%%PageBoundingBox: 0 0"); -+ if (pos != string::npos) { -+ sbuff.replace(pos,22,pbstr); // will change the size of sbuff by offstr-3 -+ cnt = cnt + pbstr.length()-22; -+ } -+ -+ // PSlib outputs pdfmarks which resize the PDF to the size of the boundingbox -+ // this is nice, but not IDL behaviour (and anyway, the two 0's are wrong) -+ char mychar[60]; -+ sprintf(mychar,"[ /CropBox [0 0 %i.00 %i.00] /PAGE pdfmark",bbXSize,bbYSize); -+ string pdfstr=string(mychar); -+ string pdfrepl(pdfstr.length(),' '); -+ pos = sbuff.find(pdfstr); -+ if (pos != string::npos) {sbuff.replace(pos,pdfstr.length(),pdfrepl);} // will not change size of sbuff -+ -+ // write the first buflen to file -+ strcpy(buff,sbuff.c_str()); -+ if (fwrite(&buff, 1, buflen, fp_plplot) < buflen) -+ { -+ Warning("Warning: failed to overwrite the plPlot-generated file with pslib output"); -+ } -+ -+ // read the rest of fp and write to file - while (true) - { -- size_t cnt = fread(&buff, 1, buflen, fp); -- if (!cnt) break; -+ cnt = fread(&buff, 1, buflen, fp); -+ if (!cnt) break; - if (fwrite(&buff, 1, cnt, fp_plplot) < cnt) - { - Warning("Warning: failed to overwrite the plPlot-generated file with pslib output"); -@@ -226,9 +320,130 @@ - # endif - } - -+private: -+ void epsHacks() -+ { -+ // using namespace std; -+ //PLPLOT outputs a strange boundingbox; this hack directly edits the eps file. -+ //if the plplot bug ever gets fixed, this hack won't be needed. -+ char *bb; -+ FILE *feps; -+ size_t buflen=2048;//largely sufficient -+ char buffer[buflen]; -+ int cnt; -+ ifstream myfile (fileName.c_str()); -+ feps=fopen(fileName.c_str(), "r"); -+ cnt=fread(buffer,sizeof(char),buflen,feps); -+ -+ //read original boundingbox -+ bb = strstr(buffer, "%%BoundingBox:"); -+ int offx, offy, width, height; -+ bb += 15; -+ sscanf(bb, "%i %i %i %i", &offx, &offy, &width, &height); -+ float hsize = XPageSize*cm2in*dpi*scale, vsize = YPageSize*cm2in*dpi*scale; -+ float newwidth = (width - offx), newheight = (height - offy); -+ float hscale = (orient_portrait ? hsize : vsize)/newwidth/5.0; -+ float vscale = (orient_portrait ? vsize : hsize)/newheight/5.0; -+ hscale = min(hscale,vscale)*0.98; -+ vscale = hscale; -+ float hoff = -5.*offx*hscale + ((orient_portrait ? hsize : vsize) - 5.0*hscale*newwidth)*0.5; -+ float voff = -5.*offy*vscale + ((orient_portrait ? vsize : hsize) - 5.0*vscale*newheight)*0.5; -+ -+ //replace with a more sensible boundingbox -+ string sbuff = string(buffer); -+ stringstream searchstr,replstr; -+ searchstr << "BoundingBox: " << offx << " " << offy << " " << width << " " << height; -+ replstr << "BoundingBox: 0 0 " << floor((orient_portrait ? hsize : vsize)+0.5) << " " << floor((orient_portrait ? vsize : hsize)+0.5); -+ size_t pos = sbuff.find(searchstr.str()); -+ int extralen; -+ if (pos != string::npos) { -+ sbuff.replace(pos,searchstr.str().length(),replstr.str()); -+ extralen = replstr.str().length()-searchstr.str().length(); -+ } -+ -+ //replace values of hscale, vscale -+ searchstr.str(""); -+ searchstr << "{hs 3600 div} def" << endl << "/YScale" << endl << " {vs 2700 div} def"; -+ replstr.str(""); -+ replstr << hscale << " def" << endl << "/YScale" << endl << " " << vscale << " def"; -+ pos = sbuff.find(searchstr.str()); -+ if (pos != string::npos) { -+ sbuff.replace(pos,searchstr.str().length(),replstr.str()); -+ extralen = extralen + replstr.str().length()-searchstr.str().length(); -+ } -+ -+ //replace the values of hoffset and voffset -+ searchstr.str(""); -+ searchstr << "0 @hoffset" << endl << "0 @voffset"; -+ replstr.str(""); -+ replstr << floor(hoff+0.5) << " " << "@hoffset" << endl << floor(voff+0.5) << " " << "@voffset"; -+ pos = sbuff.find(searchstr.str()); -+ if (pos != string::npos) { -+ sbuff.replace(pos,searchstr.str().length(),replstr.str()); -+ extralen = extralen + replstr.str().length()-searchstr.str().length(); -+ } -+ -+ //add landscape -+ if (!orient_portrait) { -+ searchstr.str("%%Page: 1 1"); -+ replstr.str(""); -+ replstr << "%%Page: 1 1" << endl << "%%PageOrientation: Landscape" << endl; -+ pos = sbuff.find(searchstr.str()); -+ if (pos != string::npos) { -+ sbuff.replace(pos,searchstr.str().length(),replstr.str()); -+ extralen = extralen + replstr.str().length()-searchstr.str().length(); -+ } -+ } -+ -+ //open temp file -+ FILE *fp = tmpfile(); // this creates a file which should be deleted automaticaly when it is closed -+ FILEGuard fpGuard( fp, fclose); -+ if (fp == NULL) { -+ Warning("Warning: failed to create temporary PostScript file."); -+ return; -+ } -+ -+ // write the first buflen to temp file -+ char buffer2[buflen + extralen]; -+ strcpy(buffer2,sbuff.c_str()); -+ fwrite(&buffer2, 1, buflen+extralen, fp); -+ -+ // read the rest of feps and write to temp file -+ while (true) -+ { -+ cnt = fread(&buffer, 1, buflen, feps); -+ if (!cnt) break; -+ if (fwrite(&buffer, 1, cnt, fp) < cnt) -+ { -+ Warning("Warning: failed to write to temporary file"); -+ } -+ } -+ fclose(feps); -+ -+ // copy temp file to fileName -+ rewind(fp); -+ FILE *fp_plplot = fopen(fileName.c_str(), "w"); -+ FILEGuard fp_plplotGuard( fp_plplot, fclose); -+ if (fp_plplot == NULL) { -+ Warning("Warning: failed to open plPlot-generated file"); -+ return; -+ } -+ while (true) -+ { -+ cnt = fread(&buffer, 1, buflen, fp); -+ if (!cnt) break; -+ if (fwrite(&buffer, 1, cnt, fp_plplot) < cnt) -+ { -+ Warning("Warning: failed to overwrite the plPlot-generated file with pslib output"); -+ } -+ } -+ -+ } -+ - public: - DevicePS(): Graphics(), fileName( "gdl.ps"), actStream( NULL), color(0), -- decomposed( 0), encapsulated(false), scale(1.) -+ decomposed( 0), encapsulated(false), scale(1.), XPageSize(17.78), YPageSize(12.7), -+ XOffset(0.0),YOffset(0.0) - { - name = "PS"; - -@@ -239,22 +454,22 @@ - - dStruct = new DStructGDL( "!DEVICE"); - dStruct->InitTag("NAME", DStringGDL( name)); -- dStruct->InitTag("X_SIZE", DLongGDL( 17780)); -- dStruct->InitTag("Y_SIZE", DLongGDL( 12700)); -- dStruct->InitTag("X_VSIZE", DLongGDL( 640)); -- dStruct->InitTag("Y_VSIZE", DLongGDL( 512)); -- dStruct->InitTag("X_CH_SIZE", DLongGDL( 0)); -- dStruct->InitTag("Y_CH_SIZE", DLongGDL( 0)); -- dStruct->InitTag("X_PX_CM", DFloatGDL( 1000.0)); -+ dStruct->InitTag("X_SIZE", DLongGDL( XPageSize*scale*1000)); //29700/1000=29.7 cm -+ dStruct->InitTag("Y_SIZE", DLongGDL( YPageSize*scale*1000)); -+ dStruct->InitTag("X_VSIZE", DLongGDL( XPageSize*scale*1000)); -+ dStruct->InitTag("Y_VSIZE", DLongGDL( YPageSize*scale*1000)); -+ dStruct->InitTag("X_CH_SIZE", DLongGDL( 360)); -+ dStruct->InitTag("Y_CH_SIZE", DLongGDL( 360)); -+ dStruct->InitTag("X_PX_CM", DFloatGDL( 1000.0)); //1000 pix/cm - dStruct->InitTag("Y_PX_CM", DFloatGDL( 1000.0)); - dStruct->InitTag("N_COLORS", DLongGDL( 256)); - dStruct->InitTag("TABLE_SIZE", DLongGDL( 256)); -- dStruct->InitTag("FILL_DIST", DLongGDL( 0)); -+ dStruct->InitTag("FILL_DIST", DLongGDL( 1)); - dStruct->InitTag("WINDOW", DLongGDL( -1)); - dStruct->InitTag("UNIT", DLongGDL( 0)); - dStruct->InitTag("FLAGS", DLongGDL( 266807)); - dStruct->InitTag("ORIGIN", origin); -- dStruct->InitTag("ZOOM", zoom); -+ dStruct->InitTag("ZOOM", zoom); - - SetPortrait(); - -@@ -297,11 +512,18 @@ - - bool CloseFile() - { -+ // trying to solve bug report 3611898 -+ // this is needed to decrement Lun number ... -+ (*static_cast( dStruct->GetTag(dStruct->Desc()->TagIndex("UNIT"))))[0]=0; - if (actStream != NULL) - { -+ psUnit->Close(); -+ psUnit->Free(); -+ psUnit=NULL; -+ - delete actStream; - actStream = NULL; -- if (!encapsulated) pslibHacks(); // needs to be called after the plPlot-generated file is closed -+ if (!encapsulated) pslibHacks(); else epsHacks(); // needs to be called after the plPlot-generated file is closed - } - return true; - } -@@ -325,6 +547,10 @@ - = DLong(floor(0.5+ - xs * (*static_cast(dStruct->GetTag(dStruct->Desc()->TagIndex("X_PX_CM"))))[0] - )); -+ (*static_cast(dStruct->GetTag(dStruct->Desc()->TagIndex("X_VSIZE"))))[0] -+ = DLong(floor(0.5+ -+ xs * (*static_cast(dStruct->GetTag(dStruct->Desc()->TagIndex("X_PX_CM"))))[0] -+ )); - return true; - } - -@@ -335,32 +561,36 @@ - = DLong(floor(0.5+ - ys * (*static_cast(dStruct->GetTag(dStruct->Desc()->TagIndex("Y_PX_CM"))))[0] - )); -+ (*static_cast(dStruct->GetTag(dStruct->Desc()->TagIndex("Y_VSIZE"))))[0] -+ = DLong(floor(0.5+ -+ ys * (*static_cast(dStruct->GetTag(dStruct->Desc()->TagIndex("Y_PX_CM"))))[0] -+ )); - return true; - } - -- bool SetColor() -+ bool SetColor(const long hascolor) - { -- color=1; -+ if (hascolor==1) color=1; else color=0; - return true; - } - - bool SetPortrait() - { - orient_portrait = true; -- XPageSize = 7 * 100. * GSL_CONST_MKSA_INCH; -- YPageSize = 5 * 100. * GSL_CONST_MKSA_INCH; -- XOffset = .75 * 100. * GSL_CONST_MKSA_INCH; -- YOffset = 3 * 100. * GSL_CONST_MKSA_INCH; // TODO: this is different from IDL docs -+// XPageSize = 7 * 100. * GSL_CONST_MKSA_INCH; -+// YPageSize = 5 * 100. * GSL_CONST_MKSA_INCH; -+// XOffset = .75 * 100. * GSL_CONST_MKSA_INCH; -+// YOffset = 3 * 100. * GSL_CONST_MKSA_INCH; // TODO: this is different from IDL docs - return true; - } - - bool SetLandscape() - { - orient_portrait = false; -- XPageSize = 10 * 100. * GSL_CONST_MKSA_INCH; -- YPageSize = 7 * 100. * GSL_CONST_MKSA_INCH; -- XOffset = .5 * 100. * GSL_CONST_MKSA_INCH; -- YOffset = .75 * 100. * GSL_CONST_MKSA_INCH; -+// XPageSize = 10 * 100. * GSL_CONST_MKSA_INCH; -+// YPageSize = 7 * 100. * GSL_CONST_MKSA_INCH; -+// XOffset = .5 * 100. * GSL_CONST_MKSA_INCH; -+// YOffset = .75 * 100. * GSL_CONST_MKSA_INCH; - return true; - } - -@@ -372,7 +602,6 @@ - - bool SetEncapsulated(bool val) - { -- // TODO ?: change XPageSize, YPageSize, XOffset, YOffset - encapsulated = val; - return true; - } -@@ -404,8 +633,8 @@ - DDouble xmin, ymin; - { - DDouble null; -- lib::get_axis_crange("X", xmin, null); -- lib::get_axis_crange("Y", ymin, null); -+ lib::gdlGetCurrentAxisRange("X", xmin, null); -+ lib::gdlGetCurrentAxisRange("Y", ymin, null); - } - if (nParam == 2) { - e->AssureLongScalarPar( 1, pos); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/devicesvg.hpp gdl/src/devicesvg.hpp ---- gdl-0.9.3/src/devicesvg.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/devicesvg.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -55,22 +55,30 @@ - // we want color - actStream->scolor( 1); - -- // set color map -+ // avoid to set color map 0 -- makes plplot very slow (?) - PLINT r[ctSize], g[ctSize], b[ctSize]; - actCT.Get( r, g, b); -- // actStream->scmap0( r, g, b, ctSize); -- actStream->scmap1( r, g, b, ctSize); -+// actStream->scmap0( r, g, b, ctSize); -+ actStream->scmap1( r, g, b, ctSize); - - actStream->SETOPT( "drvopt","text_clipping=1"); // clear drvopt - - actStream->Init(); - -+ // need to be called initially. permit to fix things -+ actStream->ssub(1,1); -+ actStream->adv(0); - // load font - actStream->font( 1); -+ actStream->vpor(0,1,0,1); -+ actStream->wind(0,1,0,1); - actStream->DefaultCharSize(); -+ //in case these are not initalized, here is a good place to do it. -+ if (actStream->updatePageInfo()==true) -+ { -+ actStream->GetPlplotDefaultCharSize(); //initializes everything in fact.. - -- // (*pMulti)[ 0] = 0; -- actStream->adv(0); -+ } - } - - public: -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/devicewin.hpp gdl/src/devicewin.hpp ---- gdl-0.9.3/src/devicewin.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/devicewin.hpp 2013-02-25 17:04:24.000000000 -0700 -@@ -237,16 +237,20 @@ - winList[ wIx]->scmap1( r, g, b, ctSize); - - winList[ wIx]->Init(); -- -+ // need to be called initially. permit to fix things -+ winList[ wIx]->ssub(1,1); -+ winList[ wIx]->adv(0); - // load font - winList[ wIx]->font( 1); -- //actStream->DefaultCharSize(); -- -- // (*pMulti)[ 0] = nx*ny; -- -- // need to be called initially -- winList[ wIx]->adv(0); -+ winList[ wIx]->vpor(0,1,0,1); -+ winList[ wIx]->wind(0,1,0,1); -+// winList[ wIx]->DefaultCharSize(); -+ //in case these are not initalized, here is a good place to do it. -+ if (winList[ wIx]->updatePageInfo()==true) -+ { -+ winList[ wIx]->GetPlplotDefaultCharSize(); //initializes everything in fact.. - -+ } - // sets actWin and updates !D - SetActWin( wIx); - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/devicex.hpp gdl/src/devicex.hpp ---- gdl-0.9.3/src/devicex.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/devicex.hpp 2013-07-08 12:39:21.588396761 -0600 -@@ -25,8 +25,6 @@ - #include - #include - --//#include --#include - #include - - #include "gdlxstream.hpp" -@@ -55,12 +53,11 @@ - int decomposed; // false -> use color table - - -- void plimage_gdl(unsigned char *idata, PLINT nx, PLINT ny, -+ void plimage_gdl(PLStream* pls, unsigned char *idata, PLINT nx, PLINT ny, - DLong tru, DLong chan) - { -- PLINT ix, iy, xm, ym; -- -- XwDev *dev = (XwDev *) plsc->dev; -+ PLINT ix, iy; -+ XwDev *dev = (XwDev *) pls->dev; - XwDisplay *xwd = (XwDisplay *) dev->xwd; - XImage *ximg = NULL, *ximg_pixmap = NULL; - -@@ -68,13 +65,14 @@ - - int (*oldErrorHandler)(Display*, XErrorEvent*); - -- if (plsc->level < 3) { -- plabort("plimage: window must be set up first"); -+ //the following 2 tests cannot happen i think. I keep them for safety. -+ if (pls->level < 3) { -+ std::cerr<<"plimage: window must be set up first"<cmap1); -- xwd->cmap1 = (XColor *) calloc(ncolors, (size_t) sizeof(XColor)); --#endif -+//#if PL_RGB_COLOR == -1 //was (always?) set by plplotP.h which we do not use anymore. -+ if (xwd->ncol1 != ncolors) -+ { -+ free_mem(xwd->cmap1); -+ xwd->cmap1 = (XColor *) calloc(ncolors, (size_t) sizeof(XColor)); -+ } -+//#endif - - for( SizeT i = 0; i < ncolors; i++ ) { - -- xwd->cmap1[i].red = ToXColor(plsc->cmap1[i].r); -- xwd->cmap1[i].green = ToXColor(plsc->cmap1[i].g); -- xwd->cmap1[i].blue = ToXColor(plsc->cmap1[i].b); -+ xwd->cmap1[i].red = ToXColor(pls->cmap1[i].r); -+ xwd->cmap1[i].green = ToXColor(pls->cmap1[i].g); -+ xwd->cmap1[i].blue = ToXColor(pls->cmap1[i].b); - xwd->cmap1[i].flags = DoRed | DoGreen | DoBlue; - - if ( XAllocColor( xwd->display, xwd->map, &xwd->cmap1[i]) == 0) -@@ -132,8 +133,8 @@ - xwd->ncol1 = ncolors; - } - -- PLINT xoff = (PLINT) (plsc->wpxoff/32767 * dev->width + 1); -- PLINT yoff = (PLINT) (plsc->wpyoff/24575 * dev->height + 1); -+ PLINT xoff = (PLINT) (pls->wpxoff/32767 * dev->width + 1); -+ PLINT yoff = (PLINT) (pls->wpyoff/24575 * dev->height + 1); - PLINT kx, ky; - - XColor curcolor; -@@ -233,7 +234,8 @@ - { - long xsize,ysize,xoff,yoff; - winList[ wIx]->GetGeometry( xsize, ysize, xoff, yoff); -- -+ PLStream* pls; -+ plgpls( &pls); - // window size and pos - // PLFLT xp; PLFLT yp; - // PLINT xleng; PLINT yleng; -@@ -246,7 +248,7 @@ - - // number of colors (based on the color depth from PLPlot) - (*static_cast( dStruct->GetTag( n_colorsTag)))[0] = -- 1 << (((static_cast((static_cast(plsc->dev))->xwd))->depth)); -+ 1 << (((static_cast((static_cast(pls->dev))->xwd))->depth)); - } - - // window number -@@ -424,7 +426,7 @@ - PLFLT xp; PLFLT yp; - PLINT xleng; PLINT yleng; - PLINT xoff; PLINT yoff; -- winList[ wIx]->gpage( xp, yp, xleng, yleng, xoff, yoff); -+ winList[ wIx]->plstream::gpage( xp, yp, xleng, yleng, xoff, yoff); - - int debug=0; - if (debug) cout <spage( xp, yp, xleng, yleng, xoff, yoff); - - // no pause on win destruction -@@ -460,23 +475,30 @@ - // we use our own window handling - winList[ wIx]->SETOPT( "drvopt","usepth=0"); - -- // set color map -+ // avoid to set color map 0 -- makes plplot very slow (?) - PLINT r[ctSize], g[ctSize], b[ctSize]; - actCT.Get( r, g, b); -- // winList[ wIx]->scmap0( r, g, b, ctSize); -- winList[ wIx]->scmap1( r, g, b, ctSize); -+// winList[ wIx]->scmap0( r, g, b, ctSize); -+ winList[ wIx]->scmap1( r, g, b, ctSize); - - winList[ wIx]->Init(); -- -+// get actual size, and resize to it (overcomes some window managers problems, solves bug #535) -+ bool success = WSize( actWin ,&xleng, &yleng, &xoff, &yoff); -+ ResizeWin((UInt)xleng, (UInt) yleng); -+ // need to be called initially. permit to fix things -+ winList[ wIx]->ssub(1,1); -+ winList[ wIx]->adv(0); - // load font - winList[ wIx]->font( 1); -+ winList[ wIx]->vpor(0,1,0,1); -+ winList[ wIx]->wind(0,1,0,1); - winList[ wIx]->DefaultCharSize(); -+ //in case these are not initalized, here is a good place to do it. -+ if (winList[ wIx]->updatePageInfo()==true) -+ { -+ winList[ wIx]->GetPlplotDefaultCharSize(); //initializes everything in fact.. - -- // (*pMulti)[ 0] = nx*ny; -- -- // need to be called initially -- winList[ wIx]->adv(0); -- -+ } - // sets actWin and updates !D - SetActWin( wIx); - -@@ -561,7 +583,7 @@ - DString title = "GDL 0"; - DLong xSize, ySize; - DefaultXYSize(&xSize, &ySize); -- bool success = WOpen( 0, title, xSize, ySize, 0, 0); -+ bool success = WOpen( 0, title, xSize, ySize, -1, -1); - if( !success) - return NULL; - if( actWin == -1) -@@ -603,6 +625,118 @@ - if( decomposed) return 1; - return 0; - } -+ -+ int OperateCG(XGCValues *gcValues, unsigned long valuemask, bool write) -+ { -+ PLStream* pls; -+ plgpls( &pls); -+ XwDev *dev = (XwDev *) pls->dev; -+ if( dev == NULL || dev->xwd == NULL) -+ { -+ Graphics* actDevice = Graphics::GetDevice(); -+ GDLGStream* newStream = actDevice->GetStream(); -+ plgpls( &pls); -+ dev = (XwDev *) pls->dev; -+ if( dev == NULL) -+ { -+ std::cerr<<"Device not open."<xwd; -+ if (write) -+ { -+ XChangeGC(xwd->display, dev->gc, valuemask, gcValues); -+ } -+ else -+ { -+ XGetGCValues(xwd->display, dev->gc, valuemask, gcValues); -+ } -+ return 1; -+ } -+ bool SetGraphicsFunction( DLong value) -+ { -+ XGCValues gcValues; -+ gcValues.function = max(0,min(value,15)); -+ if (OperateCG(&gcValues, GCFunction, true)) return true; -+ else return false; -+ } -+ DLong GetGraphicsFunction() -+ { -+ XGCValues gcValues; -+ if (OperateCG(&gcValues, GCFunction, false)) return (DLong)gcValues.function; -+ else return -1; -+ } -+ bool CursorStandard(int cursorNumber) -+ { -+ PLStream* pls; -+ plgpls( &pls); -+ int num=max(0,min(XC_num_glyphs-1,cursorNumber)); -+ XwDev *dev = (XwDev *) pls->dev; -+ if( dev == NULL || dev->xwd == NULL) -+ { -+ Graphics* actDevice = Graphics::GetDevice(); -+ GDLGStream* newStream = actDevice->GetStream(); -+ plgpls( &pls); -+ dev = (XwDev *) pls->dev; -+ if( dev == NULL) -+ { -+ std::cerr<<"Device not open."<xwd; -+ XDefineCursor(xwd->display,dev->window,XCreateFontCursor(xwd->display,num)); -+ return true; -+ } -+ bool CursorCrosshair() -+ { -+ return CursorStandard(XC_crosshair); -+ } -+ -+ void ResizeWin(UInt width, UInt height) -+ { -+ PLStream* pls; -+ plgpls( &pls); -+ XwDev *dev = (XwDev *) pls->dev; -+ if( dev == NULL) return; -+ XwDisplay *xwd = (XwDisplay *) dev->xwd; -+ XResizeWindow(xwd->display, dev->window, width, height); -+ } -+ -+ bool UnsetFocus() -+ { -+ PLStream* pls; -+ plgpls( &pls); -+ XwDev *dev = (XwDev *) pls->dev; -+ if( dev == NULL) return false; -+ XwDisplay *xwd = (XwDisplay *) dev->xwd; -+ XWMHints gestw; -+ gestw.input = FALSE; -+ gestw.flags = InputHint; -+ XSetWMHints(xwd->display, dev->window, &gestw); -+ return true; -+ } -+ bool EnableBackingStore(bool enable) -+ { -+ PLStream* pls; -+ plgpls( &pls); -+ XwDev *dev = (XwDev *) pls->dev; -+ if( dev == NULL) return false; -+ XwDisplay *xwd = (XwDisplay *) dev->xwd; -+ XSetWindowAttributes attr; -+ if (enable) -+ { -+ attr.backing_store = Always; -+ } -+ else -+ { -+ attr.backing_store = NotUseful; -+ } -+ XChangeWindowAttributes(xwd->display, dev->window,CWBackingStore,&attr); -+ return true; -+ } -+ - - int MaxWin() { ProcessDeleted(); return winList.size();} - int ActWin() { ProcessDeleted(); return actWin;} -@@ -621,13 +755,15 @@ - //BadMatch error, and if you read the XGetImage doc you'll see that such errors are prone to happen - //as soon as part of the window is obscured. - int (*oldErrorHandler)(Display*, XErrorEvent*); -- -- XwDev *dev = (XwDev *) plsc->dev; -+ PLStream* pls; -+ plgpls( &pls); -+ XwDev *dev = (XwDev *) pls->dev; - if( dev == NULL || dev->xwd == NULL) - { - GDLGStream* newStream = actDevice->GetStream(); - //already done: newStream->Init(); -- dev = (XwDev *) plsc->dev; -+ plgpls( &pls); -+ dev = (XwDev *) pls->dev; - if( dev == NULL) e->Throw( "Device not open."); - } - -@@ -812,6 +948,7 @@ - // Graphics* actDevice = Graphics::GetDevice(); - - SizeT nParam=e->NParam( 1); -+ PLStream* pls; - - GDLGStream* actStream = GetStream(); - if( actStream == NULL) -@@ -822,8 +959,8 @@ - - // actStream->NextPlot( false); - actStream->NoSub(); -- -- XwDev *dev = (XwDev *) plsc->dev; -+ plgpls( &pls); -+ XwDev *dev = (XwDev *) pls->dev; - XwDisplay *xwd = (XwDisplay *) dev->xwd; - - int xSize, ySize, xPos, yPos; -@@ -843,7 +980,7 @@ - //DByteGDL* p0B = e->GetParAs( 0); - DByteGDL* p0B; - p0B =static_cast(p0->Convert2(GDL_BYTE,BaseGDL::COPY)); -- e->Guard( p0B); -+ e->DeleteAtExit( p0B); - - int width, height; - DLong tru=0; -@@ -943,9 +1080,9 @@ - if (channel < 0 || channel > 3) - e->Throw("Value of Channel is out of allowed range."); - -- std::auto_ptr chan_guard; -+ Guard chan_guard; - if (channel == 0) { -- plimage_gdl(&(*p0B)[0], width, height, tru, channel); -+ plimage_gdl(pls, &(*p0B)[0], width, height, tru, channel); - } else if (rank == 3) { - // Rank == 3 w/channel - SizeT dims[2]; -@@ -957,11 +1094,11 @@ - (*p0B_chan)[i/3] = (*p0B)[i]; - } - // Send just single channel -- plimage_gdl(&(*p0B_chan)[0], width, height, tru, channel); -- chan_guard.reset( p0B_chan); // delete upon exit -+ plimage_gdl(pls, &(*p0B_chan)[0], width, height, tru, channel); -+ chan_guard.Init( p0B_chan); // delete upon exit - } else if (rank == 2) { - // Rank = 2 w/channel -- plimage_gdl(&(*p0B)[0], width, height, tru, channel); -+ plimage_gdl(pls, &(*p0B)[0], width, height, tru, channel); - } - } - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/devicez.hpp gdl/src/devicez.hpp ---- gdl-0.9.3/src/devicez.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/devicez.hpp 2013-02-25 17:04:24.000000000 -0700 -@@ -27,20 +27,20 @@ - #define SETOPT setopt - #endif - --#ifdef _MSC_VER --/* replacement of Unix rint() for Windows */ --static int rint (double x) --{ --char *buf; --int i,dec,sig; -- --buf = _fcvt(x, 0, &dec, &sig); --i = atoi(buf); --if(sig == 1) { --i = i * -1; --} --return(i); --} -+#ifdef _MSC_VER -+/* replacement of Unix rint() for Windows */ -+static int rint (double x) -+{ -+char *buf; -+int i,dec,sig; -+ -+buf = _fcvt(x, 0, &dec, &sig); -+i = atoi(buf); -+if(sig == 1) { -+i = i * -1; -+} -+return(i); -+} - #endif - - class DeviceZ: public Graphics -@@ -154,13 +154,20 @@ - actStream->SETOPT( "drvopt","text=0"); // clear drvopt - - actStream->Init(); -- -+ // need to be called initially. permit to fix things -+ actStream->ssub(1,1); -+ actStream->adv(0); - // load font - actStream->font( 1); -+ actStream->vpor(0,1,0,1); -+ actStream->wind(0,1,0,1); - actStream->DefaultCharSize(); -+ //in case these are not initalized, here is a good place to do it. -+ if (actStream->updatePageInfo()==true) -+ { -+ actStream->GetPlplotDefaultCharSize(); //initializes everything in fact.. - -- // (*pMulti)[ 0] = 0; -- actStream->adv(0); -+ } - } - - public: -@@ -316,8 +323,8 @@ - } - } - -- // actStream->vpor( 0, 1.0, 0, 1.0); -- // actStream->wind( 1-xLL, xsize-xLL, 1-yLL, ysize-yLL); -+ actStream->vpor( 0, 1.0, 0, 1.0); -+ actStream->wind( 1-xLL, xsize-xLL, 1-yLL, ysize-yLL); - - DByteGDL* p0B = e->GetParAs( 0); - SizeT rank = p0B->Rank(); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dinterpreter.cpp gdl/src/dinterpreter.cpp ---- gdl-0.9.3/src/dinterpreter.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dinterpreter.cpp 2013-07-31 09:41:43.812246140 -0600 -@@ -68,6 +68,8 @@ - ProgNode GDLInterpreter::NULLProgNode; - ProgNodeP GDLInterpreter::NULLProgNodeP = &GDLInterpreter::NULLProgNode; - -+void LibInit(); // defined in libinit.cpp -+ - DInterpreter::DInterpreter(): GDLInterpreter() - { - // DataStackT::Init(); -@@ -113,14 +115,14 @@ - return static_cast( this)->InnerInterpreterLoop(lineOffset); - } - --DStructGDL* GDLInterpreter::ObjectStruct( BaseGDL* self, ProgNodeP mp) -+DStructGDL* GDLInterpreter::ObjectStruct( DObjGDL* self, ProgNodeP mp) - { -- DType selfType = self->Type(); -- if( selfType != GDL_OBJ) -- throw GDLException( mp, "Object reference type" -- " required in this context: "+Name(self)); -+// DType selfType = self->Type(); -+// if( selfType != GDL_OBJ) -+// throw GDLException( mp, "Object reference type" -+// " required in this context: "+Name(self)); - -- DObjGDL* obj=static_cast(self); -+ DObjGDL* obj=self;//static_cast(self); - - SizeT o; - if( !obj->Scalar( o)) -@@ -143,22 +145,200 @@ - return oStructGDL; - } - --DStructGDL* GDLInterpreter::ObjectStructCheckAccess( BaseGDL* self, ProgNodeP mp) --{ -- DStructGDL* oStruct = ObjectStruct( self, mp); -- -- // check accessibility -- DStructDesc* desc = oStruct->Desc(); -- if( !desc->IsParent( callStack.back()->GetPro()->Object())) -- { -- throw GDLException( mp, "Object of type "+desc->Name()+ -- " is not accessible within "+ -- callStack.back()->GetProName() + ": "+Name(self)); -- } -- -- return oStruct; -+void GDLInterpreter::SetRootL( ProgNodeP tt, DotAccessDescT* aD, BaseGDL* r, ArrayIndexListT* aL) -+{ -+ if( r->Type() == GDL_STRUCT) -+ { -+ if( r->IsAssoc()) -+ { -+ ArrayIndexListGuard guard( aL); -+ throw GDLException( tt, "File expression not allowed " -+ "in this context: "+Name(r),true,false); -+ } -+ DStructGDL* structR=static_cast(r); -+ aD->ADRoot(structR, aL); -+ } -+ else -+ { -+ if( r->Type() != GDL_OBJ) -+ { -+ throw GDLException( tt, "Expression must be a" -+ " STRUCT in this context: "+Name(r), -+ true,false); -+ } -+ -+ ArrayIndexListGuard guard( aL); -+ -+ DStructGDL* oStruct = ObjectStruct( static_cast(r), tt); -+ DStructDesc* desc = oStruct->Desc(); -+ -+ bool isObj = callStack.back()->IsObject(); // called from member subroutine? -+ -+ if( desc->IsParent( GDL_OBJECT_NAME)) -+ { -+ SizeT sss = 0; -+ SizeT ooo = 0; -+ if( isObj) -+ { -+ static_cast(r)->Scalar( ooo); // checked in ObjectStruct -+ -+ BaseGDL* self = callStack.back()->GetKW(callStack.back()->GetPro()->NKey()); // SELF -+ -+ assert( dynamic_cast(self) != NULL); -+ -+ if( !static_cast(self)->Scalar( sss)) -+ throw GDLException( tt, "Internal error: SELF Object reference" -+ " must be scalar in this context: "+Name(self)); -+ -+ assert( sss != 0); -+ } -+ -+ if( !isObj || (sss != ooo)) -+ { -+ // call SetProperty -+ throw GDLException( tt, "Calling SetProperty not yet implemented: "+Name(r)); -+ //return; -+ } -+ } -+ -+ if( isObj) // member access to object? -+ { -+ if( !desc->IsParent( callStack.back()->GetPro()->Object())) -+ { -+ throw GDLException( tt, "Object of type "+desc->Name()+ -+ " is not accessible within "+ -+ callStack.back()->GetProName() + -+ ": "+Name(r)); -+ } -+ // DStructGDL* oStruct = -+ // ObjectStructCheckAccess( static_cast(r), tt); -+ -+ // oStruct cannot be "Assoc_" -+ aD->ADRoot( oStruct, guard.release()); -+ } -+ else -+ { -+ throw GDLException( tt, "Expression must be a" -+ " STRUCT in this context: "+Name(r), -+ true,false); -+ } -+ } -+} -+ -+void GDLInterpreter::SetRootR( ProgNodeP tt, DotAccessDescT* aD, BaseGDL* r, ArrayIndexListT* aL) -+{ -+// check here for object and get struct -+if( r->Type() == GDL_STRUCT) -+ { -+ if( r->IsAssoc()) -+ { -+ ArrayIndexListGuard guard( aL); -+ throw GDLException( tt, "File expression not allowed " -+ "in this context: "+Name(r),true,false); -+ } -+ DStructGDL* structR=static_cast(r); -+ aD->ADRoot( structR, aL); -+ } -+else -+ { -+ ArrayIndexListGuard guard( aL); -+ -+ if( r->Type() != GDL_OBJ) -+ { -+ throw GDLException( tt, "Expression must be a" -+ " STRUCT in this context: "+Name(r), -+ true,false); -+ } -+ -+ DStructGDL* oStruct = ObjectStruct( static_cast(r), tt); -+ DStructDesc* desc = oStruct->Desc(); -+ -+ bool isObj = callStack.back()->IsObject(); -+ -+ if( desc->IsParent( GDL_OBJECT_NAME)) -+ { -+ SizeT sss = 0; -+ SizeT ooo = 0; -+ if( isObj) -+ { -+ static_cast(r)->Scalar( ooo); // checked in ObjectStruct -+ -+ BaseGDL* self = callStack.back()->GetKW(callStack.back()->GetPro()->NKey()); // SELF -+ -+ assert( dynamic_cast(self) != NULL); -+ -+ if( !static_cast(self)->Scalar( sss)) -+ throw GDLException( tt, "Internal error: SELF Object reference" -+ " must be scalar in this context: "+Name(self)); -+ -+ assert( sss != 0); -+ } -+ -+ if( !isObj || (sss != ooo)) -+ { -+ // call GetProperty -+ throw GDLException( tt, "Calling GetProperty not yet implemented: "+Name(r)); -+ -+ //aD->ADRootGetProperty( oStruct, guard.release()); -+ return; -+ } -+ } -+ -+ if( isObj) -+ { -+ if( !desc->IsParent( callStack.back()->GetPro()->Object())) -+ { -+ throw GDLException( tt, "Object of type "+desc->Name()+ -+ " is not accessible within "+ -+ callStack.back()->GetProName() + -+ ": "+Name(r)); -+ } -+ // DStructGDL* oStruct = -+ // ObjectStructCheckAccess( static_cast(r), tt); -+ -+ if( aD->IsOwner()) delete r; -+ aD->SetOwner( false); // object struct, not owned -+ -+ aD->ADRoot( oStruct, guard.release()); -+ } -+ else -+ { -+ throw GDLException( tt, "Expression must be a" -+ " STRUCT in this context: "+Name(r),true,false); -+ } -+ } - } - -+// DStructDesc* GDLInterpreter::GDLObjectDesc( DStructGDL* oStruct, ProgNodeP mp) -+// { -+// //DStructGDL* oStruct = ObjectStruct( self, mp); -+// -+// // check accessibility -+// DStructDesc* desc = oStruct->Desc(); -+// if( !desc->IsParent( GDL_OBJECT_NAME)) -+// { -+// return NULL; -+// } -+// -+// return desc; -+// } -+// -+// void GDLInterpreter::ObjectStructCheckAccess( DStructGDL* oStruct, ProgNodeP mp) -+// { -+// //DStructGDL* oStruct = ObjectStruct( self, mp); -+// -+// // check accessibility -+// DStructDesc* desc = oStruct->Desc(); -+// if( !desc->IsParent( callStack.back()->GetPro()->Object())) -+// { -+// throw GDLException( mp, "Object of type "+desc->Name()+ -+// " is not accessible within "+ -+// callStack.back()->GetProName() + ": "+Name(self)); -+// } -+// -+// //return oStruct; -+// } -+ - // searches and compiles procedure (searchForPro == true) or function (searchForPro == false) 'pro' - bool GDLInterpreter::SearchCompilePro(const string& pro, bool searchForPro) - { -@@ -467,6 +647,15 @@ - } - } - -+DInterpreter::CommandCode DInterpreter::CmdReset() -+{ -+ RetAll( RetAllException::RESET); -+} -+DInterpreter::CommandCode DInterpreter::CmdFullReset() -+{ -+ RetAll( RetAllException::FULL_RESET); -+} -+ - DInterpreter::CommandCode DInterpreter::CmdCompile( const string& command) - { - string cmdstr = command; -@@ -623,8 +812,7 @@ - } - if( cmd( "FULL_RESET_SESSION")) - { -- cout << "FULL_RESET_SESSION not implemented yet." << endl; -- return CC_OK; -+ return CmdFullReset(); - } - if( cmd( "GO")) - { -@@ -647,8 +835,7 @@ - } - if( cmd( "RESET_SESSION")) - { -- cout << "RESET_SESSION not implemented yet." << endl; -- return CC_OK; -+ return CmdReset(); - } - if( cmd( "RNEW")) - { -@@ -771,6 +958,20 @@ - return ExecuteCommand( line.substr(1)); - } - -+ // command -+ if( firstChar == "?") -+ { -+ // later, we will have to check whether we have X11/Display or not -+ // on some computing nodes on supercomputers, this is de-activated. -+ if (line.substr(1).length() > 0) { -+ line=line.substr(1); -+ StrTrim(line); -+ line="online_help, '"+line+"'"; //' -+ } else { -+ line="online_help"; -+ } -+ } -+ - // shell command - if( firstChar == "$") - { -@@ -805,7 +1006,7 @@ - - RefDNode theAST; - try { -- auto_ptr lexer; -+ Guard lexer; - - // LineContinuation LC - // conactenate the strings and insert \n -@@ -815,17 +1016,17 @@ - int lCNum = 0; - for(;;) - { -- lexer.reset( new GDLLexer(executeLine, "", callStack.back()->CompileOpt())); -+ lexer.Reset( new GDLLexer(executeLine, "", callStack.back()->CompileOpt())); - try { - // works, but ugly -> depends from parser detecting an error - // (which it always will due to missing END_U token in case of LC) - //lexer->Parser().SetCompileOpt(callStack.back()->CompileOpt()); -- lexer->Parser().interactive(); -+ lexer.Get()->Parser().interactive(); - break; // no error -> everything ok - } - catch( GDLException& e) - { -- int lCNew = lexer->LineContinuation(); -+ int lCNew = lexer.Get()->LineContinuation(); - if( lCNew == lCNum) - // throw; // no LC -> real error - { -@@ -868,7 +1069,7 @@ - } - - // lexer->Parser().interactive(); -- theAST = lexer->Parser().getAST(); -+ theAST = lexer.Get()->Parser().getAST(); - - } - catch( GDLException& e) -@@ -946,7 +1147,7 @@ - cerr << "Compiler exception: " << e.getMessage() << endl; - return CC_OK; - } -- auto_ptr< ProgNode> progAST_guard( progAST); -+ Guard< ProgNode> progAST_guard( progAST); - - try - { -@@ -1372,7 +1573,7 @@ - rl_event_hook = GDLEventHandler; - { - int edit_input = SysVar::Edit_Input(); -- stifle_history(edit_input == 1 || edit_input < 0 ? 20 : edit_input); -+ stifle_history(edit_input == 1 || edit_input < 0 ? 200 : edit_input); - } - - // Eventually read back the ".gdl" path in user $HOME -@@ -1454,6 +1655,36 @@ - catch( RetAllException& retAllEx) - { - runCmd = (retAllEx.Code() == RetAllException::RUN); -+ bool resetCmd = (retAllEx.Code() == RetAllException::RESET); -+ bool fullResetCmd = (retAllEx.Code() == RetAllException::FULL_RESET); -+ if( resetCmd || fullResetCmd) -+ { -+ // remove $MAIN$ -+ delete callStack.back(); -+ callStack.pop_back(); -+ assert( callStack.empty()); -+ -+ ResetObjects(); -+ ResetHeap(); -+ if( fullResetCmd) -+ { -+ PurgeContainer(libFunList); -+ PurgeContainer(libProList); -+ } -+ // initially done in InitGDL() -+ // initializations -+ InitObjects(); -+ // init library functions -+ if( fullResetCmd) -+ { -+ LibInit(); -+ } -+ -+ // initially done in constructor: setup main level environment -+ DPro* mainPro=new DPro(); // $MAIN$ NOT inserted into proList -+ EnvUDT* mainEnv=new EnvUDT(NULL, mainPro); -+ callStack.push_back(mainEnv); // push main environment (necessary) -+ } - } - catch( exception& e) - { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dinterpreter.hpp gdl/src/dinterpreter.hpp ---- gdl-0.9.3/src/dinterpreter.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dinterpreter.hpp 2013-07-08 12:39:21.590396737 -0600 -@@ -91,6 +91,8 @@ - CommandCode ExecuteCommand(const std::string& command); - CommandCode CmdCompile(const std::string& command); - CommandCode CmdRun(const std::string& command); -+ CommandCode CmdReset(); -+ CommandCode CmdFullReset(); - - // execute OS shell command (interactive shell if command == "") - static void ExecuteShellCommand(const std::string& command); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dpro.cpp gdl/src/dpro.cpp ---- gdl-0.9.3/src/dpro.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dpro.cpp 2013-07-31 09:41:43.821246109 -0600 -@@ -247,7 +247,7 @@ - return var.size()-1; - } - --void DSubUD::AddKey(const string& k, const string& v) -+DSubUD* DSubUD::AddKey(const string& k, const string& v) - { - if( k == "_REF_EXTRA") - { -@@ -269,8 +269,19 @@ - { - if(extraIx != -1) extraIx++; // update extra ix index - } -- key.push_front(k); -- var.push_front(v); -+ // as we only push_front during compilation, we better use a vector here -+// key.push_front(k); -+// var.push_back(v); -+ // we want push_front -+ key.resize( key.size() + 1); -+ for( int i= key.size()-1; i>0; --i) -+ key[ i] = key[ i-1]; -+ key[ 0] = k; -+ var.resize( var.size() + 1); -+ for( int i= var.size()-1; i>0; --i) -+ var[ i] = var[ i-1]; -+ var[ 0] = v; -+ return this; - } - - // must be done after the tree is converted -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dpro.hpp gdl/src/dpro.hpp ---- gdl-0.9.3/src/dpro.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dpro.hpp 2013-07-31 09:41:43.825246095 -0600 -@@ -18,7 +18,7 @@ - #ifndef DPRO_HPP_ - #define DPRO_HPP_ - --#include -+// #include - #include - #include - #include -@@ -114,15 +114,15 @@ - // par_1,..,par_nPar, var1,..,varK - // N=size(key) - // K=size(var)-nPar-N -- IDList key; // keyword names (IDList: typedefs.hpp) -- // (KEYWORD_NAME=keyword_value) -+ KeyVarListT key; // keyword names (IDList: typedefs.hpp) -+ // (KEYWORD_NAME=keyword_value) - int nPar; // number of parameters (-1 = infinite) - int nParMin; // minimum number of parameters (-1 = infinite) - - ExtraType extra; - int extraIx; // index of extra keyword - -- IDList warnKey; // keyword names to accept but warn -+ IDList warnKey; // keyword names to accept but warn - // (IDList: typedefs.hpp) - - public: -@@ -160,7 +160,7 @@ - { - String_abbref_eq searchKey(s); - int ix=0; -- for(IDList::iterator i=key.begin(); -+ for(KeyVarListT::iterator i=key.begin(); - i != key.end(); i++, ix++) if( searchKey(*i)) { - return ix; - } -@@ -180,11 +180,12 @@ - }; - - // Lib pro/fun ******************************************************** --class EnvT; -- --typedef void (*LibPro)(EnvT*); --typedef BaseGDL* (*LibFun)(EnvT*); --typedef BaseGDL* (*LibFunDirect)(BaseGDL* param,bool canGrab); -+// moved to prognode.hpp -+// class EnvT; -+// -+// typedef void (*LibPro)(EnvT*); -+// typedef BaseGDL* (*LibFun)(EnvT*); -+// typedef BaseGDL* (*LibFunDirect)(BaseGDL* param,bool canGrab); - - // library procedure/function (in cases both are handled the same way) - class DLib: public DSub -@@ -292,7 +293,7 @@ - { - std::string file; // filename were procedure is defined in - -- IDList var; // keyword values, parameters, local variables -+ KeyVarListT var; // keyword values, parameters, local variables - - CommonBaseListT common; // common blocks or references - ProgNodeP tree; // the 'code' -@@ -334,7 +335,7 @@ - // add variables - DSubUD* AddPar(const std::string&); // add paramter - unsigned AddVar(const std::string&); // add local variable -- void AddKey(const std::string&, const std::string&); // add keyword=value -+ DSubUD* AddKey(const std::string&, const std::string&); // add keyword=value - - void DelVar(const int ix) {var.erase(var.begin() + ix);} - -@@ -345,7 +346,7 @@ - // search for variable returns true if its found in var or common blocks - bool Find(const std::string& n) - { -- IDList::iterator f=std::find(var.begin(),var.end(),n); -+ KeyVarListT::iterator f=std::find(var.begin(),var.end(),n); - if( f != var.end()) return true; - - CommonBaseListT::iterator c= -@@ -415,7 +416,7 @@ - // returns the variable index (-1 if not found) - int FindVar(const std::string& s) - { -- return FindInIDList(var,s); -+ return FindInKeyVarListT(var,s); - } - - // returns ptr to common variable (NULL if not found) -@@ -479,10 +480,10 @@ - }; - - --typedef std::deque FunListT; --typedef std::deque ProListT; -+typedef std::vector FunListT; -+typedef std::vector ProListT; - --typedef std::deque LibFunListT; --typedef std::deque LibProListT; -+typedef std::vector LibFunListT; -+typedef std::vector LibProListT; - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dstructdesc.cpp gdl/src/dstructdesc.cpp ---- gdl-0.9.3/src/dstructdesc.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dstructdesc.cpp 2013-07-08 12:39:21.592396714 -0600 -@@ -159,9 +159,9 @@ - if( tags[i]->Type() == GDL_STRUCT) - { - SpDStruct* castLeft= -- dynamic_cast(tags[i]); -+ static_cast(tags[i]); - SpDStruct* castRight= -- dynamic_cast(d->tags[i]); -+ static_cast(d->tags[i]); - DStructDesc* leftD=castLeft->Desc(); - DStructDesc* rightD=castRight->Desc(); - -@@ -203,9 +203,9 @@ - if( left.tags[i]->Type() == GDL_STRUCT) - { - SpDStruct* castLeft= -- dynamic_cast(left.tags[i]); -+ static_cast(left.tags[i]); - SpDStruct* castRight= -- dynamic_cast(right.tags[i]); -+ static_cast(right.tags[i]); - DStructDesc* leftD=castLeft->Desc(); - DStructDesc* rightD=castRight->Desc(); - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dstructdesc.hpp gdl/src/dstructdesc.hpp ---- gdl-0.9.3/src/dstructdesc.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dstructdesc.hpp 2013-07-31 09:41:43.828246085 -0600 -@@ -18,6 +18,8 @@ - #ifndef DSTRUCTDESC_HPP_ - #define DSTRUCTDESC_HPP_ - -+#include "includefirst.hpp" // USE_EIGEN3 -+ - #include - #include - #include -@@ -31,10 +33,10 @@ - class DStructBase - { - private: -- std::deque tagOffset; // data offset of tags -+ std::vector tagOffset; // data offset of tags - - protected: -- std::deque tags; // Data_ for data, 'Sp' for structList elements -+ std::vector tags; // Data_ for data, 'Sp' for structList elements - void Add( BaseGDL* t) - { - tags.push_back(t); // grabs -@@ -43,11 +45,16 @@ - // and DStringGDL (considers actual string sizes) - SizeT nBytes = tags.back()->NBytes(); - -- // alignment -- const int sizeOfPtr = sizeof( char*); -- SizeT exceed = nBytes % sizeOfPtr; -+ // alignment -+#ifdef USE_EIGEN -+ assert( sizeof( char*) <= 16); -+ const int alignmentInBytes = 16; // set to multiple of 16 >= sizeof( char*) -+#else -+ const int alignmentInBytes = sizeof( char*); -+#endif -+ SizeT exceed = nBytes % alignmentInBytes; - if( exceed > 0) -- nBytes += sizeOfPtr - exceed; -+ nBytes += alignmentInBytes - exceed; - - // valid tagOffset (used by NBytes()) - tagOffset.push_back( tagOffset.back() + nBytes); -@@ -91,7 +98,7 @@ - - - class DStructDesc; --typedef std::deque StructListT; -+typedef std::vector StructListT; - - // descriptor of structs layout ************************************************ - // unnamed struct -@@ -99,7 +106,7 @@ - class DUStructDesc: public DStructBase - { - private: -- std::deque tNames; // tag names -+ std::vector tNames; // tag names - - public: - DUStructDesc(): DStructBase() -@@ -236,7 +243,7 @@ - - void AddParent( DStructDesc*); - -- void GetParentNames( std::deque< std::string>& pNames) const -+ void GetParentNames( std::vector< std::string>& pNames) const - { - SizeT nParents=parent.size(); - for( SizeT i=0; i DStructGDL::freeList; -+vector< void*> DStructGDL::freeList; - - void* DStructGDL::operator new( size_t bytes) - { -@@ -923,3 +923,523 @@ - return aD.ADResolve(); - } - -+// basic_op_add.cpp -+DStructGDL* DStructGDL::Add( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::AddInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::AddS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::AddInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+// basic_op_sub.cpp -+DStructGDL* DStructGDL::Sub( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::SubInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::SubS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::SubInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+// datatypes.cpp -+int DStructGDL::Scalar2Index( SizeT& st) const -+{ -+ throw GDLException("STRUCT expression not allowed in this context."); -+ return 0; // get rid of warning -+} -+int DStructGDL::Scalar2RangeT( RangeT& st) const -+{ -+ throw GDLException("STRUCT expression not allowed in this context."); -+ return 0; // get rid of warning -+} -+RangeT DStructGDL::LoopIndex() const -+{ -+ throw GDLException("STRUCT expression not allowed in this context."); -+ return 0; // get rid of warning -+} -+int DStructGDL::Sgn() // -1,0,1 -+{ -+ throw GDLException("Struct expression not allowed in this context."); -+ return 0; -+} -+ -+bool DStructGDL::EqualNoDelete( const BaseGDL* r) const -+{ -+ throw GDLException("Struct expression not allowed in this context."); -+ return false; -+} -+ -+void DStructGDL::MinMax( DLong* minE, DLong* maxE, -+ BaseGDL** minVal, BaseGDL** maxVal, bool omitNaN, -+ SizeT start, SizeT stop, SizeT step, DLong valIx) -+{ -+ throw GDLException("Struct expression not allowed in this context."); -+} -+ -+ -+// basic_op_mult.cpp -+DStructGDL* DStructGDL::Mult( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::MultS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+// basic_op_div.cpp -+DStructGDL* DStructGDL::Div( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::DivInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::DivS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::DivInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+// basic_op_new.cpp -+DStructGDL* DStructGDL::AndOpNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::AndOpInvNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::AndOpSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::AndOpInvSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::OrOpNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::OrOpInvNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+ -+DStructGDL* DStructGDL::OrOpSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::OrOpInvSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::XorOpNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::XorOpSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::AddNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::AddInvNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::AddSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::AddInvSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::SubNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::SubInvNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::SubSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::SubInvSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::LtMarkNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::LtMarkSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+ -+DStructGDL* DStructGDL::GtMarkNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::GtMarkSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+ -+DStructGDL* DStructGDL::MultNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+ -+DStructGDL* DStructGDL::MultSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::DivNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::DivInvNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::DivSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::DivInvSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::ModNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::ModInvNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::ModSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::ModInvSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::PowIntNew( BaseGDL* r) -+{ -+ assert( 0); -+ throw GDLException("Internal error: DStructGDL::PowIntNew called.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::PowNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::PowInvNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::PowSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+DStructGDL* DStructGDL::PowInvSNew( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+ -+// basic_op.cpp -+DStructGDL* DStructGDL::NotOp() -+{ -+ throw GDLException("Cannot apply operation to datatype "+str+".",true,false); -+ return this; -+} -+ -+BaseGDL* DStructGDL::UMinus() -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+BaseGDL* DStructGDL::EqOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+BaseGDL* DStructGDL::NeOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+BaseGDL* DStructGDL::LeOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+BaseGDL* DStructGDL::LtOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+BaseGDL* DStructGDL::GeOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+BaseGDL* DStructGDL::GtOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return NULL; -+} -+ -+DStructGDL* DStructGDL::AndOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::AndOpInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+DStructGDL* DStructGDL::AndOpS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::AndOpInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+DStructGDL* DStructGDL::OrOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::OrOpInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+DStructGDL* DStructGDL::OrOpS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::OrOpInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+ -+DStructGDL* DStructGDL::XorOp( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+ -+ -+DStructGDL* DStructGDL::XorOpS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+DStructGDL* DStructGDL::LtMark( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+DStructGDL* DStructGDL::LtMarkS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+DStructGDL* DStructGDL::GtMark( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+DStructGDL* DStructGDL::GtMarkS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+DStructGDL* DStructGDL::Mod( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::ModInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+DStructGDL* DStructGDL::ModS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::ModInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+DStructGDL* DStructGDL::PowInt( BaseGDL* r) -+{ -+ assert( 0); -+ return this; -+} -+ -+DStructGDL* DStructGDL::PowS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::PowInvS( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::Pow( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+DStructGDL* DStructGDL::PowInv( BaseGDL* r) -+{ -+ throw GDLException("Cannot apply operation to datatype STRUCT.",true,false); -+ return this; -+} -+ -+ -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dstructgdl.hpp gdl/src/dstructgdl.hpp ---- gdl-0.9.3/src/dstructgdl.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dstructgdl.hpp 2013-07-31 09:41:43.837246053 -0600 -@@ -19,7 +19,7 @@ - #define dstructgdl_hpp_ - - #include --#include -+// #include - - #include "typedefs.hpp" - #include "datatypes.hpp" // for friend declaration -@@ -42,8 +42,12 @@ - typedef SpDStruct::DataT DataT; - - //public: -- std::deque typeVar; // for accessing data -- DataT dd; // the data -+ std::vector typeVar; // for accessing data -+#ifdef USE_EIGEN -+ EIGEN_ALIGN16 DataT dd; // the data -+#else -+ DataT dd; // the data -+#endif - - void InitTypeVar( SizeT t) - { -@@ -57,7 +61,7 @@ - - public: - -- static std::deque< void*> freeList; -+ static std::vector< void*> freeList; - - // operator new and delete - static void* operator new( size_t bytes); -@@ -436,7 +440,7 @@ - // members - // used by the interpreter - // throws (datatypes.cpp) -- int Scalar2index( SizeT& st) const; -+ int Scalar2Index( SizeT& st) const; - int Scalar2RangeT( RangeT& st) const; - RangeT LoopIndex() const; - -@@ -565,7 +569,7 @@ - DStructGDL* Pow( BaseGDL* r); - DStructGDL* PowInv( BaseGDL* r); - DStructGDL* PowInt( BaseGDL* r); -- DStructGDL* MatrixOp( BaseGDL* r,bool,bool,bool); -+ DStructGDL* MatrixOp( BaseGDL* r, bool atranspose, bool btranspose); - - - DStructGDL* AndOpS( BaseGDL* r); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/dvar.hpp gdl/src/dvar.hpp ---- gdl-0.9.3/src/dvar.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/dvar.hpp 2013-07-31 09:41:43.840246043 -0600 -@@ -49,7 +49,7 @@ - } - }; - --typedef std::deque VarListT; -+typedef std::vector VarListT; - - class DVar_eq: public std::unary_function - { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/envt.cpp gdl/src/envt.cpp ---- gdl-0.9.3/src/envt.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/envt.cpp 2013-07-31 09:41:43.846246022 -0600 -@@ -19,12 +19,12 @@ - - #include - -+#include "envt.hpp" - #include "objects.hpp" - #include "dinterpreter.hpp" --#include "envt.hpp" - #include "basic_pro.hpp" - --#include // always as last -+#include // always as last - - using namespace std; - -@@ -34,7 +34,7 @@ - // EnvBaseT::ContainerT EnvBaseT::toDestroy; - - // EnvT::new & delete --deque< void*> EnvT::freeList; -+vector< void*> EnvT::freeList; - const int multiAllocEnvT = 4; - void* EnvT::operator new( size_t bytes) - { -@@ -63,32 +63,42 @@ - } - - // EnvUDT::new & delete --deque< void*> EnvUDT::freeList; -+// deque< void*> EnvUDT::freeList; -+FreeListT EnvUDT::freeList; - const int multiAllocEnvUDT = 16; - void* EnvUDT::operator new( size_t bytes) - { - assert( bytes == sizeof( EnvUDT)); - if( freeList.size() > 0) - { -- void* res = freeList.back(); -- freeList.pop_back(); -- return res; -+ return freeList.pop_back(); -+// void* res = freeList.back(); -+// freeList.pop_back(); -+// return res; - } - // cout << "*** Resize EnvUDT " << endl; - const size_t newSize = multiAllocEnvUDT - 1; -- freeList.resize( newSize); -- char* res = static_cast< char*>( malloc( sizeof( EnvUDT) * multiAllocEnvUDT)); // one more than newSize -- for( size_t i=0; i( malloc( sizeof( EnvUDT) * multiAllocEnvUDT)); // one more than newSize -+// for( size_t i=0; i( malloc( sizeOfType * multiAllocEnvUDT)); // one more than newSize -+ -+ res = freeList.Init( newSize, res, sizeOfType); -+ // the one more - return res; - } - void EnvUDT::operator delete( void *ptr) - { --freeList.push_back( ptr); -+ freeList.push_back( ptr); - } - - -@@ -166,8 +176,13 @@ - lastJump( -1) - { - obj = true; -+ -+ DType selfType = self->Type(); -+ if( selfType != GDL_OBJ) -+ throw GDLException( cN, "Object reference type" -+ " required in this context: "+interpreter->Name(self)); - -- DStructGDL* oStructGDL = interpreter->ObjectStruct( self, cN); -+ DStructGDL* oStructGDL = interpreter->ObjectStruct( static_cast(self), cN); - - const string& mp = cN->getText(); - -@@ -219,7 +234,12 @@ - { - obj = true; - -- DStructGDL* oStructGDL = interpreter->ObjectStruct( self, cN); -+ DType selfType = self->Type(); -+ if( selfType != GDL_OBJ) -+ throw GDLException( cN, "Object reference type" -+ " required in this context: "+interpreter->Name(self)); -+ -+ DStructGDL* oStructGDL = interpreter->ObjectStruct( static_cast(self), cN); - - const string& mp = cN->getText(); - -@@ -258,7 +278,7 @@ - - - // for obj_new, obj_destroy, call_procedure and call_function --EnvT::EnvT( EnvT* pEnv, DSub* newPro, BaseGDL** self): -+EnvT::EnvT( EnvT* pEnv, DSub* newPro, DObjGDL** self): - EnvBaseT( pEnv->callingNode, newPro) - { - obj = (self != NULL); -@@ -277,13 +297,13 @@ - // parIx=keySize; // set to first parameter - // pass by reference (self must not be deleted) - if( self != NULL) -- env.Set( parIx++, self); //static_cast(oStructGDL)); -+ env.Set( parIx++, (BaseGDL**)self); //static_cast(oStructGDL)); - } - - - - //EnvUDT::EnvUDT( EnvBaseT* pEnv, DSub* newPro, BaseGDL** self): --EnvUDT::EnvUDT( ProgNodeP callingNode_, DSub* newPro, BaseGDL** self): -+EnvUDT::EnvUDT( ProgNodeP callingNode_, DSubUD* newPro, DObjGDL** self): - // EnvBaseT( pEnv->CallingNode(), newPro), - EnvBaseT( callingNode_, newPro), - ioError(NULL), -@@ -296,7 +316,7 @@ - { - obj = (self != NULL); - -- DSubUD* proUD=static_cast(pro); -+ DSubUD* proUD= newPro; //static_cast(pro); - - forLoopInfo.InitSize( proUD->NForLoops()); - -@@ -308,7 +328,7 @@ - // parIx=keySize; // set to first parameter - // pass by reference (self must not be deleted) - if( self != NULL) -- env.Set( parIx++, self); //static_cast(oStructGDL)); -+ env.Set( parIx++, (BaseGDL**)self); //static_cast(oStructGDL)); - } - - -@@ -393,12 +413,15 @@ - void EnvBaseT::Add( DPtrListT& ptrAccessible, DPtrListT& objAccessible, - BaseGDL* p) - { -- DPtrGDL* ptr = dynamic_cast< DPtrGDL*>( p); -- AddPtr( ptrAccessible, objAccessible, ptr); -- DStructGDL* stru = dynamic_cast< DStructGDL*>( p); -- AddStruct( ptrAccessible, objAccessible, stru); -- DObjGDL* obj = dynamic_cast< DObjGDL*>( p); -- AddObj( ptrAccessible, objAccessible, obj); -+ if( p == NULL) -+ return; -+ DType pType = p->Type(); -+ if( pType == GDL_PTR) -+ AddPtr( ptrAccessible, objAccessible, static_cast< DPtrGDL*>( p)); -+ else if( pType == GDL_STRUCT) -+ AddStruct( ptrAccessible, objAccessible, static_cast< DStructGDL*>( p)); -+ else if( pType == GDL_OBJ) -+ AddObj( ptrAccessible, objAccessible, static_cast< DObjGDL*>( p)); - } - void EnvBaseT::AddEnv( DPtrListT& ptrAccessible, DPtrListT& objAccessible) - { -@@ -409,14 +432,13 @@ - } - void EnvBaseT::AddToDestroy( DPtrListT& ptrAccessible, DPtrListT& objAccessible) - { --// if( toDestroy == NULL) --// return; -- for( SizeT i=0; i VectorDObj; - void EnvT::HeapGC( bool doPtr, bool doObj, bool verbose) - { - // within CLEANUP method HEAP_GC could be called again -@@ -463,9 +485,10 @@ - } - - EnvStackT& cS=interpreter->CallStack(); -- for( EnvStackT::reverse_iterator r = cS.rbegin(); r != cS.rend(); ++r) -+// for( EnvStackT::reverse_iterator r = cS.rbegin(); r != cS.rend(); ++r) -+ for( long ix = cS.size()-1; ix >= 0; --ix) - { -- (*r)->AddEnv( ptrAccessible, objAccessible); -+ cS[ix]->AddEnv( ptrAccessible, objAccessible); - } - - AddToDestroy( ptrAccessible, objAccessible); -@@ -474,8 +497,8 @@ - if( doObj) - { - std::vector* heap = interpreter->GetAllObjHeapSTL(); -- auto_ptr< std::vector > heap_guard( heap); -- SizeT nH = heap->size();//N_Elements(); -+ Guard< std::vector > heap_guard( heap); -+ SizeT nH = heap->size();//N_Elements(); - if( nH > 0 && (*heap)[0] != 0) - { - for( SizeT h=0; h* heap = interpreter->GetAllHeapSTL(); -- auto_ptr< std::vector > heap_guard( heap); -+ Guard< std::vector > heap_guard( heap); - SizeT nH = heap->size(); - if( nH > 0 && (*heap)[0] != 0) - { -@@ -546,59 +569,75 @@ - - set< DObj> EnvBaseT::inProgress; - -+class InProgressGuard -+{ -+private: -+ DObj actID; -+public: -+ InProgressGuard( DObj id): actID( id) -+ { -+ EnvBaseT::inProgress.insert( actID); -+ } -+ ~InProgressGuard() -+ { -+ EnvBaseT::inProgress.erase( actID); -+ } -+}; -+ - // for CLEANUP calls due to reference counting - // note: refcount is already zero for actID - void EnvBaseT::ObjCleanup( DObj actID) - { -- if( actID != 0 && (inProgress.find( actID) == inProgress.end())) -- { -- DStructGDL* actObj; -- try{ -- actObj=GetObjHeap( actID); --// GDLInterpreter::ObjHeapT::iterator it; --// actObj=GDLInterpreter::GetObjHeap( actID, it); -- } -- catch( GDLInterpreter::HeapException){ -- actObj=NULL; -- } -- -- if( actObj != NULL) -- { -- try{ -- // call CLEANUP function -- DPro* objCLEANUP= actObj->Desc()->GetPro( "CLEANUP"); -- -- if( objCLEANUP != NULL) -- { -- BaseGDL* actObjGDL = new DObjGDL( actID); -- auto_ptr actObjGDL_guard( actObjGDL); -- GDLInterpreter::IncRefObj( actID); // set refcount to 1 -- -- PushNewEmptyEnvUD( objCLEANUP, &actObjGDL); -- -- inProgress.insert( actID); -- -- interpreter->call_pro( objCLEANUP->GetTree()); -- -- inProgress.erase( actID); -+ if( actID == 0 || (inProgress.find( actID) != inProgress.end())) -+ return; - -- EnvBaseT* callStackBack = interpreter->CallStack().back(); -- interpreter->CallStack().pop_back(); -- delete callStackBack; -- -- FreeObjHeap( actID); // make sure actObj is freed -- // actObjGDL goes out of scope -> refcount is (would be) decreased -- } -- } -- catch( ...) -- { -- FreeObjHeap( actID); // make sure actObj is freed -- throw; // rethrow -- } -- } -- else -- FreeObjHeap( actID); // the actual freeing -+ DStructGDL* actObj; -+ try{ -+ actObj=GetObjHeap( actID); -+ } -+ catch( GDLInterpreter::HeapException&){ -+ // not found -+ return; -+ } -+ -+ // found actID -+ if( actObj != NULL) -+ { -+ InProgressGuard inProgressGuard( actID); // exception save -+ -+ Guard actObjGDL_guard; -+ try{ -+ // call CLEANUP function -+ DPro* objCLEANUP= actObj->Desc()->GetPro( "CLEANUP"); -+ -+ if( objCLEANUP != NULL) -+ { -+ BaseGDL* actObjGDL = new DObjGDL( actID); -+ actObjGDL_guard.Init( actObjGDL); -+ GDLInterpreter::IncRefObj( actID); // set refcount to 1 -+ -+ PushNewEmptyEnvUD( objCLEANUP, &actObjGDL); -+ -+ interpreter->call_pro( objCLEANUP->GetTree()); -+ -+ EnvBaseT* callStackBack = interpreter->CallStack().back(); -+ interpreter->CallStack().pop_back(); -+ delete callStackBack; -+ } - } -+ catch( ...) -+ { -+ FreeObjHeap( actID); // make sure actObj is freed -+ throw; // rethrow -+ } -+ // actObjGDL_guard goes out of scope -> refcount is (would be) decreased -+ FreeObjHeap( actID); -+ } -+ else // actObj == NULL -+ { -+ Warning("Cleaning up invalid (NULL) OBJECT ID <"+i2s(actID)+">."); -+ FreeObjHeap( actID); // make sure actObj is freed -+ } - } - - -@@ -624,8 +663,8 @@ - - if( objCLEANUP != NULL) - { -- BaseGDL* actObjGDL = new DObjGDL( actID); -- auto_ptr actObjGDL_guard( actObjGDL); -+ DObjGDL* actObjGDL = new DObjGDL( actID); -+ Guard actObjGDL_guard( actObjGDL); - GDLInterpreter::IncRefObj( actID); - - PushNewEnvUD( objCLEANUP, 1, &actObjGDL); -@@ -852,6 +891,19 @@ - // return string(""); - // } - -+ -+void EnvT::Help(const std::string s_help[], int size_of_s) -+{ -+ if (size_of_s == 0) -+ throw GDLException( CallingNode(), pro->ObjectName()+": no inline doc ready"); -+ else { -+ int i; -+ for (i = 0; i < size_of_s; i++) -+ Message(pro->ObjectName()+": "+s_help[i]); -+ throw GDLException( CallingNode(), pro->ObjectName()+": call to inline help"); -+ } -+} -+ - void EnvBaseT::SetKeyword( const string& k, BaseGDL* const val) // value - { - int varIx=GetKeywordIx( k); -@@ -929,7 +981,13 @@ - - //if( callStack.size() <= 1) return NULL; - // library environments are no longer on the call stack -- assert( callStack.back() != this); -+ // but since we have WRAPPED_FUNNode it is convenient -+// assert( callStack.back() != this); -+ if( callStack.back() == this) -+ { -+ assert( callStack.size() >= 2); -+ return callStack[ callStack.size() - 2]; -+ } - - return callStack.back(); - -@@ -966,7 +1024,7 @@ - // and obj_destroy (basic_pro.cpp) - // and call_function (basic_fun.cpp) - // and call_procedure (basic_pro.cpp) --void EnvT::PushNewEnvUD( DSub* newPro, SizeT skipP, BaseGDL** newObj) -+void EnvT::PushNewEnvUD( DSubUD* newPro, SizeT skipP, DObjGDL** newObj) - { - EnvUDT* newEnv= new EnvUDT( this->CallingNode(), newPro, newObj); - -@@ -990,7 +1048,7 @@ - // and obj_destroy (basic_pro.cpp) - // and call_function (basic_fun.cpp) - // and call_procedure (basic_pro.cpp) --EnvT* EnvT::NewEnv( DSub* newPro, SizeT skipP, BaseGDL** newObj) -+EnvT* EnvT::NewEnv( DSub* newPro, SizeT skipP, DObjGDL** newObj) - { - EnvT* newEnv= new EnvT( this, newPro, newObj); - -@@ -1030,8 +1088,7 @@ - { - BaseGDL* p1= GetParDefined( pIx); - -- DObjGDL* oRef = dynamic_cast(p1); -- if( oRef == NULL) -+ if( p1->Type() != GDL_OBJ) - { - Throw( "Parameter must be an object reference" - " in this context: "+ -@@ -1039,6 +1096,7 @@ - } - else - { -+ DObjGDL* oRef = static_cast(p1); - DObj objIx; - if( !oRef->Scalar( objIx)) - Throw( "Parameter must be a scalar in this context: "+ -@@ -1103,6 +1161,12 @@ - return pro->FindKey( k); - } - -+bool EnvT::KeywordPresent( const std::string& kw) -+{ -+ int ix = KeywordIx( kw); -+ return (env[ix] != NULL); -+} -+ - const string EnvBaseT::GetString( SizeT ix) - { - const string unnamed(""); -@@ -1289,7 +1353,7 @@ - } - - // search keyword -- IDList::iterator f=std::find_if(pro->key.begin(), -+ KeyVarListT::iterator f=std::find_if(pro->key.begin(), - pro->key.end(), - strAbbrefEq_k); - if( f == pro->key.end()) -@@ -1321,7 +1385,7 @@ - return -1; - } - // continue search (for ambiguity) -- IDList::iterator ff=std::find_if(f+1, -+ KeyVarListT::iterator ff=std::find_if(f+1, - pro->key.end(), - strAbbrefEq_k); - if( ff != pro->key.end()) -@@ -1356,6 +1420,10 @@ - - bool EnvT::KeywordSet( SizeT ix) - { -+ return EnvBaseT::KeywordSet( ix); -+} -+bool EnvBaseT::KeywordSet( SizeT ix) -+{ - BaseGDL* keyword=env[ix]; - if( keyword == NULL) return false; - if( !keyword->Scalar()) return true; -@@ -1386,7 +1454,7 @@ - { - BaseGDL* p = GetParDefined( pIx); - DLong64GDL* lp = static_cast(p->Convert2( GDL_LONG64, BaseGDL::COPY)); -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - if( !lp->Scalar( scalar)) - Throw("Parameter must be a scalar in this context: "+ - GetParString(pIx)); -@@ -1395,7 +1463,7 @@ - { - BaseGDL* p = GetParDefined( pIx); - DLongGDL* lp = static_cast(p->Convert2( GDL_LONG, BaseGDL::COPY)); -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - if( !lp->Scalar( scalar)) - Throw("Parameter must be a scalar in this context: "+ - GetParString(pIx)); -@@ -1436,7 +1504,7 @@ - - DLongGDL* lp= static_cast(p->Convert2( GDL_LONG, BaseGDL::COPY)); - -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - - if( !lp->Scalar( scalar)) - Throw("Expression must be a scalar in this context: "+ -@@ -1447,7 +1515,7 @@ - { - BaseGDL* p = GetParDefined( pIx); - DDoubleGDL* lp = static_cast(p->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - if( !lp->Scalar( scalar)) - Throw("Parameter must be a scalar in this context: "+ - GetParString(pIx)); -@@ -1478,7 +1546,7 @@ - - DDoubleGDL* lp= static_cast(p->Convert2( GDL_DOUBLE, BaseGDL::COPY)); - -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - - if( !lp->Scalar( scalar)) - Throw("Expression must be a scalar in this context: "+ -@@ -1490,7 +1558,7 @@ - { - BaseGDL* p = GetParDefined( pIx); - DFloatGDL* lp = static_cast(p->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - if( !lp->Scalar( scalar)) - Throw("Parameter must be a scalar in this context: "+ - GetParString(pIx)); -@@ -1521,7 +1589,7 @@ - - DFloatGDL* lp= static_cast(p->Convert2( GDL_FLOAT, BaseGDL::COPY)); - -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - - if( !lp->Scalar( scalar)) - Throw("Expression must be a scalar in this context: "+ -@@ -1533,7 +1601,7 @@ - { - BaseGDL* p = GetParDefined( pIx); - DStringGDL* lp = static_cast(p->Convert2( GDL_STRING, BaseGDL::COPY)); -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - if( !lp->Scalar( scalar)) - Throw("Parameter must be a scalar in this context: "+ - GetParString(pIx)); -@@ -1562,7 +1630,7 @@ - Throw("Expression undefined: "+GetString(eIx)); - - DStringGDL* lp= static_cast(p->Convert2( GDL_STRING, BaseGDL::COPY)); -- auto_ptr guard_lp( lp); -+ Guard guard_lp( lp); - - if( !lp->Scalar( scalar)) - Throw("Expression must be a scalar in this context: "+ -@@ -1572,7 +1640,7 @@ - void EnvT::SetKW( SizeT ix, BaseGDL* newVal) - { - // can't use Guard here as data has to be released -- auto_ptr guard( newVal); -+ Guard guard( newVal); - AssureGlobalKW( ix); - GDLDelete(GetKW( ix)); - GetKW( ix) = guard.release(); -@@ -1580,7 +1648,7 @@ - void EnvT::SetPar( SizeT ix, BaseGDL* newVal) - { - // can't use Guard here as data has to be released -- auto_ptr guard( newVal); -+ Guard guard( newVal); - AssureGlobalPar( ix); - GDLDelete(GetPar( ix)); - GetPar( ix) = guard.release(); -@@ -1589,7 +1657,9 @@ - bool EnvBaseT::Contains( BaseGDL* p) const - { - if( env.Contains( p)) return true; -- return (static_cast(pro)->GetCommonVarPtr( p) != NULL); -+ if (static_cast(pro)->GetCommonVarPtr( p) != NULL) return true; -+ // horrible slow... but correct -+ return Interpreter()->GetPtrToHeap( p) != NULL; - } - - BaseGDL** EnvBaseT::GetPtrTo( BaseGDL* p) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/envt.hpp gdl/src/envt.hpp ---- gdl-0.9.3/src/envt.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/envt.hpp 2013-07-31 09:41:43.850246008 -0600 -@@ -62,12 +62,12 @@ - // upon library routines exit (normal or on error) - // elimates the need of auto_ptr and in some places later destruction is needed - -- void Guard( BaseGDL* toGuard) -+ void DeleteAtExit( BaseGDL* toGuard) - { --// if( toDestroy == NULL) --// toDestroy = new ContainerT(); -- toDestroy.push_back( toGuard); -- } -+// if( toDestroy == NULL) -+// toDestroy = new ContainerT(); -+ toDestroy.push_back( toGuard); -+ } - - protected: - // for obj cleanup -@@ -85,10 +85,38 @@ - EnvBaseT* newEnv; - - // finds the local variable pp points to -- int FindLocalKW( BaseGDL** pp) { return env.FindLocal( pp);} -+// int FindLocalKW( BaseGDL** pp) { return env.FindLocal( pp);} -+public: - // used by the interperter returns the keyword index, used for UD functions -+ // and used by WRAPPED subroutines - int GetKeywordIx( const std::string& k); - -+ -+ bool StealLocalKW( SizeT ix) -+ { -+ if( LocalKW( ix)) -+ { -+ env.Clear( ix); -+ return true; -+ } -+ return false; -+ } -+ -+ bool LocalKW( SizeT ix) const -+ { -+ if( ix >= env.size()) return false; -+ return ( env.Loc( ix) != NULL); -+ } -+ -+ bool GlobalKW( SizeT ix) const -+ { -+ if( ix >= env.size()) return false; -+ return ( env.Env( ix) != NULL); -+ } -+ -+ bool KeywordSet( SizeT ix); -+ -+protected: - // for HEAP_GC - static void AddStruct( DPtrListT& ptrAccessible, DPtrListT& objAccessible, - DStructGDL* stru); -@@ -266,14 +294,10 @@ - BaseGDL*& GetParDefined(SizeT i); //, const std::string& subName = ""); - bool KeywordPresent( SizeT ix) - { return (env.Loc(ix)!=NULL)||(env.Env(ix)!=NULL);} -- bool GlobalKW( SizeT ix) -- { -- if( ix >= env.size()) return false; -- return ( env.Env( ix) != NULL); -- } -- void SetNextParUnckeckedVarNum(BaseGDL** arg1); -+ void SetNextParUnckeckedVarNum(BaseGDL** arg1); - - friend class DInterpreter; // gcc 4.4 compatibility -+ friend class InProgressGuard; - }; - - -@@ -343,7 +367,7 @@ - return; - } - // this should never happen (or only in extreme rarely cases) -- // hence the performance will go down -+ // the performance will go down - // s > defaultLength - T* newArr = new T[ s]; // ctor called - if( eArr != reinterpret_cast(buf)) -@@ -368,8 +392,8 @@ - // T operator[]( SizeT i) const { assert( i freeList; -+// static std::deque< void*> freeList; -+static FreeListT freeList; - - public: - static void* operator new( size_t bytes); -@@ -419,10 +444,13 @@ - - // for obj_new and obj_destroy - //EnvUDT( EnvBaseT* pEnv, DSub* newPro, BaseGDL** self); -- EnvUDT( ProgNodeP callindNode_, DSub* newPro, BaseGDL** self); -+ EnvUDT( ProgNodeP callindNode_, DSubUD* newPro, DObjGDL** self); - - DLong GetOnError() const { return onError;} - -+ ProgNodeP GetCatchNode() const { return catchNode;} -+ BaseGDL** GetCatchVar() const { return catchVar;} -+ - SizeT NJump() const { return nJump;} - int LastJump() const { return lastJump;} - ProgNodeP GotoTarget( int ix) -@@ -431,7 +459,7 @@ - ++nJump; - return static_cast( pro)->GotoTarget( ix); - } -- bool LFun() const { return lFun;} // left-function -+ bool IsLFun() const { return lFun;} // left-function - - void SetIOError( int targetIx) - { // this isn't a jump -@@ -461,7 +489,7 @@ - // this contains the library function API *********************** - class EnvT: public EnvBaseT - { --static std::deque< void*> freeList; -+static std::vector< void*> freeList; - - public: - static void* operator new( size_t bytes); -@@ -478,14 +506,14 @@ - EnvT( ProgNodeP cN, DSub* pro_); - - // for obj_new and obj_destroy -- EnvT( EnvT* pEnv, DSub* newPro, BaseGDL** self); -+ EnvT( EnvT* pEnv, DSub* newPro, DObjGDL** self); - - void HeapGC( bool doPtr, bool doObj, bool verbose); - void ObjCleanup( DObj actID); - - // used by obj_new (basic_fun.cpp) -- EnvT* NewEnv( DSub* newPro, SizeT skipP, BaseGDL** newObj=NULL); -- void PushNewEnvUD( DSub* newPro, SizeT skipP, BaseGDL** newObj=NULL); -+ EnvT* NewEnv( DSub* newPro, SizeT skipP, DObjGDL** newObj=NULL); -+ void PushNewEnvUD( DSubUD* newPro, SizeT skipP, DObjGDL** newObj=NULL); - // for exclusive use by lib::on_error - void OnError(); - // for exclusive use by lib::catch_pro -@@ -510,27 +538,15 @@ - - // will print the message (can be multiline) and exit - // first usage in "math_fun_ac.cpp" -- void Help(const std::string s_help[], int size_of_s) -- { -- if (size_of_s == 0) -- throw GDLException( CallingNode(), pro->ObjectName()+ \ -- ": no inline doc ready"); -- else { -- int i; -- for (i = 0; i < size_of_s-1; i++) -- Message(pro->ObjectName()+": "+s_help[i]); -- throw GDLException( CallingNode(), pro->ObjectName()+": "+s_help[i]); -- } -- } -- -- -+ void Help(const std::string s_help[], int size_of_s); -+ - // returns environment data, by value (but that by C++ reference) - // in EnvBaseT --// BaseGDL*& GetKW(SizeT ix) { return env[ix];} -+ // BaseGDL*& GetKW(SizeT ix) { return env[ix];} - - // it is now possible to define a niminum number of parameters for library subroutines - // if this is done the next function can be used --// BaseGDL*& GetParUnchecked(SizeT i); -+ // BaseGDL*& GetParUnchecked(SizeT i); - - // returns the ix'th parameter (NULL if not defined) - BaseGDL*& GetPar( SizeT i); -@@ -588,7 +604,7 @@ - // T* res = dynamic_cast( p); - // if( res != NULL) return res; - T* res = static_cast( p->Convert2( T::t, BaseGDL::COPY)); -- Guard( res); -+ this->DeleteAtExit( res); - return res; - } - // same as before for keywords -@@ -603,7 +619,7 @@ - // T* res = dynamic_cast( p); - // if( res != NULL) return res; - T* res = static_cast( p->Convert2( T::t, BaseGDL::COPY)); -- Guard( res); -+ this->DeleteAtExit( res); - return res; - } - -@@ -618,7 +634,7 @@ - // T* res = dynamic_cast( p); - // if( res != NULL) return res; - T* res = static_cast( p->Convert2( T::t, BaseGDL::COPY)); -- Guard( res); -+ this->DeleteAtExit( res); - return res; - } - // same as before for keywords -@@ -632,7 +648,7 @@ - // T* res = dynamic_cast( p); - // if( res != NULL) return res; - T* res = static_cast( p->Convert2( T::t, BaseGDL::COPY)); -- Guard( res); -+ this->DeleteAtExit( res); - return res; - } - -@@ -661,17 +677,19 @@ - // this one together with a static int holding the index is faster - // (after the first call) - bool KeywordSet( SizeT ix); -- -+ // GD added -- possibly very wrong? -+ bool KeywordPresent( const std::string& kw); - bool KeywordPresent( SizeT ix) - { return EnvBaseT::KeywordPresent( ix);} - - // local/global keyword/paramter -- bool LocalKW( SizeT ix) -+ bool LocalKW( SizeT ix) const - { -- if( ix >= env.size()) return false; -- return ( env.Loc( ix) != NULL); -+ return EnvBaseT::LocalKW( ix); -+// if( ix >= env.size()) return false; -+// return ( env.Loc( ix) != NULL); - } -- bool GlobalKW( SizeT ix) -+ bool GlobalKW( SizeT ix) const - { - return EnvBaseT::GlobalKW( ix); - } -@@ -724,10 +742,10 @@ - void AssureScalarPar( SizeT pIx, typename T::Ty& scalar) - { - BaseGDL* p = GetParDefined( pIx); -- T* tp= dynamic_cast(p); -- if( tp == NULL) -+ if( p->Type() != T::t) - Throw( "Variable must be a "+T::str+" in this context: "+ - GetParString(pIx)); -+ T* tp= static_cast(p); - if( !tp->Scalar( scalar)) - Throw("Variable must be a scalar in this context: "+ - GetParString(pIx)); -@@ -739,10 +757,10 @@ - BaseGDL* p = GetKW( ix); - if( p == NULL) - Throw("Keyword undefined: "+GetString(ix)); -- T* tp= dynamic_cast(p); -- if( tp == NULL) -+ if( p->Type() != T::t) - Throw("Keyword must be a "+T::str+" in this context: "+ - GetString(ix)); -+ T* tp= static_cast(p); - if( !tp->Scalar( scalar)) - Throw("Keyword must be a scalar in this context: "+ - GetString(ix)); -@@ -789,9 +807,59 @@ - void ShiftParNumbering(int n); - }; - -+const int defaultStackDepth = 64; -+class EnvStackT -+{ -+ EnvUDT** envStackFrame; -+ EnvUDT** envStack; -+ -+ SizeT top; -+ SizeT sz; -+ -+public: -+ typedef SizeT size_type; -+ typedef EnvUDT* pointer_type; -+ -+ EnvStackT(): sz(defaultStackDepth), top(0) -+ { -+ envStackFrame = new EnvUDT* [ sz+1]; -+ envStack = envStackFrame + 1; -+ } -+ ~EnvStackT() { delete[] envStackFrame;} -+ -+ bool empty() const { return top == 0;} -+ -+ void push_back( EnvUDT* b) -+ { -+ if( top >= sz) -+ { -+ if( sz >= 32768) -+ throw GDLException("Recursion limit reached ("+i2s(sz)+")."); -+ -+ EnvUDT** newEnvStackFrame = new EnvUDT* [ sz + sz + 1]; -+ EnvUDT** newEnvStack = newEnvStackFrame + 1; -+ -+ for( SizeT i=0; i0); --top;} -+ EnvUDT* back() const { assert(top>0); return envStackFrame[ top];} -+ SizeT size() const { return top;} -+ EnvUDT* operator[]( SizeT ix) const { return envStack[ ix];} -+ EnvUDT*& operator[]( SizeT ix) { return envStack[ ix];} -+// EnvUDT** begin() const { return &envStack[0];} -+// EnvUDT** end() const { return &envStack[sz];} -+}; - - // typedef std::deque EnvStackT; --typedef std::deque EnvStackT; -+// typedef std::deque EnvStackT; - - #endif - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/extrat.cpp gdl/src/extrat.cpp ---- gdl-0.9.3/src/extrat.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/extrat.cpp 2013-07-31 09:41:43.854245994 -0600 -@@ -40,9 +40,11 @@ - // EnvBaseT* callerDebug=thisEnv->Caller(); - // DSub::ExtraType extraTypeDebug= callerDebug->pro->Extra(); - -- DStructGDL* extraStruct= dynamic_cast(extraVal); -- if( extraStruct != NULL) // _EXTRA -+ if( extraVal != NULL) -+ { -+ if( extraVal->Type() == GDL_STRUCT) // _EXTRA - { -+ DStructGDL* extraStruct= static_cast(extraVal); - DStructDesc* desc=extraStruct->Desc(); - - SizeT nTag=desc->NTags(); -@@ -51,7 +53,7 @@ - const string& tName=desc->TagName( t); - - // search keyword -- IDList::iterator f=find_if(pro->key.begin(), -+ KeyVarListT::iterator f=find_if(pro->key.begin(), - pro->key.end(), - String_abbref_eq( tName)); - if (f != pro->key.end()) -@@ -86,9 +88,9 @@ - } - else // _REF_EXTRA - { -- DStringGDL* extraString= dynamic_cast(extraVal); -- if( extraString != NULL) -+ if( extraVal->Type() == GDL_STRING) // _EXTRA - { -+ DStringGDL* extraString= static_cast(extraVal); - EnvBaseT* caller; - if( callerIn == NULL) - caller = thisEnv->Caller(); -@@ -114,7 +116,7 @@ - { // found - - // search keyword -- IDList::iterator f=find_if(pro->key.begin(), -+ KeyVarListT::iterator f=find_if(pro->key.begin(), - pro->key.end(), - String_abbref_eq( kName)); - if( f != pro->key.end()) -@@ -145,6 +147,7 @@ - } // caller->pro->Extra() == DSub::REFEXTRA) - } // extraString != NULL - } -+ } - // all keywords are now overridden in the actual environment - // listName/listEnv holds all _EXTRA data, which is not used by this - // subroutine -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/fftw.cpp gdl/src/fftw.cpp ---- gdl-0.9.3/src/fftw.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/fftw.cpp 2013-07-08 12:39:21.899393076 -0600 -@@ -35,8 +35,8 @@ - - using namespace std; - -- static int szdbl=sizeof(double); -- static int szflt=sizeof(float); -+// static int szdbl=sizeof(double); -+// static int szflt=sizeof(float); - - template < typename T> - T* fftw_template(BaseGDL* p0, -@@ -77,7 +77,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i guard_p0C; -+ Guard guard_p0C; - - if( p0->Type() != GDL_COMPLEXDBL) { - p0C = static_cast(p0->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY)); -- guard_p0C.reset(p0C); -+ guard_p0C.Init(p0C); - } else - { - if( overwrite) -@@ -209,7 +209,7 @@ - - DComplexGDL* p0C = static_cast - (p0->Convert2( GDL_COMPLEX, BaseGDL::COPY)); -- auto_ptr guard_p0C( p0C); -+ Guard guard_p0C( p0C); - return fftw_template< DComplexGDL> (p0C, nEl, dbl, overwrite, direct); - - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/file.cpp gdl/src/file.cpp ---- gdl-0.9.3/src/file.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/file.cpp 2013-07-08 12:39:21.901393053 -0600 -@@ -20,6 +20,8 @@ - #include "basegdl.hpp" - #include "str.hpp" - -+#include -+ - //#ifdef HAVE_LIBWXWIDGETS - - #include "envt.hpp" -@@ -419,6 +421,7 @@ - e->AssureScalarPar( 0, dir); - - WordExp( dir); -+ // cout<< dir<Throw( "Unable to change current directory to: "+dir+"."); - } -@@ -1085,6 +1089,127 @@ - } - #endif - -+ -+ BaseGDL* file_basename( EnvT* e) -+ { -+ -+ SizeT nParams=e->NParam( 1); -+ -+ // accepting only strings as parameters -+ BaseGDL* p0 = e->GetParDefined(0); -+ DStringGDL* p0S = dynamic_cast(p0); -+ if (p0S == NULL) e->Throw("String expression required in this context: " + e->GetParString(0)); -+ -+ BaseGDL* p1; -+ DStringGDL* p1S; -+ bool DoRemoveSuffix = false; -+ -+ if (nParams == 2) { -+ // shall we remove a suffix ? -+ p1 = e->GetPar(1); -+ p1S = dynamic_cast(p1); -+ // if (p1S == NULL) e->Throw("String expression required in this context: " + e->GetParString(0)); -+ if (p1S->N_Elements() == 1) { -+ if (strlen(strdup((*p1S)[0].c_str())) >0) DoRemoveSuffix=true; -+ } -+ if (p1S->N_Elements() > 1) -+ e->Throw(" Expression must be a scalar or 1 element array in this context: " + e->GetParString(1)); -+ } -+ -+ dimension resDim; -+ resDim=p0S->Dim(); -+ DStringGDL* res = new DStringGDL(resDim, BaseGDL::NOZERO); -+ -+ char *bname; -+ char *tmp; -+ -+ for (SizeT i = 0; i < p0S->N_Elements(); i++) { -+ -+ tmp=strdup((*p0S)[i].c_str()); -+ -+ // cout << ">>"<<(*p0S)[i].c_str() << "<<" << endl; -+ if (strlen(tmp) > 0) { -+ bname=basename(tmp); -+ (*res)[i]=string(bname); -+ } -+ else -+ { -+ (*res)[i]=""; -+ } -+ } -+ -+ // managing suffixe -+ if (DoRemoveSuffix) { -+ -+ string suffixe=(*p1S)[0]; -+ int suffLength=strlen(strdup((*p1S)[0].c_str())); -+ -+ static int fold_caseIx = e->KeywordIx( "FOLD_CASE"); -+ bool fold_case = e->KeywordSet( fold_caseIx); -+ -+ if (fold_case) suffixe=StrUpCase(suffixe); -+ -+ cout << "suffixe :"<< suffixe << endl; -+ -+ -+ string tmp1, fin_tmp; -+ for (SizeT i = 0; i < p0S->N_Elements(); i++) { -+ tmp1=(*res)[i].c_str(); -+ -+ // Strickly greater : if equal, we keep it ! -+ if (tmp1.length() > suffLength) { -+ fin_tmp=tmp1.substr(tmp1.length()-suffLength); -+ -+ if (fold_case) fin_tmp=StrUpCase(fin_tmp); -+ -+ if (fin_tmp.compare(suffixe) == 0) { -+ (*res)[i]=tmp1.substr(0,tmp1.length()-suffLength); -+ } -+ } -+ } -+ -+ } -+ -+ return res; -+ } -+ -+ -+ BaseGDL* file_dirname( EnvT* e) -+ { -+ // accepting only strings as parameters -+ BaseGDL* p0 = e->GetParDefined(0); -+ DStringGDL* p0S = dynamic_cast(p0); -+ if (p0S == NULL) e->Throw("String expression required in this context: " + e->GetParString(0)); -+ -+ dimension resDim; -+ resDim=p0S->Dim(); -+ DStringGDL* res = new DStringGDL(resDim, BaseGDL::NOZERO); -+ -+ char *dname; -+ -+ for (SizeT i = 0; i < p0S->N_Elements(); i++) { -+ char *tmp; -+ tmp=strdup((*p0S)[i].c_str()); -+ dname=dirname(tmp); -+ (*res)[i]=string(dname); -+ -+ } -+ -+#ifdef _MSC_VER -+ string PathSeparator="\\"; //" -+#else -+ string PathSeparator="/";//" -+#endif -+ if (e->KeywordSet("MARK_DIRECTORY")) { -+ for (SizeT i = 0; i < p0S->N_Elements(); i++) { -+ (*res)[i]=(*res)[i] + PathSeparator; -+ } -+ } -+ -+ return res; -+ -+} -+ - BaseGDL* file_same( EnvT* e) - { - // assuring right number of parameters -@@ -1323,7 +1448,9 @@ - for (int j=0; jN_Elements(); j++) - { - string tmp = (*pi)[j]; -- if (!noexpand_path) WordExp(tmp); -+ // cout<Throw("failed to create a directory (or execute mkdir)."); - } - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/file.hpp gdl/src/file.hpp ---- gdl-0.9.3/src/file.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/file.hpp 2013-07-08 12:39:21.902393041 -0600 -@@ -35,6 +35,9 @@ - - BaseGDL* file_info( EnvT* e); - -+ BaseGDL* file_basename( EnvT* e); -+ BaseGDL* file_dirname( EnvT* e); -+ - // helper functions - void ExpandPath( FileListT& result, - const DString& dirN, -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTIn.cpp gdl/src/FMTIn.cpp ---- gdl-0.9.3/src/FMTIn.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTIn.cpp 2013-07-08 12:39:21.286400339 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "format.in.g" -> "FMTIn.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.in.g" -> "FMTIn.cpp"$ */ - - #include "includefirst.hpp" - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTIn.hpp gdl/src/FMTIn.hpp ---- gdl-0.9.3/src/FMTIn.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTIn.hpp 2013-07-08 12:39:21.288400315 -0600 -@@ -3,7 +3,7 @@ - - #include - #include "FMTInTokenTypes.hpp" --/* $ANTLR 2.7.7 (20110618): "format.in.g" -> "FMTIn.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.in.g" -> "FMTIn.hpp"$ */ - #include - - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTInTokenTypes.hpp gdl/src/FMTInTokenTypes.hpp ---- gdl-0.9.3/src/FMTInTokenTypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTInTokenTypes.hpp 2013-07-08 12:39:21.289400303 -0600 -@@ -1,7 +1,7 @@ - #ifndef INC_FMTInTokenTypes_hpp_ - #define INC_FMTInTokenTypes_hpp_ - --/* $ANTLR 2.7.7 (20110618): "format.in.g" -> "FMTInTokenTypes.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.in.g" -> "FMTInTokenTypes.hpp"$ */ - - #ifndef CUSTOM_API - # define CUSTOM_API -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTInTokenTypes.txt gdl/src/FMTInTokenTypes.txt ---- gdl-0.9.3/src/FMTInTokenTypes.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTInTokenTypes.txt 2013-07-08 12:39:21.290400291 -0600 -@@ -1,4 +1,4 @@ --// $ANTLR 2.7.7 (20110618): format.in.g -> FMTInTokenTypes.txt$ -+// $ANTLR 2.7.7 (20120518): format.in.g -> FMTInTokenTypes.txt$ - FMTIn // output token vocab name - ALL=4 - CSTR=5 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTLexer.cpp gdl/src/FMTLexer.cpp ---- gdl-0.9.3/src/FMTLexer.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTLexer.cpp 2013-07-08 12:39:21.311400043 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "format.g" -> "FMTLexer.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.g" -> "FMTLexer.cpp"$ */ - - #include "includefirst.hpp" - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTLexer.hpp gdl/src/FMTLexer.hpp ---- gdl-0.9.3/src/FMTLexer.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTLexer.hpp 2013-07-08 12:39:21.316399983 -0600 -@@ -2,7 +2,7 @@ - #define INC_FMTLexer_hpp_ - - #include --/* $ANTLR 2.7.7 (20110618): "format.g" -> "FMTLexer.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.g" -> "FMTLexer.hpp"$ */ - #include - #include - #include -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTOut.cpp gdl/src/FMTOut.cpp ---- gdl-0.9.3/src/FMTOut.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTOut.cpp 2013-07-08 12:39:21.320399936 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "format.out.g" -> "FMTOut.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.out.g" -> "FMTOut.cpp"$ */ - - #include "includefirst.hpp" - -@@ -621,6 +621,21 @@ - c1 = _t; - match(antlr::RefAST(_t),CMOA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c1->getRep(); -+ int w = c1->getW(); -+ int d = c1->getD(); -+ int f = c1->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMOA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CMoA: -@@ -628,6 +643,21 @@ - c2 = _t; - match(antlr::RefAST(_t),CMoA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c2->getRep(); -+ int w = c2->getW(); -+ int d = c2->getD(); -+ int f = c2->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMoA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CmoA: -@@ -635,6 +665,21 @@ - c3 = _t; - match(antlr::RefAST(_t),CmoA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c3->getRep(); -+ int w = c3->getW(); -+ int d = c3->getD(); -+ int f = c3->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CmoA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CHI: -@@ -642,6 +687,21 @@ - c4 = _t; - match(antlr::RefAST(_t),CHI); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c4->getRep(); -+ int w = c4->getW(); -+ int d = c4->getD(); -+ int f = c4->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CHI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case ChI: -@@ -649,6 +709,21 @@ - c5 = _t; - match(antlr::RefAST(_t),ChI); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c5->getRep(); -+ int w = c5->getW(); -+ int d = c5->getD(); -+ int f = c5->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::ChI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CDWA: -@@ -656,6 +731,21 @@ - c6 = _t; - match(antlr::RefAST(_t),CDWA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c6->getRep(); -+ int w = c6->getW(); -+ int d = c6->getD(); -+ int f = c6->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CDWA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CDwA: -@@ -663,6 +753,21 @@ - c7 = _t; - match(antlr::RefAST(_t),CDwA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c7->getRep(); -+ int w = c7->getW(); -+ int d = c7->getD(); -+ int f = c7->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CDwA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CdwA: -@@ -670,6 +775,21 @@ - c8 = _t; - match(antlr::RefAST(_t),CdwA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c8->getRep(); -+ int w = c8->getW(); -+ int d = c8->getD(); -+ int f = c8->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CdwA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CAPA: -@@ -677,6 +797,21 @@ - c9 = _t; - match(antlr::RefAST(_t),CAPA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c9->getRep(); -+ int w = c9->getW(); -+ int d = c9->getD(); -+ int f = c9->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CAPA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CApA: -@@ -684,6 +819,21 @@ - c10 = _t; - match(antlr::RefAST(_t),CApA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c10->getRep(); -+ int w = c10->getW(); -+ int d = c10->getD(); -+ int f = c10->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CApA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CapA: -@@ -691,6 +841,21 @@ - c11 = _t; - match(antlr::RefAST(_t),CapA); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c11->getRep(); -+ int w = c11->getW(); -+ int d = c11->getD(); -+ int f = c11->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CapA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CMOI: -@@ -698,6 +863,21 @@ - c12 = _t; - match(antlr::RefAST(_t),CMOI); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c12->getRep(); -+ int w = c12->getW(); -+ int d = c12->getD(); -+ int f = c12->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMOI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CDI: -@@ -705,6 +885,21 @@ - c13 = _t; - match(antlr::RefAST(_t),CDI); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c13->getRep(); -+ int w = c13->getW(); -+ int d = c13->getD(); -+ int f = c13->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CDI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CYI: -@@ -712,6 +907,21 @@ - c14 = _t; - match(antlr::RefAST(_t),CYI); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c14->getRep(); -+ int w = c14->getW(); -+ int d = c14->getD(); -+ int f = c14->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CYI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CMI: -@@ -719,6 +929,21 @@ - c15 = _t; - match(antlr::RefAST(_t),CMI); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c15->getRep(); -+ int w = c15->getW(); -+ int d = c15->getD(); -+ int f = c15->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CSI: -@@ -726,6 +951,21 @@ - c16 = _t; - match(antlr::RefAST(_t),CSI); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c16->getRep(); -+ int w = c16->getW(); -+ int d = c16->getD(); -+ int f = c16->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CSI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case CSF: -@@ -733,6 +973,21 @@ - c17 = _t; - match(antlr::RefAST(_t),CSF); - _t = _t->getNextSibling(); -+ -+ if( actPar == NULL) break; -+ -+ int r = c17->getRep(); -+ int w = c17->getW(); -+ int d = c17->getD(); -+ int f = c17->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CSF); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ - break; - } - case X: -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTOut.hpp gdl/src/FMTOut.hpp ---- gdl-0.9.3/src/FMTOut.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTOut.hpp 2013-07-08 12:39:21.321399924 -0600 -@@ -3,7 +3,7 @@ - - #include - #include "FMTOutTokenTypes.hpp" --/* $ANTLR 2.7.7 (20110618): "format.out.g" -> "FMTOut.hpp"$ */ -+/* $ANTLR 2.7.7 (2006-11-01): "format.out.g" -> "FMTOut.hpp"$ */ - #include - - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTOutTokenTypes.hpp gdl/src/FMTOutTokenTypes.hpp ---- gdl-0.9.3/src/FMTOutTokenTypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTOutTokenTypes.hpp 2013-07-08 12:39:21.323399900 -0600 -@@ -1,7 +1,7 @@ - #ifndef INC_FMTOutTokenTypes_hpp_ - #define INC_FMTOutTokenTypes_hpp_ - --/* $ANTLR 2.7.7 (20110618): "format.out.g" -> "FMTOutTokenTypes.hpp"$ */ -+/* $ANTLR 2.7.7 (2006-11-01): "format.out.g" -> "FMTOutTokenTypes.hpp"$ */ - - #ifndef CUSTOM_API - # define CUSTOM_API -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTOutTokenTypes.txt gdl/src/FMTOutTokenTypes.txt ---- gdl-0.9.3/src/FMTOutTokenTypes.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTOutTokenTypes.txt 2013-07-08 12:39:21.324399888 -0600 -@@ -1,4 +1,4 @@ --// $ANTLR 2.7.7 (20110618): format.out.g -> FMTOutTokenTypes.txt$ -+// $ANTLR 2.7.7 (2006-11-01): format.out.g -> FMTOutTokenTypes.txt$ - FMTOut // output token vocab name - ALL=4 - CSTR=5 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTParser.cpp gdl/src/FMTParser.cpp ---- gdl-0.9.3/src/FMTParser.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTParser.cpp 2013-07-08 12:39:21.326399865 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "format.g" -> "FMTParser.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.g" -> "FMTParser.cpp"$ */ - - #include "includefirst.hpp" - -@@ -883,10 +883,10 @@ - c_AST = astFactory->create(c); - astFactory->makeASTRoot(currentAST, antlr::RefAST(c_AST)); - match(C); -- match(RBRACE); -+ match(LBRACE); - csub(); - astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -- match(LBRACE); -+ match(RBRACE); - c_AST->setRep( repeat); - rep_fmt_AST = RefFMTNode(currentAST.root); - break; -@@ -928,7 +928,6 @@ - fNode->setD( n2); - break; - } -- case LBRACE: - case COMMA: - case RBRACE: - case SLASH: -@@ -944,7 +943,6 @@ - } - break; - } -- case LBRACE: - case COMMA: - case RBRACE: - case SLASH: -@@ -1091,8 +1089,8 @@ - c1_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1120,8 +1118,8 @@ - c2_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1149,8 +1147,8 @@ - c3_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1200,8 +1198,8 @@ - c6_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1229,8 +1227,8 @@ - c7_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1258,8 +1256,8 @@ - c8_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1287,8 +1285,8 @@ - c9_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1316,8 +1314,8 @@ - c10_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -@@ -1345,8 +1343,8 @@ - c11_AST->setW( n1); - break; - } -- case LBRACE: - case COMMA: -+ case RBRACE: - { - break; - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTParser.hpp gdl/src/FMTParser.hpp ---- gdl-0.9.3/src/FMTParser.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTParser.hpp 2013-07-08 12:39:21.328399841 -0600 -@@ -2,7 +2,7 @@ - #define INC_FMTParser_hpp_ - - #include --/* $ANTLR 2.7.7 (20110618): "format.g" -> "FMTParser.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.g" -> "FMTParser.hpp"$ */ - #include - #include - #include "FMTTokenTypes.hpp" -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTTokenTypes.hpp gdl/src/FMTTokenTypes.hpp ---- gdl-0.9.3/src/FMTTokenTypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTTokenTypes.hpp 2013-07-08 12:39:21.332399794 -0600 -@@ -1,7 +1,7 @@ - #ifndef INC_FMTTokenTypes_hpp_ - #define INC_FMTTokenTypes_hpp_ - --/* $ANTLR 2.7.7 (20110618): "format.g" -> "FMTTokenTypes.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "format.g" -> "FMTTokenTypes.hpp"$ */ - - #ifndef CUSTOM_API - # define CUSTOM_API -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/FMTTokenTypes.txt gdl/src/FMTTokenTypes.txt ---- gdl-0.9.3/src/FMTTokenTypes.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/FMTTokenTypes.txt 2013-07-08 12:39:21.339399711 -0600 -@@ -1,4 +1,4 @@ --// $ANTLR 2.7.7 (20110618): format.g -> FMTTokenTypes.txt$ -+// $ANTLR 2.7.7 (20120518): format.g -> FMTTokenTypes.txt$ - FMT // output token vocab name - ALL=4 - CSTR=5 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/format.g gdl/src/format.g ---- gdl-0.9.3/src/format.g 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/format.g 2013-07-08 12:39:21.903393029 -0600 -@@ -176,7 +176,7 @@ - | b:B w_d [ #b] { #b->setRep( repeat);} - | z:Z w_d [ #z] { #z->setRep( repeat);} - | zz:ZZ w_d [ #zz] { #zz->setRep( repeat);} -- | c:C^ RBRACE! csub LBRACE! { #c->setRep( repeat);} -+ | c:C^ LBRACE! csub RBRACE! { #c->setRep( repeat);} - ; - - csub -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/format.out.g gdl/src/format.out.g ---- gdl-0.9.3/src/format.out.g 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/format.out.g 2013-07-08 12:39:21.905393006 -0600 -@@ -456,22 +456,278 @@ - - csubcode - : c1:CMOA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c1->getRep(); -+ int w = c1->getW(); -+ int d = c1->getD(); -+ int f = c1->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMOA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } -+ - | c2:CMoA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c2->getRep(); -+ int w = c2->getW(); -+ int d = c2->getD(); -+ int f = c2->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMoA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c3:CmoA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c3->getRep(); -+ int w = c3->getW(); -+ int d = c3->getD(); -+ int f = c3->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CmoA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c4:CHI -+ { -+ if( actPar == NULL) break; -+ -+ int r = c4->getRep(); -+ int w = c4->getW(); -+ int d = c4->getD(); -+ int f = c4->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CHI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c5:ChI -+ { -+ if( actPar == NULL) break; -+ -+ int r = c5->getRep(); -+ int w = c5->getW(); -+ int d = c5->getD(); -+ int f = c5->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::ChI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c6:CDWA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c6->getRep(); -+ int w = c6->getW(); -+ int d = c6->getD(); -+ int f = c6->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CDWA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c7:CDwA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c7->getRep(); -+ int w = c7->getW(); -+ int d = c7->getD(); -+ int f = c7->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CDwA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c8:CdwA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c8->getRep(); -+ int w = c8->getW(); -+ int d = c8->getD(); -+ int f = c8->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CdwA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c9:CAPA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c9->getRep(); -+ int w = c9->getW(); -+ int d = c9->getD(); -+ int f = c9->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CAPA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c10:CApA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c10->getRep(); -+ int w = c10->getW(); -+ int d = c10->getD(); -+ int f = c10->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CApA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c11:CapA -+ { -+ if( actPar == NULL) break; -+ -+ int r = c11->getRep(); -+ int w = c11->getW(); -+ int d = c11->getD(); -+ int f = c11->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CapA); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c12:CMOI -+ { -+ if( actPar == NULL) break; -+ -+ int r = c12->getRep(); -+ int w = c12->getW(); -+ int d = c12->getD(); -+ int f = c12->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMOI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c13:CDI -+ { -+ if( actPar == NULL) break; -+ -+ int r = c13->getRep(); -+ int w = c13->getW(); -+ int d = c13->getD(); -+ int f = c13->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CDI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c14:CYI -+ { -+ if( actPar == NULL) break; -+ -+ int r = c14->getRep(); -+ int w = c14->getW(); -+ int d = c14->getD(); -+ int f = c14->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CYI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c15:CMI -+ { -+ if( actPar == NULL) break; -+ -+ int r = c15->getRep(); -+ int w = c15->getW(); -+ int d = c15->getD(); -+ int f = c15->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CMI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c16:CSI -+ { -+ if( actPar == NULL) break; -+ -+ int r = c16->getRep(); -+ int w = c16->getW(); -+ int d = c16->getD(); -+ int f = c16->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CSI); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | c17:CSF -+ { -+ if( actPar == NULL) break; -+ -+ int r = c17->getRep(); -+ int w = c17->getW(); -+ int d = c17->getD(); -+ int f = c17->getFill(); -+ do { -+ SizeT tCount = actPar->OFmtCal( os, valIx, r, w, d, f, -+ BaseGDL::CSF); -+ r -= tCount; -+ NextVal( tCount); -+ if( actPar == NULL) break; -+ } while( r>0); -+ } - | x - | f_csubcode - ; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlarray.hpp gdl/src/gdlarray.hpp ---- gdl-0.9.3/src/gdlarray.hpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/gdlarray.hpp 2013-07-31 09:41:43.870245938 -0600 -@@ -0,0 +1,322 @@ -+/*************************************************************************** -+ gdlarray.hpp - basic typedefs -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002 by Marc Schellens -+ email : m_schellens@users.sf.net -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#ifndef GDLARRAY_HPP_ -+#define GDLARRAY_HPP_ -+ -+// #define GDLARRAY_CACHE -+#undef GDLARRAY_CACHE -+ -+//#define GDLARRAY_DEBUG -+#undef GDLARRAY_DEBUG -+ -+// for complex (of POD) -+const bool TreatPODComplexAsPOD = true; -+ -+template -+class GDLArray -+{ -+private: -+ enum GDLArrayConstants -+ { -+ smallArraySize = 27, -+ maxCache = 1000 * 1000 // ComplexDbl is 16 bytes -+ }; -+ -+ typedef T Ty; -+ -+#ifdef USE_EIGEN -+ EIGEN_ALIGN16 char scalarBuf[ smallArraySize * sizeof(Ty)]; -+#else -+ char scalarBuf[ smallArraySize * sizeof(Ty)]; -+#endif -+ -+ Ty* InitScalar() -+ { -+ assert( sz <= smallArraySize); -+ if( IsPOD) -+ { -+ return reinterpret_cast(scalarBuf); -+ } -+ else -+ { -+ Ty* b = reinterpret_cast(scalarBuf); -+ for( int i = 0; i( s); -+#else -+ return new Ty[ s]; -+#endif -+ } -+ -+public: -+ GDLArray() throw() : buf( NULL), sz( 0) {} -+ -+#ifndef GDLARRAY_CACHE -+ -+ ~GDLArray() throw() -+ { -+ if( IsPOD) -+ { -+#ifdef USE_EIGEN -+ if( buf != reinterpret_cast(scalarBuf)) -+ Eigen::internal::aligned_delete( buf, sz); -+#else -+ if( buf != reinterpret_cast(scalarBuf)) -+ delete[] buf; // buf == NULL also possible -+#endif -+ // no cleanup of "buf" here -+ } -+ else -+ { -+#ifdef USE_EIGEN -+ if( buf != reinterpret_cast(scalarBuf)) -+ Eigen::internal::aligned_delete( buf, sz); -+ else -+ for( int i = 0; i(scalarBuf)) -+ delete[] buf; // buf == NULL also possible -+ else -+ for( int i = 0; i smallArraySize) ? New(cp.size()) /*New T[ cp.size()]*/ : InitScalar(); -+ } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } -+ -+ std::memcpy(buf,cp.buf,sz*sizeof(T)); -+ } -+ else -+ { -+ try { -+ buf = (cp.size() > smallArraySize) ? New(cp.size()) /*new Ty[ cp.size()]*/ : InitScalar(); -+ } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } -+ for( SizeT i=0; i smallArraySize) ? New(s) /*T[ s]*/ : InitScalar(); -+ } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } -+ } -+ -+ GDLArray( T val, SizeT s) : sz( s) -+ { -+ try { -+ buf = (s > smallArraySize) ? New(s) /*T[ s]*/ : InitScalar(); -+ } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } -+ -+ for( SizeT i=0; i smallArraySize ) ? New(s) /*T[ s]*/: InitScalar(); -+ } -+ catch ( std::bad_alloc& ) { ThrowGDLException ( "Array requires more memory than available" ); } -+ -+ std::memcpy(buf,arr,sz*sizeof(T)); -+ } -+ else -+ { -+ try { -+ buf = (s > smallArraySize) ? New(s) /*new Ty[ s]*/: InitScalar(); -+ } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } -+ for( SizeT i=0; i(scalarBuf); -+ buf[0] = s; -+ } -+ else -+ { -+ Ty* b = reinterpret_cast(scalarBuf); -+ new (&(b[ 0])) Ty( s); -+ buf = b; -+ } -+ } -+ -+ T& operator[]( SizeT ix) throw() -+ { -+ if( ix >= sz) -+ assert( ix < sz); -+ return buf[ ix]; -+ } -+ const T& operator[]( SizeT ix) const throw() -+ { -+// if( ix >= sz) // debug -+ assert( ix < sz); -+ return buf[ ix]; -+ } -+ -+// private: // disable -+// only used (indirect) by DStructGDL::DStructGDL(const DStructGDL& d_) -+void InitFrom( const GDLArray& right ) -+{ -+ assert( &right != this); -+ assert ( sz == right.size() ); -+ if( IsPOD) -+ { -+ std::memcpy(buf,right.buf,sz*sizeof(Ty)); -+ } -+ else -+ { -+ for ( SizeT i=0; i smallArraySize ) -+ { -+ try -+ { -+ buf = New(sz) /*new T[ newSz]*/; -+ } -+ catch ( std::bad_alloc& ) -+ { -+ ThrowGDLException ( "Array requires more memory than available" ); -+ } -+ } -+ else -+ { -+ // default constructed instances have buf == NULL and size == 0 -+ // make sure buf is set corectly if such instances are resized -+ buf = InitScalar(); -+ } -+ } -+ -+}; // GDLArray -+ -+#endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlc.g gdl/src/gdlc.g ---- gdl-0.9.3/src/gdlc.g 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlc.g 2013-07-08 12:39:21.910392946 -0600 -@@ -1214,8 +1214,18 @@ - ; - - arrayindex_list -+{ -+ int rank = 1; -+} - : LSQUARE! arrayindex (COMMA! arrayindex)* RSQUARE! -- | LBRACE! arrayindex (COMMA! arrayindex)* RBRACE! -+ | LBRACE! arrayindex -+ ({++rank <= MAXRANK}? COMMA! arrayindex -+ // { // this is needed here because an ARRAYEXPR_FN which -+ // // is a function call might have more paremeters -+ // if( -+ // throw antlr::NoViableAltException(LT(1), getFilename()); -+ // } -+ )* RBRACE! - ; - - all! -@@ -1456,7 +1466,8 @@ - } - // : array_expr_1st (DOT array_expr_nth)* - : a1:array_expr_1st -- ((tag_access)=> nDot=tag_access -+ // ((tag_access)=> nDot=tag_access -+ ((DOT)=> nDot=tag_access - { - - dot=#[DOT,"."]; -@@ -1501,6 +1512,43 @@ - { #assign_expr = #([ASSIGN,":="], #assign_expr);} - ; - -+// arrayexpr_mfcall_last -+// : (IDENTIFIER^ arrayindex_list) -+// ; -+ -+// only used for production in primary_expr -+arrayexpr_mfcall! -+{ -+ RefDNode dot; -+ RefDNode tag; -+ int nDot; -+} -+ : a1:array_expr_1st -+ ( // this rule is only for prodction // (tag_access_keeplast)=> -+ nDot=t1:tag_access_keeplast -+ { -+ if( --nDot > 0) -+ { -+ dot=#[DOT,"DOT_A_MF"]; -+ dot->SetNDot( nDot); -+ dot->SetLine( #a1->getLine()); -+ tag = #(dot, #a1, #t1); -+ } -+ } -+ ) -+ id:IDENTIFIER al:arrayindex_list -+ { -+ if( nDot > 0) -+ #arrayexpr_mfcall = #([ARRAYEXPR_MFCALL,"arrayexpr_mfcall"], #tag, #id, #al); -+ else -+ #arrayexpr_mfcall = #([ARRAYEXPR_MFCALL,"arrayexpr_mfcall"], #a1, #id, #al); -+ } -+ | ASTERIX deref_arrayexpr_mfcall:arrayexpr_mfcall -+ { #arrayexpr_mfcall = -+ #([DEREF,"deref"], #deref_arrayexpr_mfcall);} -+ ; -+ -+ - // only here a function call is ok also (all other places must be an array) - primary_expr - { -@@ -1518,11 +1566,13 @@ - // ambiguity (arrayexpr or mfcall) - (deref_dot_expr_keeplast - (IDENTIFIER LBRACE expr (COMMA expr)* RBRACE))=> -- d2:deref_dot_expr_keeplast -- // here it is impossible to decide about function call -- // as we do not know the object type/struct tag -- IDENTIFIER arrayindex_list -- { #primary_expr = #([ARRAYEXPR_MFCALL,"arrayexpr_mfcall"], #primary_expr);} -+ -+ arrayexpr_mfcall -+ // d2:deref_dot_expr_keeplast -+ // // here it is impossible to decide about function call -+ // // as we do not know the object type/struct tag -+ // IDENTIFIER arrayindex_list -+ // { #primary_expr = #([ARRAYEXPR_MFCALL,"arrayexpr_mfcall"], #primary_expr);} - | - // not the above -> unambigous mfcall (or unambigous array expr handled below) - (deref_dot_expr_keeplast formal_function_call)=> -@@ -1566,11 +1616,17 @@ - } - | - // still ambiguity (arrayexpr or fcall) -- var arrayindex_list // array_expr_fn -+ (var arrayindex_list)=> var arrayindex_list // array_expr_fn - { - // std::cout << "***(IDENTIFIER LBRACE expr (COMMA expr)* RBRACE) 2" << std::endl; - - #primary_expr = #([ARRAYEXPR_FCALL,"arrayexpr_fcall"], #primary_expr);} -+ | // if arrayindex_list failed (due to to many indices) -+ // this must be a function call -+ formal_function_call -+ { -+ #primary_expr = #([FCALL, "fcall"], #primary_expr); -+ } - // ( parent=member_function_call - // { - // if( parent) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlc.i.g gdl/src/gdlc.i.g ---- gdl-0.9.3/src/gdlc.i.g 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlc.i.g 2013-07-31 09:41:43.882245897 -0600 -@@ -169,8 +169,11 @@ - static int GetFunIx( const std::string& subName); - static int GetProIx( ProgNodeP);//const std::string& subName); - static int GetProIx( const std::string& subName); -- DStructGDL* ObjectStruct( BaseGDL* self, ProgNodeP mp); -- DStructGDL* ObjectStructCheckAccess( BaseGDL* self, ProgNodeP mp); -+ DStructGDL* ObjectStruct( DObjGDL* self, ProgNodeP mp); -+ void SetRootR( ProgNodeP tt, DotAccessDescT* aD, BaseGDL* r, ArrayIndexListT* aL); -+ void SetRootL( ProgNodeP tt, DotAccessDescT* aD, BaseGDL* r, ArrayIndexListT* aL); -+ // DStructGDL* ObjectStructCheckAccess( DObjGDL* self, ProgNodeP mp); -+ // DStructDesc* GDLObjectDesc( DObjGDL* self, ProgNodeP mp); - - // code in: dinterpreter.cpp - static void SetFunIx( ProgNodeP f); // triggers read/compile -@@ -198,8 +201,10 @@ - { - public: - enum ExCode { -- NONE=0, // normal RETALL -- RUN // RETALL from .RUN command -+ NONE=0 // normal RETALL -+ ,RUN // RETALL from .RUN command -+ ,RESET // RETALL from .RESET command -+ ,FULL_RESET // RETALL from .FULL_RESET command - }; - - private: -@@ -316,6 +321,13 @@ - } - } - } -+ static void HeapErase( DPtr id) // for LIST -+ { -+ if( id != 0) -+ { -+ heap.erase( id); -+ } -+ } - static void FreeHeapDirect( DPtr id, HeapT::iterator it) - { - delete (*it).second.get(); -@@ -402,7 +414,7 @@ - } - static void DecRefObj( DObjGDL* p) - { -- SizeT nEl=p->N_Elements(); -+ SizeT nEl=p->Size();//N_Elements(); - for( SizeT ix=0; ix < nEl; ix++) - { - DObj id= (*p)[ix]; -@@ -479,7 +491,7 @@ - } - static void IncRefObj( DObjGDL* p) - { -- SizeT nEl=p->N_Elements(); -+ SizeT nEl=p->Size();//N_Elements(); - for( SizeT ix=0; ix < nEl; ix++) - { - DObj id= (*p)[ix]; -@@ -492,13 +504,15 @@ - static BaseGDL*& GetHeap( DPtr ID) - { - HeapT::iterator it=heap.find( ID); -- if( it == heap.end()) throw HeapException(); -+ if( it == heap.end()) -+ throw HeapException(); - return it->second.get(); - } - static DStructGDL*& GetObjHeap( DObj ID) - { - ObjHeapT::iterator it=objHeap.find( ID); -- if( it == objHeap.end()) throw HeapException(); -+ if( it == objHeap.end()) -+ throw HeapException(); - return it->second.get(); - } - -@@ -510,12 +524,12 @@ - if( it == objHeap.end()) return NULL; - return it->second.get()->Desc()->GetOperator( opIx); - } -- // static DStructGDL* GetObjHeapNoThrow( DObj ID) -- // { -- // ObjHeapT::iterator it=objHeap.find( ID); -- // if( it == objHeap.end()) return NULL; -- // return it->second.get(); -- // } -+ static DStructGDL* GetObjHeapNoThrow( DObj ID) -+ { -+ ObjHeapT::iterator it=objHeap.find( ID); -+ if( it == objHeap.end()) return NULL; -+ return it->second.get(); -+ } - // static DStructGDL*& GetObjHeap( DObj ID, ObjHeapT::iterator& it) - // { - // // ObjHeapT::iterator it=objHeap.find( ID); -@@ -629,6 +643,21 @@ - return ret; - } - -+ -+ static void ResetHeap() // purges both heaps -+ { -+ for( HeapT::iterator it=heap.begin(); it != heap.end(); ++it) -+ { -+ delete (*it).second.get(); -+ heap.erase( it->first); -+ } -+ for( ObjHeapT::iterator it=objHeap.begin(); it != objHeap.end(); ++it) -+ { -+ delete (*it).second.get(); -+ objHeap.erase( it->first); -+ } -+ } -+ - // name of data - static const std::string Name( BaseGDL* p) // const - { -@@ -645,6 +674,9 @@ - return "<(ptr to undefined expression not found on the heap)>"; - } - -+ -+ -+ - // compiler (lexer, parser, treeparser) def in dinterpreter.cpp - static void ReportCompileError( GDLException& e, const std::string& file = ""); - -@@ -692,17 +724,22 @@ - { - DString msgPrefix = SysVar::MsgPrefix(); - -- EnvStackT::reverse_iterator upEnv = callStack.rbegin(); -- //EnvStackT::reverse_iterator env = upEnv++; -- upEnv++; -- for(; -- upEnv != callStack.rend(); -- ++upEnv /*,++env*/) -+ // EnvStackT::reverse_iterator upEnv = callStack.rbegin(); -+ // //EnvStackT::reverse_iterator env = upEnv++; -+ // upEnv++; -+ // for(; -+ // upEnv != callStack.rend(); -+ // ++upEnv /*,++env*/) -+ -+ long actIx = callStack.size() - 2; -+ for( ; actIx >= 0; --actIx) - { -+ EnvStackT::pointer_type upEnv = callStack[ actIx]; -+ - std::cerr << msgPrefix << std::right << std::setw( w) << ""; -- std::cerr << std::left << std::setw(16) << (*upEnv)->GetProName(); -+ std::cerr << std::left << std::setw(16) << upEnv->GetProName(); - -- std::string file = (*upEnv)->GetFilename(); -+ std::string file = upEnv->GetFilename(); - if( file != "") - { - // ProgNodeP cNode= (*env)->CallingNode(); -@@ -714,14 +751,13 @@ - // { - // std::cerr << std::right << std::setw(6) << ""; - // } -- - // ProgNodeP cNode= (*env)->CallingNode(); - // if( cNode != NULL && cNode->getLine() != 0) - // { - // (*upEnv)->SetLineNumber( cNode->getLine()); - // } - -- int lineNumber = (*upEnv)->GetLineNumber(); -+ int lineNumber = upEnv->GetLineNumber(); - if( lineNumber != 0) - { - std::cerr << std::right << std::setw(6) << lineNumber; -@@ -1019,7 +1055,7 @@ - | CONTINUE - | GOTO - | RETF -- | RETP -+ | RETP - ) - - // control-c and debugging -@@ -1103,28 +1139,81 @@ - // .CONTINUE does not work) - _retTree = last; - -- if( dynamic_cast< GDLIOException*>( &e) != NULL) -+ if( last->IsWrappedNode()) -+ throw e; // WRAPPED_... nodes should not stop inside -+ -+ // set !ERROR_STATE sys var -+ static DStructDesc* errorStateDesc = SysVar::Error_State()->Desc(); -+ static unsigned nameTag = errorStateDesc->TagIndex( "NAME"); -+ static unsigned codeTag = errorStateDesc->TagIndex( "CODE"); -+ static unsigned msgTag = errorStateDesc->TagIndex( "MSG"); -+ -+ if( e.IsIOException()) - { -+ assert( dynamic_cast< GDLIOException*>( &e) != NULL); - // set the jump target - also logs the jump - ProgNodeP onIOErr = - static_cast(callStack.back())->GetIOError(); - if( onIOErr != NULL) - { -- SysVar::SetErr_String( e.getMessage()); -+ DStructGDL* errorState = SysVar::Error_State(); -+ (*static_cast( errorState->GetTag( nameTag)))[0] = -+ "IDL_M_FAILURE"; -+ (*static_cast( errorState->GetTag( codeTag)))[0] = -+ e.ErrorCode(); -+ SysVar::SetErrError( e.ErrorCode()); -+ (*static_cast( errorState->GetTag( msgTag)))[0] = -+ e.getMessage(); -+ SysVar::SetErr_String( e.getMessage()); - - _retTree = onIOErr; - return RC_OK; - } - } - -+ // handle CATCH -+ ProgNodeP catchNode = callStack.back()->GetCatchNode(); -+ if( catchNode != NULL) -+ { -+ DStructGDL* errorState = SysVar::Error_State(); -+ (*static_cast( errorState->GetTag( nameTag)))[0] = -+ "IDL_M_FAILURE"; -+ (*static_cast( errorState->GetTag( codeTag)))[0] = -+ e.ErrorCode(); -+ SysVar::SetErrError( e.ErrorCode()); -+ (*static_cast( errorState->GetTag( msgTag)))[0] = -+ e.getMessage(); -+ SysVar::SetErr_String( e.getMessage()); -+ -+ BaseGDL** catchVar = callStack.back()->GetCatchVar(); -+ GDLDelete(*catchVar); -+ *catchVar = new DLongGDL( e.ErrorCode()); -+ _retTree = catchNode; -+ return RC_OK; -+ } -+ - EnvUDT* targetEnv = e.GetTargetEnv(); - if( targetEnv == NULL) - { - // initial exception, set target env -+ -+ // set !ERROR_STATE here -+ DStructGDL* errorState = SysVar::Error_State(); -+ (*static_cast( errorState->GetTag( nameTag)))[0] = -+ "IDL_M_FAILURE"; -+ (*static_cast( errorState->GetTag( codeTag)))[0] = -+ e.ErrorCode(); -+ SysVar::SetErrError( e.ErrorCode()); -+ (*static_cast( errorState->GetTag( msgTag)))[0] = -+ e.getMessage(); -+ SysVar::SetErr_String( e.getMessage()); -+ - // look if ON_ERROR is set somewhere -- for( EnvStackT::reverse_iterator i = callStack.rbegin(); -- i != callStack.rend(); ++i) -+ // for( EnvStackT::reverse_iterator i = callStack.rbegin(); -+ // i != callStack.rend(); ++i) -+ for( long ix = callStack.size() - 1; ix>=0; --ix) - { -+ EnvUDT** i = &callStack[ ix]; - DLong oE = -1; - EnvUDT* envUD = dynamic_cast(*i); - if( envUD != NULL) -@@ -1140,32 +1229,40 @@ - else if( oE == 1) - { - EnvUDT* cS_begin = -- static_cast(*callStack.begin()); -+ static_cast(callStack[0]); -+ // static_cast(*callStack.begin()); - targetEnv = cS_begin; - } - // 2 -> caller of routine which called ON_ERROR - else if( oE == 2) - { - // set to caller, handle nested -- while( static_cast(*(++i))->GetOnError() == 2 -- && i != callStack.rend()); -+ while( ix > 0 && static_cast(callStack[--ix])->GetOnError() == 2) -+ ; // just set ix - -- if( i == callStack.rend()) -- { -- EnvUDT* cS_begin = -- static_cast(*callStack.begin()); -- targetEnv = cS_begin; -- } -- else -- { -- EnvUDT* iUDT = static_cast(*i); -- targetEnv = iUDT; -- } -+ EnvUDT* iUDT = static_cast(callStack[ix]); -+ targetEnv = iUDT; -+ -+ -+ // while( static_cast(*(++i))->GetOnError() == 2 -+ // && i != callStack.rend()); -+ // if( i == callStack.rend()) -+ // { -+ // EnvUDT* cS_begin = -+ // static_cast(*callStack.begin()); -+ // targetEnv = cS_begin; -+ // } -+ // else -+ // { -+ // EnvUDT* iUDT = static_cast(*i); -+ // targetEnv = iUDT; -+ // } - } - // 3 -> routine which called ON_ERROR - else if( oE == 3) - { -- EnvUDT* iUDT = static_cast(*i); -+ EnvUDT* iUDT = static_cast(callStack[ix]); -+ // EnvUDT* iUDT = static_cast(*i); - targetEnv = iUDT; - } - -@@ -1259,7 +1356,7 @@ - - assert( actEnv != NULL); - -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = _t->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -1276,7 +1373,7 @@ - if( !callStack.back()->Contains( e1)) - { - // if( actEnv != NULL) -- actEnv->Guard( e1); -+ actEnv->DeleteAtExit( e1); - // else - // e1_guard.reset( e1); - } -@@ -1286,7 +1383,7 @@ - e1 = evalExpr->Eval(); - - // if( actEnv != NULL) -- actEnv->Guard( e1); -+ actEnv->DeleteAtExit( e1); - // else - // e1_guard.reset(e1); - } -@@ -1330,7 +1427,7 @@ - : res=l_deref - | #(QUESTION e1=expr - { -- auto_ptr e1_guard(e1); -+ Guard e1_guard(e1); - if( e1->True()) - { - res=l_ret_expr(_t); -@@ -1367,16 +1464,16 @@ - | // here ASSIGN and ASSIGN_REPLACE are identical - #(ASSIGN // can it occur at all? - { -- auto_ptr r_guard; -+ Guard r_guard; - } - ( e1=tmp_expr - { -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - | e1=lib_function_call - { - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - ) - res=l_ret_expr -@@ -1391,16 +1488,16 @@ - ) - | #(ASSIGN_ARRAYEXPR_MFCALL // here as return value of l_function - { -- auto_ptr r_guard; -+ Guard r_guard; - } - ( e1=tmp_expr - { -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - | e1=lib_function_call - { - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - ) - res=l_arrayexpr_mfcall_as_mfcall -@@ -1415,16 +1512,16 @@ - ) - | #(ASSIGN_REPLACE - { -- auto_ptr r_guard; -+ Guard r_guard; - } - ( e1=tmp_expr - { -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - | e1=lib_function_call - { - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - ) - res=l_ret_expr -@@ -1567,31 +1664,31 @@ - : #(dot:DOT - { - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - } -- l_dot_array_expr[ aD.get()] -- (tag_array_expr[ aD.get()] /* nDot times*/ )+ -+ l_dot_array_expr[ aD.Get()] -+ (tag_array_expr[ aD.Get()] /* nDot times*/ )+ - ) - { - if( dec_inc == DECSTATEMENT) - { -- aD->Dec(); -+ aD.Get()->Dec(); - res = NULL; - } - else if( dec_inc == INCSTATEMENT) - { -- aD->Inc(); -+ aD.Get()->Inc(); - res = NULL; - } - else - { -- if( dec_inc == DEC) aD->Dec(); //*** aD->Assign( dec_inc); -- else if( dec_inc == INC) aD->Inc(); -+ if( dec_inc == DEC) aD.Get()->Dec(); //*** aD->Assign( dec_inc); -+ else if( dec_inc == INC) aD.Get()->Inc(); - // -- res=aD->ADResolve(); -+ res=aD.Get()->ADResolve(); - -- if( dec_inc == POSTDEC) aD->Dec(); -- else if( dec_inc == POSTINC) aD->Inc(); -+ if( dec_inc == POSTDEC) aD.Get()->Dec(); -+ else if( dec_inc == POSTINC) aD.Get()->Inc(); - } - } - ; -@@ -1604,7 +1701,7 @@ - } - : #(QUESTION e1=expr - { -- auto_ptr e1_guard(e1); -+ Guard e1_guard(e1); - - if( e1->True()) - { -@@ -1619,7 +1716,7 @@ - ) // trinary operator - | #(ASSIGN - { -- auto_ptr r_guard; -+ Guard r_guard; - } - // ( e1=tmp_expr - // { -@@ -1632,11 +1729,11 @@ - // } - // ) - ( e1=indexable_expr -- | e1=indexable_tmp_expr { r_guard.reset( e1);} -+ | e1=indexable_tmp_expr { r_guard.Init( e1);} - | e1=lib_function_call - { - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); // guard if no global data -+ r_guard.Init( e1); // guard if no global data - } - ) - { -@@ -1652,14 +1749,14 @@ - ) - | #(ASSIGN_ARRAYEXPR_MFCALL - { -- auto_ptr r_guard; -+ Guard r_guard; - } - ( e1=indexable_expr -- | e1=indexable_tmp_expr { r_guard.reset( e1);} -+ | e1=indexable_tmp_expr { r_guard.Init( e1);} - | e1=lib_function_call - { - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); // guard if no global data -+ r_guard.Init( e1); // guard if no global data - } - ) - { -@@ -1677,7 +1774,7 @@ - { - delete *tmp; - -- if( r_guard.get() == e1) -+ if( r_guard.Get() == e1) - *tmp = r_guard.release(); - else - *tmp = e1->Dup(); -@@ -1703,16 +1800,16 @@ - ) - | #(ASSIGN_REPLACE - { -- auto_ptr r_guard; -+ Guard r_guard; - } - ( e1=tmp_expr - { -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - | e1=lib_function_call - { - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - } - ) - { -@@ -1731,7 +1828,7 @@ - { - delete *tmp; - -- if( r_guard.get() == e1) -+ if( r_guard.Get() == e1) - *tmp = r_guard.release(); - else - *tmp = e1->Dup(); -@@ -1753,12 +1850,15 @@ - //BaseGDL** e = l_arrayexpr_mfcall_as_mfcall( _t); - self=expr mp2:IDENTIFIER - { -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - EnvUDT* newEnv; - -+ DObjGDL* selfObj = NULL; -+ if( self->Type() == GDL_OBJ) -+ selfObj = static_cast( self); - try { -- newEnv=new EnvUDT( self, mp2, "", true); -+ newEnv=new EnvUDT( selfObj, mp2, "", true); - self_guard.release(); - } - catch( GDLException& ex) -@@ -1867,44 +1967,15 @@ - { - ArrayIndexListT* aL; - BaseGDL** rP; -- //DStructGDL* structR; -- ArrayIndexListGuard guard; - - if( _t->getType() == ARRAYEXPR) - { - rP=l_indexable_expr(_t->getFirstChild()); - aL=arrayindex_list(_retTree); -- guard.reset(aL); - - _retTree = _t->getNextSibling(); - -- // check here for object and get struct --// structR=dynamic_cast(*rP); --// if( structR == NULL) -- if( (*rP)->Type() != GDL_STRUCT) -- { -- bool isObj = callStack.back()->IsObject(); -- if( isObj) -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( *rP, _t); -- // oStruct cannot be "Assoc_" -- aD->ADRoot( oStruct, guard.release()); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(*rP), -- true,false); -- } -- } -- else -- { -- DStructGDL* structR=static_cast(*rP); -- if( (*rP)->IsAssoc()) -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(*rP),true,false); -- aD->ADRoot( structR, guard.release() /* aL */); -- } -+ SetRootL( _t, aD, *rP, aL); - } - else - // case ARRAYEXPR_MFCALL: -@@ -1919,37 +1990,8 @@ - // case VARPTR: - { - rP=l_indexable_expr(_t); -- //_t = _retTree; _retTree set ok -- -- // check here for object and get struct -- //structR = dynamic_cast(*rP); -- //if( structR == NULL) -- if( (*rP)->Type() != GDL_STRUCT) -- { -- bool isObj = callStack.back()->IsObject(); -- if( isObj) // member access to object? -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( *rP, _t); -- // oStruct cannot be "Assoc_" -- aD->ADRoot( oStruct); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(*rP), -- true,false); -- } -- } -- else -- { -- DStructGDL* structR=static_cast(*rP); -- if( (*rP)->IsAssoc()) -- { -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(*rP),true,false); -- } -- aD->ADRoot(structR); -- } -+ -+ SetRootL( _t, aD, *rP, NULL); - } - return; - // _retTree = _t; -@@ -1975,7 +2017,7 @@ - // _t = _t->getFirstChild(); - // e1=expr(_t); - // _t = _retTree; -- // auto_ptr e1_guard(e1); -+ // Guard e1_guard(e1); - // if( e1->True()) - // { - // res=l_expr(_t, right); -@@ -2024,7 +2066,7 @@ - // res=l_sys_var(_t); - // // _t = _retTree; // ok - -- // auto_ptr conv_guard; //( rConv); -+ // Guard conv_guard; //( rConv); - // BaseGDL* rConv = right; - // if( !(*res)->EqType( right)) - // { -@@ -2082,7 +2124,7 @@ - // _t = _t->getFirstChild(); - - // SizeT nDot = tIn->nDot; -- // auto_ptr aD( new DotAccessDescT(nDot+1)); -+ // Guard aD( new DotAccessDescT(nDot+1)); - - // l_dot_array_expr(_t, aD.get()); - // _t = _retTree; -@@ -2560,10 +2602,10 @@ - _t = _t->getFirstChild(); - e=expr(_t); - -- auto_ptr e_guard(e); -+ Guard e_guard(e); - - SizeT tagIx; -- int ret=e->Scalar2index(tagIx); -+ int ret=e->Scalar2Index(tagIx); - if( ret < 1) // this is a return code, not the index - throw GDLException( tIn, "Expression must be a scalar" - " >= 0 in this context: "+Name(e),true,false); -@@ -2584,23 +2626,23 @@ - return; - } - : #(EXPR e=expr -- { -- auto_ptr e_guard(e); -+ // { -+ // Guard e_guard(e); - -- SizeT tagIx; -- int ret=e->Scalar2index(tagIx); -- if( ret < 1) // this is a return code, not the index -- throw GDLException( _t, "Expression must be a scalar" -- " >= 0 in this context: "+Name(e),true,false); -+ // SizeT tagIx; -+ // int ret=e->Scalar2index(tagIx); -+ // if( ret < 1) // this is a return code, not the index -+ // throw GDLException( _t, "Expression must be a scalar" -+ // " >= 0 in this context: "+Name(e),true,false); - -- aD->ADAdd( tagIx); -- } -+ // aD->ADAdd( tagIx); -+ // } - ) - | i:IDENTIFIER -- { -- std::string tagName=i->getText(); -- aD->ADAdd( tagName); -- } -+ // { -+ // std::string tagName=i->getText(); -+ // aD->ADAdd( tagName); -+ // } - ; - - // for l and r expr -@@ -2630,8 +2672,8 @@ - //_retTree = _t; - return; - } -- : #(ARRAYEXPR tag_expr[ aD] aL=arrayindex_list { aD->ADAddIx(aL);} ) -- | tag_expr[ aD] { aD->ADAddIx(NULL);} -+ : #(ARRAYEXPR tag_expr[ aD] aL=arrayindex_list /*{ aD->ADAddIx(aL);}*/ ) -+ | tag_expr[ aD] //{ aD->ADAddIx(NULL);} - ; - - r_dot_indexable_expr [DotAccessDescT* aD] returns [BaseGDL* res] // 1st -@@ -2679,95 +2721,18 @@ - { - BaseGDL* r; - ArrayIndexListT* aL; -- ArrayIndexListGuard guard; - } - // NOTE: r is owned by aD or a l_... (r must not be deleted here) - : #(ARRAYEXPR r=r_dot_indexable_expr[ aD] -- aL=arrayindex_list { guard.reset(aL);} ) -+ aL=arrayindex_list /*{ guard.reset(aL);}*/ ) - { - // check here for object and get struct -- if( r->Type() != GDL_STRUCT) -- { -- // if( r->Type() != GDL_OBJ) -- // { -- // // check for Get/SetProperty -- // throw GDLException( _t, "Expression must be a" -- // " STRUCT in this context: "+ -- // Name(r),true,false); -- // } -- bool isObj = callStack.back()->IsObject(); -- if( isObj) -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( r, _t); -- --// DStructGDL* obj = oStruct->Index( aL); -- -- if( aD->IsOwner()) delete r; -- aD->SetOwner( false); // object struct, not owned -- -- aD->ADRoot( oStruct, guard.release()); --// aD->ADRoot( obj); -- --// BaseGDL* obj = r->Index( aL); --// auto_ptr objGuard( obj); // new object -> guard -- --// DStructGDL* oStruct = ObjectStructCheckAccess( obj, _t); -- --// // oStruct cannot be "Assoc_" --// if( aD->IsOwner()) delete r; --// aD->SetOwner( false); // object structs are never owned --// aD->ADRoot( oStruct); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(r),true,false); -- } -- } -- else -- { -- if( r->IsAssoc()) -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(r),true,false); -- -- DStructGDL* structR=static_cast(r); -- aD->ADRoot( structR, guard.release()); -- } -+ SetRootR( _t, aD, r, aL); - } - | r=r_dot_indexable_expr[ aD] - { - // check here for object and get struct -- // structR = dynamic_cast(r); -- // if( structR == NULL) -- if( r->Type() != GDL_STRUCT) -- { -- bool isObj = callStack.back()->IsObject(); -- if( isObj) // member access to object? -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( r, _t); -- -- // oStruct cannot be "Assoc_" -- if( aD->IsOwner()) delete r; -- aD->SetOwner( false); // object structs are never owned -- aD->ADRoot( oStruct); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(r),true,false); -- } -- } -- else -- { -- if( r->IsAssoc()) -- { -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(r),true,false); -- } -- -- DStructGDL* structR=static_cast(r); -- aD->ADRoot(structR); -- } -+ SetRootR( _t, aD, r, NULL); - } - ; - -@@ -3187,7 +3152,7 @@ - self=expr mp2:IDENTIFIER - - { -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - try { - newEnv=new EnvUDT( self, mp2, "", true); -@@ -3218,10 +3183,10 @@ - #(dot:DOT // struct assignment - { - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - } -- l_dot_array_expr[ aD.get()] -- (tag_array_expr[ aD.get()] /* nDot times*/ )+ -+ l_dot_array_expr[ aD.Get()] -+ (tag_array_expr[ aD.Get()] /* nDot times*/ )+ - ) - { - if( right == NULL) -@@ -3229,7 +3194,7 @@ - "Struct expression not allowed in this context.", - true,false); - -- aD->ADAssign( right); -+ aD.Get()->ADAssign( right); - - res=NULL; - -@@ -3245,10 +3210,10 @@ - #(dot:DOT // struct assignment - { - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - } -- l_dot_array_expr[ aD.get()] -- (tag_array_expr[ aD.get()] /* nDot times*/ )+ -+ l_dot_array_expr[ aD.Get()] -+ (tag_array_expr[ aD.Get()] /* nDot times*/ )+ - ) - ) - { -@@ -3257,7 +3222,7 @@ - "Struct expression not allowed in this context.", - true,false); - -- aD->ADAssign( right); -+ aD.Get()->ADAssign( right); - - res=NULL; - } -@@ -3278,7 +3243,7 @@ - - self=expr mp2:IDENTIFIER - { -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - newEnv=new EnvUDT( self, mp2, "", true); - -@@ -3332,7 +3297,7 @@ - // needed because N_ELEMENTS must handle undefined variables different - parameter_def_n_elements [EnvBaseT* actEnv] - { -- auto_ptr guard(actEnv); -+ Guard guard(actEnv); - _retTree = _t; - // bool interruptEnableIn = interruptEnable; - if( _retTree != NULL) -@@ -3403,7 +3368,7 @@ - parameter_def [EnvBaseT* actEnv] - { - // as actEnv is not on the stack guard it here -- auto_ptr guard(actEnv); -+ Guard guard(actEnv); - - EnvBaseT* callerEnv = callStack.back(); - EnvBaseT* oldNewEnv = callerEnv->GetNewEnv(); -@@ -3468,7 +3433,7 @@ - // for library subroutines, their number of parameters is already checked in the compiler - parameter_def_nocheck [EnvBaseT* actEnv] - { -- auto_ptr guard(actEnv); -+ Guard guard(actEnv); - - EnvBaseT* callerEnv = callStack.back(); - EnvBaseT* oldNewEnv = callerEnv->GetNewEnv(); -@@ -3512,7 +3477,7 @@ - - arrayindex_list returns [ArrayIndexListT* aL] - { -- IxExprListT cleanupList; // for cleanup -+ // IxExprListT cleanupList; // for cleanup - IxExprListT ixExprList; - SizeT nExpr; - BaseGDL* s; -@@ -3522,9 +3487,9 @@ - // match(antlr::RefAST(_t),ARRAYIX); - _t = _t->getFirstChild(); - -- aL = ax->arrIxList; -+ aL = ax->arrIxList; // vs. ax->arrIxListNoAssoc - assert( aL != NULL); -- -+ - nExpr = aL->NParam(); - if( nExpr == 0) - { -@@ -3534,6 +3499,8 @@ - } - - while( true) { -+ IxExprListT* cleanupList = aL->GetCleanupIx(); // for cleanup -+ - assert( _t != NULL); - if( NonCopyNode( _t->getType())) - { -@@ -3545,13 +3512,13 @@ - s=lib_function_call(_t); - //_t = _retTree; - if( !callStack.back()->Contains( s)) -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - else - { - s=_t->Eval(); //indexable_tmp_expr(_t); - //_t = _retTree; -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - - assert( s != NULL); -@@ -3562,7 +3529,7 @@ - _t = _t->getNextSibling(); - } - -- aL->Init( ixExprList, &cleanupList); -+ aL->Init( ixExprList);//, &cleanupList); - - _retTree = ax->getNextSibling();//retTree; - return aL; -@@ -3576,7 +3543,7 @@ - )* - ) - ; -- -+/* - arrayindex_list_noassoc returns [ArrayIndexListT* aL] - { - IxExprListT cleanupList; // for cleanup -@@ -3642,12 +3609,12 @@ - )* - ) - ; -- -+*/ - // for _overloadBracketsLeftSide/_overloadBracketsRightSide - arrayindex_list_overload [IxExprListT& indexList] - { - ArrayIndexListT* aL; -- IxExprListT cleanupList; // for cleanup -+ // IxExprListT cleanupList; // for cleanup - IxExprListT ixExprList; - SizeT nExpr; - BaseGDL* s; -@@ -3659,15 +3626,17 @@ - - aL = ax->arrIxListNoAssoc; - assert( aL != NULL); -- -+ - nExpr = aL->NParam(); - if( nExpr == 0) - { -- aL->InitAsOverloadIndex( ixExprList, NULL, indexList); -+ aL->InitAsOverloadIndex( ixExprList, /* NULL,*/ indexList); - _retTree = ax->getNextSibling();//retTree; - return; - } - -+ IxExprListT* cleanupList = aL->GetCleanupIx(); -+ - while( true) { - assert( _t != NULL); - if( NonCopyNode( _t->getType())) -@@ -3677,16 +3646,17 @@ - } - else if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- s=lib_function_call(_t); -+ // s=lib_function_call(_t); -+ s = static_cast(_t)->EvalFCALL_LIB(); - //_t = _retTree; - if( !callStack.back()->Contains( s)) -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - else - { - s=_t->Eval(); //indexable_tmp_expr(_t); - //_t = _retTree; -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - - ixExprList.push_back( s); -@@ -3696,7 +3666,7 @@ - _t = _t->getNextSibling(); - } - -- aL->InitAsOverloadIndex( ixExprList, &cleanupList, indexList); -+ aL->InitAsOverloadIndex( ixExprList, /*&cleanupList,*/ indexList); - - _retTree = ax->getNextSibling();//retTree; - return; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdl.cpp gdl/src/gdl.cpp ---- gdl-0.9.3/src/gdl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdl.cpp 2013-07-08 12:39:21.906392994 -0600 -@@ -43,6 +43,10 @@ - #include "sigfpehandler.hpp" - #include "gdleventhandler.hpp" - -+#ifdef _OPENMP -+#include -+#endif -+ - #ifdef USE_MPI - # include "mpi.h" - #endif -@@ -70,6 +74,32 @@ - void SetGDLGenericGSLErrorHandler(); // defined in gsl_fun.cpp - } - -+// Nodar and Alain, May 2013: we try to optimize the value for CpuTPOOL_NTHREADS -+// if *valid* external value for OMP_NUM_THREADS (0 < OMP_NUM_THREADS < nb_cores) we used it -+// if not provided, we try to estimate a value looking at the average load -+ -+void InitOpenMP() { -+#ifdef _OPENMP -+ int suggested_num_threads, omp_num_core; -+ suggested_num_threads=get_suggested_omp_num_threads(); -+ omp_num_core=omp_get_num_procs(); -+ -+ // cout << "estimated Threads :" << suggested_num_threads << endl; -+ -+ // we update iff needed (by default, "omp_num_threads" is initialiazed to "omp_num_core" -+ if ((suggested_num_threads > 0) && (suggested_num_threads < omp_num_core)) { -+ -+ // update of !cpu.TPOOL_NTHREADS -+ DStructGDL* cpu = SysVar::Cpu(); -+ static unsigned NTHREADSTag = cpu->Desc()->TagIndex( "TPOOL_NTHREADS"); -+ (*static_cast( cpu->GetTag( NTHREADSTag, 0)))[0] =suggested_num_threads; -+ -+ // effective gloabl change of num of treads using omp_set_num_threads() -+ omp_set_num_threads(suggested_num_threads); -+ } -+#endif -+} -+ - void AtExit() - { - // cerr << "AtExit()" << endl; -@@ -77,6 +107,8 @@ - // clean up everything - // (for debugging memory leaks) - ResetObjects(); -+ PurgeContainer(libFunList); -+ PurgeContainer(libProList); - } - - void InitGDL() -@@ -238,6 +270,9 @@ - - InitGDL(); - -+ // must be after !cpu initialisation -+ InitOpenMP(); -+ - if( isatty(0) && !quiet) StartupMessage(); - - // instantiate the interpreter -Only in gdl-0.9.3/src: gdlc.tree.g.ARRAYEXPR_FN -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlexception.cpp gdl/src/gdlexception.cpp ---- gdl-0.9.3/src/gdlexception.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlexception.cpp 2013-07-08 12:39:21.915392887 -0600 -@@ -37,12 +37,41 @@ - return ""; - } - -+GDLException::GDLException(DLong eC, const string& s, bool pre, bool decorate): -+ ANTLRException(s), -+ errorNode(static_cast(antlr::nullAST)), -+ errorNodeP( NULL), -+ errorCode(eC), -+ line( 0), col( 0), prefix( pre), -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) -+{ -+if(decorate && interpreter!=NULL && interpreter->CallStack().size()>0) -+{ -+ EnvBaseT* e = interpreter->CallStack().back(); -+ errorNodeP = e->CallingNode(); -+ msg = e->GetProName(); -+ if( msg != "$MAIN$") msg += ": "+ s; else msg = s; -+} -+else -+{ -+ msg = s; -+} -+ // note: This is for cases, when form a destructor is thrown -+ // in these cases, program aborts -+#ifdef GDL_DEBUG -+ cerr << s << endl; -+#endif -+} - GDLException::GDLException(const string& s, bool pre, bool decorate): - ANTLRException(s), - errorNode(static_cast(antlr::nullAST)), - errorNodeP( NULL), -+ errorCode(-1), - line( 0), col( 0), prefix( pre), -- targetEnv( NULL) -+ ioException( false), -+ targetEnv( NULL) - { - if(decorate && interpreter!=NULL && interpreter->CallStack().size()>0) - { -@@ -66,8 +95,36 @@ - ANTLRException(s), - errorNode(eN), - errorNodeP( NULL), -+ errorCode(-1), - line( 0), col( 0), prefix( true), -- targetEnv( NULL) -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) -+{ -+if(interpreter!=NULL && interpreter->CallStack().size()>0) -+{ -+ EnvBaseT* e = interpreter->CallStack().back(); -+ errorNodeP = e->CallingNode(); -+ msg = e->GetProName(); -+ if( msg != "$MAIN$") msg += ": "+ s; else msg = s; -+} -+else -+{ -+ msg = s; -+} -+#ifdef GDL_DEBUG -+ cerr << s << endl; -+#endif -+} -+GDLException::GDLException(DLong eC, const RefDNode eN, const string& s): -+ ANTLRException(s), -+ errorNode(eN), -+ errorNodeP( NULL), -+ errorCode(eC), -+ line( 0), col( 0), prefix( true), -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) - { - if(interpreter!=NULL && interpreter->CallStack().size()>0) - { -@@ -89,8 +146,11 @@ - ANTLRException(s), - errorNode(static_cast(antlr::nullAST)), - errorNodeP( eN), -+ errorCode(-1), - line( 0), col( 0), prefix( true), -- targetEnv( NULL) -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) - { - if( overWriteNode && interpreter!=NULL && interpreter->CallStack().size()>0) - { -@@ -111,25 +171,81 @@ - cerr << s << endl; - #endif - } -+GDLException::GDLException(DLong eC, const ProgNodeP eN, const string& s, bool decorate, bool overWriteNode): -+ ANTLRException(s), -+ errorNode(static_cast(antlr::nullAST)), -+ errorNodeP( eN), -+ errorCode(eC), -+ line( 0), col( 0), prefix( true), -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) -+{ -+ if( overWriteNode && interpreter!=NULL && interpreter->CallStack().size()>0) -+ { -+ EnvBaseT* e = interpreter->CallStack().back(); -+ errorNodeP = e->CallingNode(); -+ } -+ if( decorate && interpreter!=NULL && interpreter->CallStack().size()>0) -+ { -+ EnvBaseT* e = interpreter->CallStack().back(); -+ msg = e->GetProName(); -+ if( msg != "$MAIN$") msg += ": "+ s; else msg = s; -+ } -+ else -+ { -+ msg = s; -+ } -+#ifdef GDL_DEBUG -+ cerr << s << endl; -+#endif -+} - - GDLException::GDLException(SizeT l, SizeT c, const string& s): - ANTLRException(s), - errorNode(static_cast(antlr::nullAST)), - errorNodeP( NULL), -+ errorCode(-1), - line( l), col( c), prefix( true), -- targetEnv( NULL) --{ --if(interpreter!=NULL && interpreter->CallStack().size()>0) -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) - { -- EnvBaseT* e = interpreter->CallStack().back(); -- errorNodeP = e->CallingNode(); -- msg = e->GetProName(); -- if( msg != "$MAIN$") msg += ": "+ s; else msg = s; -+ if(interpreter!=NULL && interpreter->CallStack().size()>0) -+ { -+ EnvBaseT* e = interpreter->CallStack().back(); -+ errorNodeP = e->CallingNode(); -+ msg = e->GetProName(); -+ if( msg != "$MAIN$") msg += ": "+ s; else msg = s; -+ } -+ else -+ { -+ msg = s; -+ } -+#ifdef GDL_DEBUG -+ cerr << s << endl; -+#endif - } --else -+GDLException::GDLException(DLong eC, SizeT l, SizeT c, const string& s): -+ ANTLRException(s), -+ errorNode(static_cast(antlr::nullAST)), -+ errorNodeP( NULL), -+ errorCode(eC), -+ line( l), col( c), prefix( true), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) - { -- msg = s; --} -+ if(interpreter!=NULL && interpreter->CallStack().size()>0) -+ { -+ EnvBaseT* e = interpreter->CallStack().back(); -+ errorNodeP = e->CallingNode(); -+ msg = e->GetProName(); -+ if( msg != "$MAIN$") msg += ": "+ s; else msg = s; -+ } -+ else -+ { -+ msg = s; -+ } - #ifdef GDL_DEBUG - cerr << s << endl; - #endif -@@ -157,7 +273,9 @@ - - void WarnAboutObsoleteRoutine(const string& name) - { -- static DStructGDL* warnStruct = SysVar::Warn(); -+ // no static here due to .RESET_SESSION -+ DStructGDL* warnStruct = SysVar::Warn(); -+ // this static is ok as it will evaluate always to the same value - static unsigned obs_routinesTag = warnStruct->Desc()->TagIndex( "OBS_ROUTINES"); - if (((static_cast( warnStruct->GetTag(obs_routinesTag, 0)))[0]).LogTrue()) - Message("Routine compiled from an obsolete library: " + name); -@@ -167,15 +285,17 @@ - void WarnAboutObsoleteRoutine(const RefDNode eN, const string& name) - { - // TODO: journal? -- static DStructGDL* warnStruct = SysVar::Warn(); -+ // no static here due to .RESET_SESSION -+ DStructGDL* warnStruct = SysVar::Warn(); -+ // this static is ok as it will evaluate always to the same value - static unsigned obs_routinesTag = warnStruct->Desc()->TagIndex( "OBS_ROUTINES"); - if (((static_cast( warnStruct->GetTag(obs_routinesTag, 0)))[0]).LogTrue()) - { - GDLException* e = new GDLException(eN, - "Routine compiled from an obsolete library: " + name -- ); -+ ); -+ Guard eGuard(e); - GDLInterpreter::ReportCompileError(*e, ""); --// TODO: file /\ -- delete e; -+// TODO: file - } - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlexception.hpp gdl/src/gdlexception.hpp ---- gdl-0.9.3/src/gdlexception.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlexception.hpp 2013-07-08 12:39:21.917392863 -0600 -@@ -33,14 +33,21 @@ - { - static DInterpreter* interpreter; - --std::string msg; -+ std::string msg; - - RefDNode errorNode; - ProgNodeP errorNodeP; -+ DLong errorCode; - SizeT line; - SizeT col; - bool prefix; -- -+ -+ bool arrayexprIndexeeFailed; -+ -+protected: -+ bool ioException; -+ -+private: - EnvUDT* targetEnv; // where to stop (depending on ON_ERROR) - - public: -@@ -51,24 +58,45 @@ - - void SetErrorNodeP( ProgNodeP p) { errorNodeP = p;} - -+ bool GetArrayexprIndexeeFailed() const { return arrayexprIndexeeFailed;} -+ void SetArrayexprIndexeeFailed( bool b) { arrayexprIndexeeFailed = b;} -+ - GDLException(): ANTLRException(), - errorNode(static_cast(antlr::nullAST)), - errorNodeP( NULL), -+ errorCode(-1), - line( 0), col( 0), prefix( true), -- targetEnv( NULL) -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) -+ {} -+ GDLException( DLong eC): ANTLRException(), -+ errorNode(static_cast(antlr::nullAST)), -+ errorNodeP( NULL), -+ errorCode(eC), -+ line( 0), col( 0), prefix( true), -+ ioException( false), -+ targetEnv( NULL), -+ arrayexprIndexeeFailed(false) - {} - GDLException(const std::string& s, bool pre = true, bool decorate=true); - GDLException(const RefDNode eN, const std::string& s); - GDLException(const ProgNodeP eN, const std::string& s, bool decorate=true, bool overWriteNode=true); - GDLException(SizeT l, SizeT c, const std::string& s); - -- ~GDLException() throw() {} -+ GDLException(DLong eC, const std::string& s, bool pre = true, bool decorate=true); -+ GDLException(DLong eC, const RefDNode eN, const std::string& s); -+ GDLException(DLong eC, const ProgNodeP eN, const std::string& s, bool decorate=true, bool overWriteNode=true); -+ GDLException(DLong eC, SizeT l, SizeT c, const std::string& s); - --std::string toString() const -- { -- return msg; -- } -+ ~GDLException() throw() {} - -+ DLong ErrorCode() const { return errorCode;} -+ -+ std::string toString() const -+ { -+ return msg; -+ } - - SizeT getLine() const - { -@@ -104,6 +132,8 @@ - { - return targetEnv; - } -+ -+ bool IsIOException() const { return ioException;} - }; - - // for ON_IOERROR -@@ -112,16 +142,27 @@ - public: - GDLIOException(): - GDLException() -- {} -+ { ioException = true;} - - GDLIOException(const std::string& s, bool pre = true): - GDLException( s, pre) -- {} -+ { ioException = true;} - - GDLIOException(const ProgNodeP eN, const std::string& s): - GDLException( eN, s) -- {} -+ { ioException = true;} - -+ GDLIOException(DLong eC): -+ GDLException(eC) -+ { ioException = true;} -+ -+ GDLIOException(DLong eC,const std::string& s, bool pre = true): -+ GDLException( eC, s, pre) -+ { ioException = true;} -+ -+ GDLIOException(DLong eC,const ProgNodeP eN, const std::string& s): -+ GDLException( eC, eN, s) -+ { ioException = true;} - }; - - // warnings ignore !QUIET -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlgstream.cpp gdl/src/gdlgstream.cpp ---- gdl-0.9.3/src/gdlgstream.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlgstream.cpp 2013-07-08 12:39:21.919392840 -0600 -@@ -103,12 +103,15 @@ - SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("NAME"), 0) - ))[0]; - -- if (name == "X") plstream::schr( 1.5, 1.0); -- else if (name == "PS") plstream::schr( 3.5, 1.0); -- else plstream::schr( 0, 1.0); -+ if (name == "PS" || name=="SVG") schr( 3.5, 1.0); -+ else schr(1.5, 1.0); -+ (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("X_CH_SIZE"), 0)))[0]= -+ theCurrentChar.dsx; -+ (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("Y_CH_SIZE"), 0)))[0]= -+ theCurrentChar.dsy; - } - --void GDLGStream::NextPlot( bool erase) -+void GDLGStream::NextPlot( bool erase ) - { - DLongGDL* pMulti = SysVar::GetPMulti(); - -@@ -121,69 +124,97 @@ - nx = (nx>0)?nx:1; - ny = (ny>0)?ny:1; - nz = (nz>0)?nz:1; -- -- plstream::ssub( nx, ny); // changes charsize -- -- if( (*pMulti)[ 0] <= 0 || (*pMulti)[ 0] == nx*ny) -- // if( (*pMulti)[ 0] <= 0) -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"NextPlot(erase=%d)\n",erase); -+ // set subpage numbers in X and Y -+// plstream::ssub( nx, ny ); // ssub does not change charsize it seems -+ ssub( nx, ny ); -+ DLong pMod = (*pMulti)[0] % (nx*ny); -+ -+// if( (*pMulti)[0] <= 0 || (*pMulti)[0] == nx*ny) // clear and restart to first subpage -+ if( pMod == 0 ) // clear and restart to first subpage -+ { -+ if( erase ) - { -- if( erase) -- { -- eop(); // overridden (for Z-buffer) -- plstream::bop(); // changes charsize -- } -- -- plstream::adv(1); -- (*pMulti)[ 0] = nx*ny*nz-1; -+ eop(); // overridden (for Z-buffer) -+ plstream::bop(); // changes charsize - } -+ -+// plstream::adv(1); //advance to first subpage -+ adv(1); //advance to first subpage -+ (*pMulti)[0] = nx*ny*nz-1; //set PMULTI[0] to this page -+ } - else -+ { -+ if( dir == 0 ) - { -- DLong pMod = (*pMulti)[ 0] % (nx*ny); -- if( dir == 0) -- { -- plstream::adv(nx*ny - pMod + 1); -- } -- else -- { -- int p = nx*ny - pMod; -- int pp = p*nx % (nx*ny) + p/ny + 1; -- plstream::adv(pp); -- } -- -- if( erase) -- { -- --(*pMulti)[ 0]; -- } -+// plstream::adv(nx*ny - pMod + 1); -+ adv(nx*ny - pMod + 1); - } -- -- // restore charsize -- DefaultCharSize(); -+ else -+ { -+ int p = nx*ny - pMod; -+ int pp = p*nx % (nx*ny) + p/ny + 1; -+// plstream::adv(pp); -+ adv(pp); -+ } -+ if( erase ) -+ { -+ --(*pMulti)[0]; -+ } -+ } -+ // restore charsize to default for newpage -+ sizeChar(1.0); - } - - void GDLGStream::NoSub() - { -- plstream::ssub( 1, 1); // changes charsize -- plstream::adv( 0); -- DefaultCharSize(); -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"NoSub()\n"); -+ ssub( 1, 1); // changes charsize ? -+//plstream::adv( 0); -+ adv( 0); -+// DefaultCharSize(); - } - --// default is a wrapper for gpage() -+// default is a wrapper for gpage(). Is overriden by, e.g., X driver. - void GDLGStream::GetGeometry( long& xSize, long& ySize, long& xoff, long& yoff) - { -- -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"GDLGStream::GetGeometry()\n"); - PLFLT xp; PLFLT yp; - PLINT xleng; PLINT yleng; - PLINT plxoff; PLINT plyoff; -- gpage( xp, yp, xleng, yleng, plxoff, plyoff); -+ plstream::gpage( xp, yp, xleng, yleng, plxoff, plyoff); //for X-Window, wrapper give sizes from X11, not plplot which seems bugged. - -- xSize = xleng; -- ySize = yleng; -- xoff = plxoff; -- yoff = plyoff; -+//since the page sizes for PS and EPS images are processed by GDL after plplot finishes -+//its work, gpage will not output correct sizes -+ DString name = (*static_cast( -+ SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("NAME"), 0) -+ ))[0]; -+ if (name == "PS") { -+ xSize = (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("X_SIZE"), 0)))[0]; -+ ySize = (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("Y_SIZE"), 0)))[0]; -+ xoff = 0; -+ yoff = 0; -+ } else { -+ xSize = xleng; -+ ySize = yleng; -+ xoff = plxoff; -+ yoff = plyoff; -+ } -+ if (xSize<1.0||ySize<1) //plplot gives back crazy values! z-buffer for example! -+ { -+ PLFLT xmin,xmax,ymin,ymax; -+ plstream::gspa(xmin,xmax,ymin,ymax); //subpage in mm -+ xSize=min(1.0,xmax-xmin); -+ ySize=min(1.0,ymax-ymin); -+ xoff=0.0; -+ yoff=0.0; -+ } -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," found (%ld %ld %ld %ld)\n", xSize, ySize, xoff, yoff); -+ - } - - // SA: embedded font attributes handling (IDL to plPlot syntax translation) --const char * GDLGStream::TranslateFormatCodes(const char *in) -+bool GDLGStream::TranslateFormatCodes(const char *in, std::string & out) - { - bool debug = false; - static char errmsg[] = "Invalid graphtext command: ...! "; -@@ -199,7 +230,7 @@ - size_t len = strlen(in); - - // skip conversion if the string is empty -- if (len == 0) return in; -+ if (len == 0) return false; - - const std::string fonts[] = { - "#fn", // !0 : unused -@@ -240,7 +271,7 @@ - int curr_lev = 0; // (incremented with #u, decremented with #d) - int curr_pos = 0; // (current position in string) - int save_pos = 0; // (position in string used in !S/!R save/restore) -- std::string out = std::string(""); -+// std::string out = std::string(""); - - for (size_t i = 0; i < len; i++) { - if (in[i] == '!' && in[i + 1] != '!') -@@ -746,17 +777,90 @@ - - retrn: - if (debug) cout << "GDLGStream::TranslateFormatCodes(\"" << in << "\") = \"" << out << "\"" << endl; -- return out.c_str(); -+ return true; - } - - void GDLGStream::mtex( const char *side, PLFLT disp, PLFLT pos, PLFLT just, - const char *text) - { -- plstream::mtex(side,disp,pos,just,TranslateFormatCodes(text)); -+ std::string out = std::string(""); -+ if (TranslateFormatCodes(text,out)) plstream::mtex(side,disp,pos,just,out.c_str()); - } - - void GDLGStream::ptex( PLFLT x, PLFLT y, PLFLT dx, PLFLT dy, PLFLT just, - const char *text) - { -- plptex(x,y,dx,dy,just,TranslateFormatCodes(text)); -+ std::string out = std::string(""); -+ if (TranslateFormatCodes(text,out)) plstream::ptex(x,y,dx,dy,just,out.c_str()); -+} -+ -+void GDLGStream::schr( PLFLT def, PLFLT scale ) -+{ -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"schr(%f,%f)\n",def,scale); -+ plstream::schr(def, scale); -+ CurrentCharSize(scale); -+} -+ -+void GDLGStream::sizeChar( PLFLT scale ) -+{ -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"SizeChar(%f)\n",scale); -+ plstream::schr(theDefaultChar.mmsy, scale); -+// plstream::schr(0, scale); -+ CurrentCharSize(scale); -+} -+ -+void GDLGStream::vpor(PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax ) -+{ -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"vpor(): requesting x[%f:%f],y[%f:%f] (normalized, subpage)\n",xmin,xmax,ymin,ymax); -+ plstream::vpor(xmin, xmax, ymin, ymax); -+ theBox.nx1=xmin; -+ theBox.nx2=xmax; -+ theBox.ny1=ymin; -+ theBox.ny2=ymax; -+ PLFLT x1,x2,y1,y2; -+ plstream::gvpd(x1,x2,y1,y2); //retrieve NORMALIZED DEVICE coordinates of viewport -+ theBox.ndx1=x1; -+ theBox.ndx2=x2; -+ theBox.ndy1=y1; -+ theBox.ndy2=y2; -+ theBox.ondx=x1; -+ theBox.ondy=y1; -+ theBox.sndx=x2-x1; -+ theBox.sndy=y2-y1; -+ -+ theBox.initialized=true; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"vpor(): got x[%f:%f],x[%f:%f] (normalized, device)\n",theBox.ndx1,theBox.ndx2,theBox.ndy1,theBox.ndy2); -+ syncPageInfo(); -+} -+ -+void GDLGStream::wind( PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax ) -+{ -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"wind(): setting x[%f:%f],y[%f:%f] (world) \n",xmin,xmax,ymin,ymax); -+ plstream::wind(xmin, xmax, ymin, ymax); -+ theBox.wx1=xmin; -+ theBox.wx2=xmax; -+ theBox.wy1=ymin; -+ theBox.wy2=ymax; -+ updateBoxDeviceCoords(); -+ UpdateCurrentCharWorldSize(); -+} -+ -+void GDLGStream::ssub(PLINT nx, PLINT ny) -+{ -+ plstream::ssub( nx, ny ); // does not appear to change charsize. -+ // set subpage numbers in X and Y -+ thePage.nbPages=nx*ny; -+ thePage.nx=nx; -+ thePage.ny=ny; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"ssub() %dx%d pages\n",nx,ny); -+ thePage.curPage=1; -+ syncPageInfo(); -+} -+ -+void GDLGStream::adv(PLINT page) -+{ -+ plstream::adv(page); -+ if (page==0) {thePage.curPage++;} else {thePage.curPage=page;} -+ if (thePage.curPage > thePage.nbPages) thePage.curPage=1; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"adv() now at page %d\n",thePage.curPage); - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlgstream.hpp gdl/src/gdlgstream.hpp ---- gdl-0.9.3/src/gdlgstream.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlgstream.hpp 2013-08-04 20:25:18.830700051 -0600 -@@ -18,6 +18,9 @@ - #ifndef GDLGSTREAM_HPP_ - #define GDLGSTREAM_HPP_ - -+//debug aid. Put to 1 to debug -+#define GDL_DEBUG_PLSTREAM 0 -+ - #include - #include - #ifndef HAVE_X -@@ -25,6 +28,9 @@ - # include - #endif - #include -+#if PLPLOT_PRIVATE_NOT_HIDDEN -+#include -+#endif - #include - #include - #include "typedefs.hpp" -@@ -34,21 +40,124 @@ - #include - #endif - -+#define MMTOINCH 0.03937 -+ - using namespace std; - -+// Graphic Structures: -+ typedef struct _P_GRAPHICS { -+ DLong background; -+ DFloat charSize; -+ DFloat charThick; -+ DLong clip[6]; -+ DLong color; -+ DLong font; -+ DLong lineStyle; -+ DLong multi[5]; -+ DLong noClip; -+ DLong noErase; -+ DLong nsum; -+ DFloat position[4]; -+ DLong psym; -+ DFloat region[4]; -+ DString subTitle; -+ DFloat symSize; -+ DDouble t[4][4]; -+ DLong t3d; -+ DFloat thick; -+ DString title; -+ DFloat ticklen; -+ DLong channel; -+ } pstruct ; -+ -+ typedef struct GDL_BOX { -+ bool initialized; -+ PLFLT wx1; //world coord of x min -+ PLFLT wx2; -+ PLFLT wy1; -+ PLFLT wy2; -+ PLFLT nx1; //normalized position in subpage -+ PLFLT nx2; -+ PLFLT ny1; -+ PLFLT ny2; -+ PLFLT ndx1; //normalized device position -+ PLFLT ndx2; -+ PLFLT ndy1; -+ PLFLT ndy2; -+ PLFLT ondx; //offset x of box in device coords -+ PLFLT ondy; // in y -+ PLFLT sndx; //size of box, x , device -+ PLFLT sndy; -+ PLFLT dx1; //position in device coords (e.g. pixels) -+ PLFLT dx2; -+ PLFLT dy1; -+ PLFLT dy2; -+ PLFLT pageWorldCoordinates[4]; -+ PLFLT subPageWorldCoordinates[4]; -+ } gdlbox ; -+ -+ typedef struct GDL_SUBPAGE { -+ PLFLT dxsize; //subpage x size device units -+ PLFLT dysize; //subpage y size device units -+ PLFLT dxoff; // subpage x offset -+ PLFLT dyoff; // subpage y offset -+ } gdlsubpage ; -+ -+ typedef struct GDL_PAGE { -+ PLFLT xdpmm; // x resolution Dots per mm -+ PLFLT ydpmm; // y resolution Dots per mm -+ PLFLT length; //x length (device coordinates) -+ PLFLT height; //y lenght -+ PLFLT plxoff; // x offset -+ PLFLT plyoff; // y iffset -+ PLFLT xsizemm; // size in mm, x -+ PLFLT ysizemm; -+ PLINT curPage; //current Page -+ PLINT nbPages; //nx*ny -+ PLINT nx; -+ PLINT ny; -+ gdlsubpage subpage; -+ } gdlpage ; -+ -+ typedef struct GDL_CHARINFO { -+ PLFLT scale; -+ PLFLT ndsx; // size of char in normalized device units, x direction -+ PLFLT ndsy; // idem y -+ PLFLT dsx; // size of char in device units, x direction -+ PLFLT dsy; // idem y -+ DDouble mmsx; //in mm -+ DDouble mmsy; // -+ PLFLT wsx; //in current world coordinates -+ PLFLT wsy; -+ } gdlCharInfo; -+ - class GDLGStream: public plstream - { - void init(); // prevent plstream::init from being called directly -- -+private: -+ gdlpage pageLayout; -+ gdlbox boxLayout; -+ - protected: - bool valid; -+ gdlCharInfo theCurrentChar; -+ gdlCharInfo theDefaultChar; -+ int gdlDefaultCharInitialized; -+ gdlbox theBox; -+ gdlpage thePage; -+ PLStream* Mypls; - - public: -- GDLGStream( int nx, int ny, const char *driver, const char *file=NULL) -+ -+ GDLGStream( int nx, int ny, const char *driver, const char *file=NULL) - : plstream( nx, ny, driver, file), valid( true) - { - if (!checkPlplotDriver(driver)) - ThrowGDLException(std::string("PLplot installation lacks the requested driver: ") + driver); -+ gdlDefaultCharInitialized=0; -+ thePage.nbPages=0; -+ theBox.initialized=false; -+ plgpls( &Mypls); - } - - virtual ~GDLGStream() -@@ -117,16 +226,432 @@ - virtual void GetGeometry( long& xSize, long& ySize, long& xoff, long& yoff); - - virtual void eop() { plstream::eop();} -- -+ virtual void setDoubleBuffering() {} -+ virtual void unSetDoubleBuffering() {} -+ virtual bool hasDoubleBuffering() {return false;} - virtual void Raise() {} - virtual void Lower() {} - virtual void Iconic() {} - virtual void DeIconic() {} -+ virtual bool GetGin(PLGraphicsIn *gin, int mode) {return 0;} -+ virtual void WarpPointer(DLong x, DLong y){} -+ virtual void Flush() {} - virtual void Clear() {} - virtual void Clear( DLong bColor) {} - - bool Valid() { return valid;} -+ bool validWorldBox() -+ { -+ if( theBox.wx1==0&&theBox.wx2==0 || theBox.wy1==0&&theBox.wy2==0 ) return false; else return true; -+ } -+ bool validNormdBox() -+ { -+ if( theBox.nx1==0&&theBox.nx2==0 || theBox.ny1==0&&theBox.ny2==0 ) return false; else return true; -+ } -+ inline PLFLT charScale(){return theCurrentChar.scale;} -+ inline PLFLT nCharLength(){return theCurrentChar.ndsx;} -+ inline PLFLT nCharHeight(){return theCurrentChar.ndsy;} -+ inline PLFLT dCharLength(){return theCurrentChar.dsx;} -+ inline PLFLT dCharHeight(){return theCurrentChar.dsy;} -+ inline PLFLT wCharLength(){return theCurrentChar.wsx;} -+ inline PLFLT wCharHeight(){return theCurrentChar.wsy;} -+ inline DDouble mmCharLength(){return theCurrentChar.mmsx;} -+ inline DDouble mmCharHeight(){return theCurrentChar.mmsy;} -+ inline PLFLT xResolution(){return thePage.xdpmm;} -+ inline PLFLT yResolution(){return thePage.ydpmm;} -+ inline PLFLT mmxPageSize(){return thePage.xsizemm;} //size in mm -+ inline PLFLT mmyPageSize(){return thePage.ysizemm;} -+ inline PLFLT boxnXSize(){return theBox.sndx;} -+ inline PLFLT boxnYSize(){return theBox.sndy;} -+ inline PLFLT xPageSize(){return thePage.length;} //size in units (alternate:{return Mypls->xlength;}) -+ inline PLFLT yPageSize(){return thePage.height;} //alternate: {return Mypls->ylength;} -+ inline PLFLT xSubPageSize(){return thePage.subpage.dxsize;} //size in units -+ inline PLFLT ySubPageSize(){return thePage.subpage.dysize;} -+ -+ // bunch of conversion functions that should be used in the future now that Mypls is here! -+ // device coords to physical coords (x,y) -+ inline PLFLT d2px(PLFLT x){ return ( Mypls->phyxmi + Mypls->phyxlen * x );} -+ inline PLFLT d2py(PLFLT y){ return ( Mypls->phyymi + Mypls->phyylen * y );} -+ inline void device2physical(PLFLT devx, PLFLT devy, PLFLT &physx, PLFLT &physy) -+ { physx=d2px(devx); physy=d2py(devy);} -+ // device to mm -+ inline PLFLT d2mx(PLFLT x){ return (PLFLT) ( x * ( Mypls->phyxma - Mypls->phyxmi ) / Mypls->xpmm ) ;} -+ inline PLFLT d2my(PLFLT y){ return (PLFLT) ( y * ( Mypls->phyyma - Mypls->phyymi ) / Mypls->ypmm ) ;} -+ inline void device2mm(PLFLT devx, PLFLT devy, PLFLT &mmx, PLFLT &mmy) -+ { mmx=d2mx(devx); mmy=d2my(devy);} -+ //device to world -+ inline PLFLT d2wx(PLFLT x){return (PLFLT) ( (x- Mypls->wdxoff) / Mypls->wdxscl );} -+ inline PLFLT d2wy(PLFLT y){return (PLFLT) ( (y- Mypls->wdyoff) / Mypls->wdyscl );} -+ inline void device2world(PLFLT devx, PLFLT devy, PLFLT &wx, PLFLT &wy) -+ { wx=d2wx(devx); wy=d2wy(devy);} -+ // device coords to subpage coords -+ inline PLFLT d2spx(PLFLT x){ return (PLFLT) ( ( x - Mypls->spdxmi ) / ( Mypls->spdxma - Mypls->spdxmi ) ) ;} -+ inline PLFLT d2spy(PLFLT y){ return (PLFLT) ( ( y - Mypls->spdymi ) / ( Mypls->spdyma - Mypls->spdymi ) ) ;} -+ inline void device2subpage(PLFLT devx, PLFLT devy, PLFLT &spx, PLFLT &spy) -+ { spx=d2spx(devx); spy=d2spy(devy);} -+ -+ // millimeters to physical coords (x,y) -+ inline PLFLT m2px(PLFLT x){ return ( Mypls->phyxmi + Mypls->xpmm * x );} -+ inline PLFLT m2py(PLFLT y){ return ( Mypls->phyymi + Mypls->ypmm * y );} -+ inline void mm2physical(PLFLT mmx, PLFLT mmy, PLFLT &physx, PLFLT &physy) -+ { physx=m2px(mmx); physy=m2py(mmy);} -+ // mm to device -+ inline PLFLT m2dx(PLFLT x){ return (PLFLT) ( ( x * Mypls->xpmm ) / abs( Mypls->phyxma - Mypls->phyxmi ));} -+ inline PLFLT m2dy(PLFLT y){ return (PLFLT) ( ( y * Mypls->ypmm ) / abs( Mypls->phyyma - Mypls->phyymi ));} -+ inline void mm2device(PLFLT mmx, PLFLT mmy, PLFLT &devx, PLFLT &devy) -+ { devx=m2dx(mmx); devy=m2dy(mmy);} -+ // mm to world -+ inline PLFLT m2wx(PLFLT x){ x=m2dx(x); return d2wx(x);} -+ inline PLFLT m2wy(PLFLT y){ y=m2dy(y); return d2wy(y);} -+ inline void mm2world(PLFLT mmx, PLFLT mmy, PLFLT &wx, PLFLT &wy) -+ { wx=m2wx(mmx); wy=m2wy(mmy);} -+ // mm to subpage coord -+ inline PLFLT m2spx(PLFLT x){ x=m2dx(x); return d2spx(x);} -+ inline PLFLT m2spy(PLFLT y){ y=m2dy(y); return d2spy(y);} -+ inline void mm2subpage(PLFLT mmx, PLFLT mmy, PLFLT &spx, PLFLT &spy) -+ { spx=m2spx(mmx); spy=m2spy(mmy);} -+ -+ // world to physical coords -+ inline PLFLT w2px(PLFLT x){ return ( Mypls->wpxoff + Mypls->wpxscl * x );} -+ inline PLFLT w2py(PLFLT y){ return ( Mypls->wpyoff + Mypls->wpyscl * y );} -+ inline void world2physical(PLFLT wx, PLFLT wy, PLFLT &physx, PLFLT &physy) -+ { physx=m2px(wx); physy=m2py(wy);} -+ // world to device -+ inline PLFLT w2dx(PLFLT x){ return (PLFLT) ( Mypls->wdxoff + Mypls->wdxscl * x );} -+ inline PLFLT w2dy(PLFLT y){ return (PLFLT) ( Mypls->wdyoff + Mypls->wdyscl * y );} -+ inline void world2device(PLFLT wx, PLFLT wy, PLFLT &devx, PLFLT &devy) -+ { devx=w2dx(wx); devy=w2dy(wy);} -+ //world to mm -+ inline PLFLT w2mx(PLFLT x){ return (PLFLT) ( Mypls->wmxoff + Mypls->wmxscl * x );} -+ inline PLFLT w2my(PLFLT y){ return (PLFLT) ( Mypls->wmyoff + Mypls->wmyscl * y );} -+ inline void world2mm(PLFLT wx, PLFLT wy, PLFLT &mmx, PLFLT &mmy) -+ { mmx=w2mx(wx); mmy=w2my(wy);} -+ //world to subpage coord -+ inline PLFLT w2spx(PLFLT x){ x=w2dx(x) ; return d2spx(x);} -+ inline PLFLT w2spy(PLFLT y){ y=w2dy(y) ; return d2spy(y);} -+ inline void world2subpage(PLFLT wx, PLFLT wy, PLFLT &spx, PLFLT &spy) -+ { spx=w2spx(wx); spy=w2my(spy);} -+ -+ // physical to device -+ inline PLFLT p2dx(PLFLT x){ return (PLFLT) ( ( x - Mypls->phyxmi ) / (double) Mypls->phyxlen );} -+ inline PLFLT p2dy(PLFLT y){ return (PLFLT) ( ( y - Mypls->phyymi ) / (double) Mypls->phyylen );} -+ inline void physical2device(PLFLT physx, PLFLT physy, PLFLT &devx, PLFLT &devy) -+ { devx=p2dx(physx); devy=p2dy(physy);} -+ //physical to world -+ //physical to mm -+ //physical to subpage coord -+ -+ // subpage coords to device coords -+ inline PLFLT sp2dx(PLFLT x){ return (PLFLT) ( Mypls->spdxmi + ( Mypls->spdxma - Mypls->spdxmi ) * x ) ;} -+ inline PLFLT sp2dy(PLFLT y){ return (PLFLT) ( Mypls->spdymi + ( Mypls->spdyma - Mypls->spdymi ) * y ) ;} -+ inline void subpage2device(PLFLT spx, PLFLT spy, PLFLT &devx, PLFLT &devy) -+ { devx=sp2dx(spx); devy=sp2dy(spy);} -+ //subpage to world -+ //subpage to mm -+ //subpage to physical -+ -+#if PLPLOT_PRIVATE_NOT_HIDDEN -+ //use simple internal function -+ PLFLT gdlGetmmStringLength(const char *string) -+ { -+ return plstrl(string); -+ } -+#else -+#ifdef PLPLOT_HAS_LEGEND -+ //use trick to extract desired value hidden in pllegend! -+ PLFLT gdlGetmmStringLength(const char *string) -+ { -+ if ( Mypls->has_string_length ) -+ { -+ Mypls->get_string_length = 1; -+ c_plmtex( "t", 0.0, 0.0, 0.0, string ); -+ Mypls->get_string_length = 0; -+ return (PLFLT) m2dx(Mypls->string_length); -+ } -+ //else use only possibility without using Private function plstrl(): pllegend! -+ PLFLT text_scale = Mypls->chrht / Mypls->chrdef; -+ PLFLT xwmin_save, xwmax_save, ywmin_save, ywmax_save; -+ plgvpw(&xwmin_save, &xwmax_save, &ywmin_save, &ywmax_save); -+ PLFLT xdmin_save, xdmax_save, ydmin_save, ydmax_save; -+ xdmin_save = ( Mypls->vpdxmi - Mypls->spdxmi ) / ( Mypls->spdxma - Mypls->spdxmi ); -+ xdmax_save = ( Mypls->vpdxma - Mypls->spdxmi ) / ( Mypls->spdxma - Mypls->spdxmi ); -+ ydmin_save = ( Mypls->vpdymi - Mypls->spdymi ) / ( Mypls->spdyma - Mypls->spdymi ); -+ ydmax_save = ( Mypls->vpdyma - Mypls->spdymi ) / ( Mypls->spdyma - Mypls->spdymi ); -+ PLFLT mxmin, mxmax, mymin, mymax; -+ plgspa( &mxmin, &mxmax, &mymin, &mymax ); -+ PLFLT x_subpage_per_mm, y_subpage_per_mm; -+ x_subpage_per_mm = 1. / ( mxmax - mxmin ); -+ y_subpage_per_mm = 1. / ( mymax - mymin ); -+ PLFLT def_mm, charheight_mm; -+ plgchr( &def_mm, &charheight_mm ); -+ PLFLT character_width=charheight_mm/(mymax-mymin ); -+ -+ plvpor( 0., 1., 0., 1. ); -+ plwind( 0., 1., 0., 1. ); -+ PLFLT xdmin_adopted, xdmax_adopted, ydmin_adopted, ydmax_adopted; -+ xdmin_adopted = ( Mypls->vpdxmi - Mypls->spdxmi ) / ( Mypls->spdxma - Mypls->spdxmi ); -+ xdmax_adopted = ( Mypls->vpdxma - Mypls->spdxmi ) / ( Mypls->spdxma - Mypls->spdxmi ); -+ ydmin_adopted = ( Mypls->vpdymi - Mypls->spdymi ) / ( Mypls->spdyma - Mypls->spdymi ); -+ ydmax_adopted = ( Mypls->vpdyma - Mypls->spdymi ) / ( Mypls->spdyma - Mypls->spdymi ); -+// we have all info, give back box values: -+ plvpor( xdmin_save, xdmax_save, ydmin_save, ydmax_save ); -+ plwind( xwmin_save, xwmax_save, ywmin_save, ywmax_save ); -+//call pllegend (outside plot) -+ PLINT opt_array[1]; -+ PLINT text_colors[1]; -+ PLINT line_colors[1]; -+ PLINT line_styles[1]; -+ PLINT line_widths[1]; -+ PLFLT legend_width, legend_height; -+ PLFLT plot_width=1.0; -+ const char *text[1]; -+ opt_array[0] = 0; -+ text_colors[0] = 0; -+ line_colors[0] = 0; -+ line_styles[0] = 1; -+ line_widths[0] = 1; -+ text[0]=string; -+ pllegend (&legend_width , &legend_height , -+ PL_LEGEND_NONE, -+ PL_POSITION_VIEWPORT|PL_POSITION_TOP|PL_POSITION_OUTSIDE, -+ 1.0 , -0.1 , plot_width , //moved the position farther away since it shows up in postscripts; -+ 0 , 0 , 1 , -+ 1 , 1 , -+ 1 , opt_array , -+ 0.0 , text_scale , 0.0 , 0.0 , text_colors , -+ text , NULL , NULL , NULL , NULL , NULL , -+ NULL , NULL , NULL , NULL , NULL , NULL); -+//with these values: legend_width = 2. * 0.4 *character_width + text_width ; -+ //invert pllegend work: -+#define subpage_to_adopted_x( nx ) ( ( nx - xdmin_adopted ) / ( ( xdmax_adopted ) - ( xdmin_adopted ) ) ) -+#define adopted_to_subpage_x( nx ) ( ( xdmin_adopted ) + ( nx ) * ( ( xdmax_adopted ) - ( xdmin_adopted ) ) ) -+ PLFLT tempsize=adopted_to_subpage_x(legend_width+subpage_to_adopted_x( 0. )); -+ tempsize=tempsize-0.8*character_width-adopted_to_subpage_x(plot_width) + adopted_to_subpage_x( 0. ); -+ return tempsize/x_subpage_per_mm; -+ } -+#else //we are desperate at this point since the value returned will be false since fonts are proportional fonts. -+ PLFLT gdlGetmmStringLength(const char *string) -+ { -+ return (strlen(string))*theCurrentChar.mmsx; -+ } -+#endif -+#endif -+ -+ void currentPhysicalPos(PLFLT &x, PLFLT &y) -+ { -+ x=Mypls->currx; //Physical x-coordinate of current point -+ y=Mypls->curry; -+ } -+ void currentWorldPos(PLFLT &x, PLFLT &y) -+ { -+ x=Mypls->currx; //Physical x-coordinate of current point -+ y=Mypls->curry; -+ x=(x-Mypls->wpxoff)/Mypls->wpxscl; -+ y=(y-Mypls->wpyoff)/Mypls->wpyscl; -+ } -+ void currentDevicePos(PLFLT &x, PLFLT &y) -+ { -+ x=Mypls->currx; //Physical x-coordinate of current point -+ y=Mypls->curry; -+ x=p2dx(x); -+ y=p2dy(y); -+ } -+ void currentMmPos(PLFLT &x, PLFLT &y) -+ { -+ x=Mypls->currx; //Physical x-coordinate of current point -+ y=Mypls->curry; -+ x=p2dx(x);x=d2mx(x); -+ y=p2dy(y);y=d2my(y); -+ } -+ -+ void pageWorldCoordinates(PLFLT &wxmin, PLFLT &wxmax, PLFLT &wymin, PLFLT &wymax) -+ { -+ wxmin=theBox.pageWorldCoordinates[0]; -+ wxmax=theBox.pageWorldCoordinates[1]; -+ wymin=theBox.pageWorldCoordinates[2]; -+ wymax=theBox.pageWorldCoordinates[3]; -+ } -+ void subPageWorldCoordinates(PLFLT &wxmin, PLFLT &wxmax, PLFLT &wymin, PLFLT &wymax) -+ { -+ wxmin=theBox.subPageWorldCoordinates[0]; -+ wxmax=theBox.subPageWorldCoordinates[1]; -+ wymin=theBox.subPageWorldCoordinates[2]; -+ wymax=theBox.subPageWorldCoordinates[3]; -+ } -+ void boxDeviceCoordinates(PLFLT &wxmin, PLFLT &wxmax, PLFLT &wymin, PLFLT &wymax) -+ { -+ wxmin=theBox.dx1; -+ wxmax=theBox.dx2; -+ wymin=theBox.dy1; -+ wymax=theBox.dy2; -+ } -+ PLFLT boxAspectDevice(){return (theBox.dy2-theBox.dy1)/(theBox.dx2-theBox.dx1);} -+ PLFLT boxAspectWorld(){return fabs(theBox.wy2-theBox.wy1)/fabs(theBox.wx2-theBox.wx1);} -+ -+ void SaveLayout() -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"SaveLayout():\n"); -+ pageLayout.nbPages=thePage.nbPages; -+ pageLayout.nx=thePage.nx; -+ pageLayout.ny=thePage.ny; -+ pageLayout.curPage=thePage.curPage; -+ pageLayout.length=thePage.length; -+ pageLayout.height=thePage.height; -+ pageLayout.xsizemm=thePage.xsizemm; -+ pageLayout.ysizemm=thePage.ysizemm; -+ pageLayout.plxoff=thePage.plxoff; -+ pageLayout.plyoff=thePage.plyoff; -+ -+ boxLayout.nx1=theBox.nx1; -+ boxLayout.nx2=theBox.nx2; -+ boxLayout.ny1=theBox.ny1; -+ boxLayout.ny2=theBox.ny2; -+ boxLayout.ndx1=theBox.ndx1; -+ boxLayout.ndx2=theBox.ndx2; -+ boxLayout.ndy1=theBox.ndy1; -+ boxLayout.ndy2=theBox.ndy2; -+ boxLayout.ondx=theBox.ondx; -+ boxLayout.ondy=theBox.ondy; -+ boxLayout.sndx=theBox.sndx; -+ boxLayout.sndy=theBox.sndy; -+ boxLayout.dx1=theBox.dx1; -+ boxLayout.dx2=theBox.dx2; -+ boxLayout.dy1=theBox.dy1; -+ boxLayout.dy2=theBox.dy2; -+ boxLayout.wx1=theBox.wx1; -+ boxLayout.wx2=theBox.wx2; -+ boxLayout.wy1=theBox.wy1; -+ boxLayout.wy2=theBox.wy2; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"saving box [%f,%f,%f,%f] at [%f,%f,%f,%f] in subpage %d of %dx%d (device coords [%f,%f,%f,%f]\n",boxLayout.wx1,boxLayout.wy1,boxLayout.wx2,boxLayout.wy2,boxLayout.nx1,boxLayout.ny1,boxLayout.nx2,boxLayout.ny2,pageLayout.curPage,pageLayout.nx,pageLayout.ny,boxLayout.dx1,boxLayout.dy1,boxLayout.dx2,boxLayout.dy2); -+ } -+ -+ void RestoreLayout() -+ { -+ ssub(pageLayout.nx,pageLayout.ny); -+ adv(pageLayout.curPage); -+ vpor(boxLayout.nx1,boxLayout.nx2,boxLayout.ny1,boxLayout.ny2); -+ wind(boxLayout.wx1,boxLayout.wx2,boxLayout.wy1,boxLayout.wy2); -+ } -+ -+ void OnePageSaveLayout() -+ { -+ SaveLayout(); -+ NoSub(); -+ } -+ -+ bool updatePageInfo() -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"updatePageInfo():\n"); -+ if (thePage.nbPages==0) {if (GDL_DEBUG_PLSTREAM) fprintf(stderr," FAILED\n");return false;} -+ long xsize,ysize,xoff,yoff; -+ GetGeometry(xsize,ysize,xoff,yoff); -+ thePage.length=xsize; -+ thePage.height=ysize; -+ thePage.plxoff=xoff; -+ thePage.plyoff=yoff; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," %fx%f device units.\n",thePage.length, thePage.height); -+ return true; -+ } - -+ inline void NormToDevice(PLFLT normx, PLFLT normy, PLFLT &devx, PLFLT &devy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"NormToDevice()\n"); -+ devx=normx*thePage.subpage.dxsize+thePage.subpage.dxoff; -+ devy=normy*thePage.subpage.dysize+thePage.subpage.dyoff; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f] output [%f,%f]\n", normx, normy, devx, devy); -+ } -+ -+ inline void NormedDeviceToDevice(PLFLT normx, PLFLT normy, PLFLT &devx, PLFLT &devy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"NormedDeviceToDevice()\n"); -+ devx=normx*thePage.length; -+ devy=normy*thePage.height; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f] output [%f,%f]\n", normx, normy, devx, devy); -+ } -+ -+ inline void DeviceToNorm(PLFLT devx, PLFLT devy, PLFLT &normx, PLFLT &normy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"DeviceToNorm()\n"); -+ normx=(devx-thePage.subpage.dxoff)/thePage.subpage.dxsize; -+ normy=(devy-thePage.subpage.dyoff)/thePage.subpage.dysize; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f] output [%f,%f]\n", devx, devy, normx, normy); -+ } -+ inline void DeviceToNormedDevice(PLFLT devx, PLFLT devy, PLFLT &normx, PLFLT &normy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"DeviceToNormedDevice()\n"); -+ normx=devx/thePage.length; -+ normy=devy/thePage.height; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f] output [%f,%f]\n", devx, devy, normx, normy); -+ } -+ inline void NormToWorld(PLFLT normx, PLFLT normy, PLFLT &worldx, PLFLT &worldy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"NormToWorld()\n"); -+ DDouble s1,s2; -+ s1=(theBox.wx2-theBox.wx1)/(theBox.nx2-theBox.nx1); -+ s2=theBox.wx1; -+ worldx=s1*(normx-theBox.nx1)+s2; -+ s1=(theBox.wy2-theBox.wy1)/(theBox.ny2-theBox.ny1); -+ s2=theBox.wy1; -+ worldy=s1*(normy-theBox.ny1)+s2; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f] output [%f,%f]\n", normx, normy, worldx, worldy); -+ } -+ -+ inline void NormedDeviceToWorld(PLFLT normx, PLFLT normy, PLFLT &worldx, PLFLT &worldy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"NormedDeviceToWorld()\n"); -+ DDouble s1,s2; -+ s1=(theBox.wx2-theBox.wx1)/(theBox.ndx2-theBox.ndx1); -+ s2=theBox.wx1; -+ worldx=s1*(normx-theBox.ndx1)+s2; -+ s1=(theBox.wy2-theBox.wy1)/(theBox.ndy2-theBox.ndy1); -+ s2=theBox.wy1; -+ worldy=s1*(normy-theBox.ndy1)+s2; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f] (nd) output [%f,%f] (w)\n", normx, normy, worldx, worldy); -+ } -+ -+ inline void WorldToNorm(PLFLT worldx, PLFLT worldy, PLFLT &normx, PLFLT &normy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"WorldToNormedDevice()\n"); -+ DDouble s1,s2; -+ s1=(theBox.nx2-theBox.nx1)/(theBox.wx2-theBox.wx1); -+ s2=theBox.nx1; -+ normx=s1*(worldx-theBox.wx1)+s2; -+ s1=(theBox.ny2-theBox.ny1)/(theBox.wy2-theBox.wy1); -+ s2=theBox.ny1; -+ normy=s1*(worldy-theBox.wy1)+s2; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f] output [%f,%f]\n", worldx, worldy, normx, normy); -+ } -+ -+ inline void WorldToNormedDevice(PLFLT worldx, PLFLT worldy, PLFLT &normx, PLFLT &normy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"WorldToNormedDevice()\n"); -+ DDouble s1,s2; -+ s1=(theBox.ndx2-theBox.ndx1)/(theBox.wx2-theBox.wx1); -+ s2=theBox.ndx1; -+ normx=s1*(worldx-theBox.wx1)+s2; -+ s1=(theBox.ndy2-theBox.ndy1)/(theBox.wy2-theBox.wy1); -+ s2=theBox.ndy1; -+ normy=s1*(worldy-theBox.wy1)+s2; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," input [%f,%f](w) output [%f,%f](nd)\n", worldx, worldy, normx, normy); -+ } -+ -+ -+ inline void DeviceToWorld(PLFLT devx, PLFLT devy, PLFLT &worldx, PLFLT &worldy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"DeviceToWorld()\n"); -+ PLFLT normx, normy; -+ DeviceToNormedDevice(devx, devy, normx, normy); -+ NormedDeviceToWorld(normx, normy, worldx, worldy); -+ } -+ -+ inline void WorldToDevice(PLFLT worldx, PLFLT worldy, PLFLT &devx, PLFLT &devy) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"WorldToDevice()\n"); -+ PLFLT normx, normy; -+ WorldToNormedDevice(worldx, worldy, normx, normy); -+ NormedDeviceToDevice(normx, normy, devx, devy); -+ } -+ - // void Clear(); - void Color( ULong c, DLong decomposed=0, UInt ix=1); - void Background( ULong c, DLong decomposed=0); -@@ -136,14 +661,152 @@ - - void NoSub(); // no subwindows (/NORM, /DEVICE) - -+ void CurrentCharSize(PLFLT scale) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"CurrentCharsize()\n"); -+ if (gdlDefaultCharInitialized==0) -+ { -+ if (updatePageInfo()==true) -+ { -+ GetPlplotDefaultCharSize(); -+ } -+ } -+ theCurrentChar.scale=scale; -+ theCurrentChar.ndsx=scale*theDefaultChar.ndsx; -+ theCurrentChar.ndsy=scale*theDefaultChar.ndsy; -+ theCurrentChar.dsx=scale*theDefaultChar.dsx; -+ theCurrentChar.dsy=scale*theDefaultChar.dsy; -+ theCurrentChar.mmsx=scale*theDefaultChar.mmsx; -+ theCurrentChar.mmsy=scale*theDefaultChar.mmsy; -+ theCurrentChar.wsx=scale*theDefaultChar.wsx; -+ theCurrentChar.wsy=scale*theDefaultChar.wsy; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," sized by %f is %fx%f mm or %fx%f device or %fx%f world\n",scale,theCurrentChar.mmsx,theCurrentChar.mmsy,theCurrentChar.dsx,theCurrentChar.dsy,theCurrentChar.wsx, theCurrentChar.wsy); -+ } -+ -+ void UpdateCurrentCharWorldSize() -+ { -+ PLFLT x,y,dx,dy; -+ DeviceToWorld(0,0,x,y); -+ DeviceToWorld(theDefaultChar.dsx,theDefaultChar.dsy, dx, dy); -+ theDefaultChar.wsx=abs(dx-x); -+ theDefaultChar.wsy=abs(dy-y); -+ theCurrentChar.wsx=theCurrentChar.scale*theDefaultChar.wsx; -+ theCurrentChar.wsy=theCurrentChar.scale*theDefaultChar.wsy; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"UpdateCurrentCharWorldSize(%f,%f)\n", -+ theCurrentChar.wsx,theCurrentChar.wsy); -+ } -+ -+ void GetPlplotDefaultCharSize() -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"GetPlPlotDefaultCharsize()\n"); -+ if (thePage.nbPages==0) {return;} -+ //dimensions in normalized, device and millimetres -+ if (gdlDefaultCharInitialized==1) {if (GDL_DEBUG_PLSTREAM) fprintf(stderr," Already initialized\n"); return;} -+ -+ PLFLT nxmin, nxmax, nymin, nymax, wxmin, wxmax, wymin, wymax; -+ plstream::gvpd(nxmin, nxmax, nymin, nymax); //save norm of current box -+ if((nxmin==0.0&&nxmax==0.0)||(nymin==0.0&&nymax==0.0)) //if not initialized, set normalized mode -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," Warning: initializing viewport\n"); -+ plstream::vpor(0, 1, 0, 1); -+ plstream::gvpd(nxmin, nxmax, nymin, nymax); -+ plstream::wind(0.0,1.0,0.0,1.0); -+ } -+ plstream::gvpw(wxmin, wxmax, wymin, wymax); //save world of current box -+ PLFLT vpXmin, vpXmax, vpYmin, vpYmax; -+ PLFLT vpXmin2, vpXmax2, vpYmin2, vpYmax2; -+ plstream::vpor(0, 1, 0, 1); -+ plstream::wind(0.0,1.0,0.0,1.0); -+ plstream::gvpd(vpXmin, vpXmax, vpYmin, vpYmax); -+ plstream::vsta(); -+ plstream::gvpd(vpXmin2, vpXmax2, vpYmin2, vpYmax2); -+ theDefaultChar.ndsx=0.5*((vpXmin2-vpXmin)/8.0+(vpXmax-vpXmax2)/5.0); -+ theDefaultChar.ndsy=0.5*((vpYmin2-vpYmin)/5.0+(vpYmax-vpYmax2)/5.0); -+ theDefaultChar.dsx=0.5*((vpXmin2-vpXmin)/8.0+(vpXmax-vpXmax2)/5.0)*thePage.length; -+ theDefaultChar.dsy=0.5*((vpYmin2-vpYmin)/5.0+(vpYmax-vpYmax2)/5.0)*thePage.height; -+ plstream::vpor(nxmin, nxmax, nymin, nymax); //restore norm of current box -+ plstream::wind(wxmin, wxmax, wymin, wymax); //restore world of current box -+ PLFLT defhmm, scalhmm; -+ plgchr(&defhmm, &scalhmm); // height of a letter in millimetres -+ theDefaultChar.mmsy=scalhmm; -+ theDefaultChar.mmsx=theDefaultChar.ndsx/theDefaultChar.ndsy*scalhmm; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," %fx%f(mm)\n",theDefaultChar.mmsx,theDefaultChar.mmsy); -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," %fx%f(norm)\n",theDefaultChar.ndsx,theDefaultChar.ndsy); -+ gdlDefaultCharInitialized=1; -+ } - // SA: overloading plplot methods in order to handle IDL-plplot extended - // text formating syntax conversion -- const char * TranslateFormatCodes(const char *text); -+ bool TranslateFormatCodes(const char *text, std::string &out); - void mtex( const char *side, PLFLT disp, PLFLT pos, PLFLT just, - const char *text); - void ptex( PLFLT x, PLFLT y, PLFLT dx, PLFLT dy, PLFLT just, - const char *text); -+ void schr( PLFLT def, PLFLT scale ); -+ void sizeChar(PLFLT scale); -+ void vpor( PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax ); -+// void gvpd( PLFLT& xmin, PLFLT& xmax, PLFLT& ymin, PLFLT& ymax ); -+ void wind( PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax ); -+ void ssub( PLINT nx, PLINT ny); -+ void adv(PLINT page); -+ void gpage(PLFLT& xp, PLFLT& yp, PLINT& xleng, PLINT& yleng, -+ PLINT& xoff, PLINT& yoff) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"gpage()\n",xp,yp); -+ if(updatePageInfo()==true) -+ { -+ xp=thePage.xdpmm/MMTOINCH; -+ yp=thePage.ydpmm/MMTOINCH; -+ xleng=(PLINT)thePage.length; -+ yleng=(PLINT)thePage.height; -+ xoff=(PLINT)thePage.plxoff; -+ yoff=(PLINT)thePage.plyoff; -+ } -+ } -+ -+ inline void syncPageInfo() -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"SyncPageInfo()\n"); -+ PLINT level; -+ plstream::glevel(level); -+ if (level>1 && thePage.nbPages!=0) //we need to have a vpor defined, and a page! -+ { -+ PLFLT bxsize_mm, bysize_mm, offx_mm, offy_mm; -+ PLFLT xmin,ymin,xmax,ymax; -+ plstream::gspa(xmin,xmax,ymin,ymax); //subpage in mm -+ bxsize_mm=xmax-xmin; -+ bysize_mm=ymax-ymin; -+ offx_mm=xmin; -+ offy_mm=ymin; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," gspa returned size[%f,%f] at offset [%f,%f] (mm) for subpage %d of %dx%d subpages\n",bxsize_mm,bysize_mm,offx_mm,offy_mm,thePage.curPage,thePage.nx,thePage.ny); -+ //we can derive the dpm in x and y which converts mm to device coords: -+ thePage.xdpmm=abs(thePage.length/(thePage.nx*bxsize_mm)); -+ thePage.ydpmm=abs(thePage.height/(thePage.ny*bysize_mm)); -+ //and the page width and height in mm: -+ thePage.xsizemm=thePage.length/thePage.xdpmm; -+ thePage.ysizemm=thePage.height/thePage.ydpmm; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," device resolution [%f,%f]mm^-1, device size [%f,%f], [%f,%f] mm\n", -+ thePage.xdpmm,thePage.ydpmm,thePage.length,thePage.height,thePage.xsizemm,thePage.ysizemm); -+ thePage.subpage.dxoff=offx_mm*thePage.xdpmm; -+ thePage.subpage.dyoff=offy_mm*thePage.ydpmm; -+ thePage.subpage.dxsize=bxsize_mm*thePage.xdpmm; -+ thePage.subpage.dysize=bysize_mm*thePage.ydpmm; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr," subpage is %fx%f at [%f,%f] device units\n", -+ thePage.subpage.dxsize,thePage.subpage.dysize,thePage.subpage.dxoff,thePage.subpage.dyoff); -+ -+ } else if (GDL_DEBUG_PLSTREAM) fprintf(stderr," WARNING: not initalized\n"); -+ } - -+ inline void updateBoxDeviceCoords() -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"updateBoxDeviceCoords()\n"); -+ // world coordinates of current subpage boundaries and page boundaries -+ NormedDeviceToWorld(0.0, 0.0,theBox.pageWorldCoordinates[0],theBox.pageWorldCoordinates[2]); -+ NormedDeviceToWorld(1.0, 1.0,theBox.pageWorldCoordinates[1],theBox.pageWorldCoordinates[3]); -+ NormToWorld(0.0, 0.0,theBox.subPageWorldCoordinates[0],theBox.subPageWorldCoordinates[2]); -+ NormToWorld(1.0, 1.0,theBox.subPageWorldCoordinates[1],theBox.subPageWorldCoordinates[3]); -+ NormToDevice(theBox.nx1,theBox.ny1,theBox.dx1,theBox.dy1); -+ NormToDevice(theBox.nx2,theBox.ny2,theBox.dx2,theBox.dy2); -+ } - }; - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlgstream.hpp.rej gdl/src/gdlgstream.hpp.rej ---- gdl-0.9.3/src/gdlgstream.hpp.rej 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/gdlgstream.hpp.rej 2011-08-22 08:48:35.000000000 -0600 -@@ -0,0 +1,29 @@ -+--- src/gdlgstream.hpp.includes 2010-06-11 09:09:51.000000000 -0600 -++++ src/gdlgstream.hpp 2011-08-18 13:10:41.285235153 -0600 -+@@ -50,7 +50,7 @@ -+ { -+ // std::cerr << "GDLGStream()" << std::endl; -+ if (!checkPlplotDriver(driver)) -+- ThrowGDLException(string("PLplot installation lacks the requested driver: ") + driver); -++ ThrowGDLException(std::string("PLplot installation lacks the requested driver: ") + driver); -+ } -+ -+ virtual ~GDLGStream() -+@@ -103,7 +103,7 @@ -+ -+ // devNames = new std::vector( numdevs_plus_one - 1); -+ for( int i = 0; i < numdevs_plus_one - 1; ++i) -+- devNames.push_back(string(devnames[ i])); -++ devNames.push_back(std::string(devnames[ i])); -+ -+ free(devnames); -+ } -+@@ -111,7 +111,7 @@ -+ // for debug -+ std::vector devnamesDbg = devNames; -+ -+-return std::find( devNames.begin(), devNames.end(), string( driver)) != devNames.end(); -++return std::find( devNames.begin(), devNames.end(), std::string( driver)) != devNames.end(); -+ -+ // checking if a given driver is in the list -+ // bool supported = false; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLInterpreter.cpp gdl/src/GDLInterpreter.cpp ---- gdl-0.9.3/src/GDLInterpreter.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLInterpreter.cpp 2013-07-31 09:41:43.633246764 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "gdlc.i.g" -> "GDLInterpreter.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.i.g" -> "GDLInterpreter.cpp"$ */ - - // gets inserted before the antlr generated includes in the cpp file - #include "includefirst.hpp" -@@ -428,13 +428,31 @@ - // .CONTINUE does not work) - _retTree = last; - -- if( dynamic_cast< GDLIOException*>( &e) != NULL) -+ if( last->IsWrappedNode()) -+ throw e; // WRAPPED_... nodes should not stop inside -+ -+ // set !ERROR_STATE sys var -+ static DStructDesc* errorStateDesc = SysVar::Error_State()->Desc(); -+ static unsigned nameTag = errorStateDesc->TagIndex( "NAME"); -+ static unsigned codeTag = errorStateDesc->TagIndex( "CODE"); -+ static unsigned msgTag = errorStateDesc->TagIndex( "MSG"); -+ -+ if( e.IsIOException()) - { -+ assert( dynamic_cast< GDLIOException*>( &e) != NULL); - // set the jump target - also logs the jump - ProgNodeP onIOErr = - static_cast(callStack.back())->GetIOError(); - if( onIOErr != NULL) - { -+ DStructGDL* errorState = SysVar::Error_State(); -+ (*static_cast( errorState->GetTag( nameTag)))[0] = -+ "IDL_M_FAILURE"; -+ (*static_cast( errorState->GetTag( codeTag)))[0] = -+ e.ErrorCode(); -+ SysVar::SetErrError( e.ErrorCode()); -+ (*static_cast( errorState->GetTag( msgTag)))[0] = -+ e.getMessage(); - SysVar::SetErr_String( e.getMessage()); - - _retTree = onIOErr; -@@ -442,14 +460,49 @@ - } - } - -+ // handle CATCH -+ ProgNodeP catchNode = callStack.back()->GetCatchNode(); -+ if( catchNode != NULL) -+ { -+ DStructGDL* errorState = SysVar::Error_State(); -+ (*static_cast( errorState->GetTag( nameTag)))[0] = -+ "IDL_M_FAILURE"; -+ (*static_cast( errorState->GetTag( codeTag)))[0] = -+ e.ErrorCode(); -+ SysVar::SetErrError( e.ErrorCode()); -+ (*static_cast( errorState->GetTag( msgTag)))[0] = -+ e.getMessage(); -+ SysVar::SetErr_String( e.getMessage()); -+ -+ BaseGDL** catchVar = callStack.back()->GetCatchVar(); -+ GDLDelete(*catchVar); -+ *catchVar = new DLongGDL( e.ErrorCode()); -+ _retTree = catchNode; -+ return RC_OK; -+ } -+ - EnvUDT* targetEnv = e.GetTargetEnv(); - if( targetEnv == NULL) - { - // initial exception, set target env -+ -+ // set !ERROR_STATE here -+ DStructGDL* errorState = SysVar::Error_State(); -+ (*static_cast( errorState->GetTag( nameTag)))[0] = -+ "IDL_M_FAILURE"; -+ (*static_cast( errorState->GetTag( codeTag)))[0] = -+ e.ErrorCode(); -+ SysVar::SetErrError( e.ErrorCode()); -+ (*static_cast( errorState->GetTag( msgTag)))[0] = -+ e.getMessage(); -+ SysVar::SetErr_String( e.getMessage()); -+ - // look if ON_ERROR is set somewhere -- for( EnvStackT::reverse_iterator i = callStack.rbegin(); -- i != callStack.rend(); ++i) -+ // for( EnvStackT::reverse_iterator i = callStack.rbegin(); -+ // i != callStack.rend(); ++i) -+ for( long ix = callStack.size() - 1; ix>=0; --ix) - { -+ EnvUDT** i = &callStack[ ix]; - DLong oE = -1; - EnvUDT* envUD = dynamic_cast(*i); - if( envUD != NULL) -@@ -465,32 +518,40 @@ - else if( oE == 1) - { - EnvUDT* cS_begin = -- static_cast(*callStack.begin()); -+ static_cast(callStack[0]); -+ // static_cast(*callStack.begin()); - targetEnv = cS_begin; - } - // 2 -> caller of routine which called ON_ERROR - else if( oE == 2) - { - // set to caller, handle nested -- while( static_cast(*(++i))->GetOnError() == 2 -- && i != callStack.rend()); -+ while( ix > 0 && static_cast(callStack[--ix])->GetOnError() == 2) -+ ; // just set ix - -- if( i == callStack.rend()) -- { -- EnvUDT* cS_begin = -- static_cast(*callStack.begin()); -- targetEnv = cS_begin; -- } -- else -- { -- EnvUDT* iUDT = static_cast(*i); -+ EnvUDT* iUDT = static_cast(callStack[ix]); - targetEnv = iUDT; -- } -+ -+ -+ // while( static_cast(*(++i))->GetOnError() == 2 -+ // && i != callStack.rend()); -+ // if( i == callStack.rend()) -+ // { -+ // EnvUDT* cS_begin = -+ // static_cast(*callStack.begin()); -+ // targetEnv = cS_begin; -+ // } -+ // else -+ // { -+ // EnvUDT* iUDT = static_cast(*i); -+ // targetEnv = iUDT; -+ // } - } - // 3 -> routine which called ON_ERROR - else if( oE == 3) - { -- EnvUDT* iUDT = static_cast(*i); -+ EnvUDT* iUDT = static_cast(callStack[ix]); -+ // EnvUDT* iUDT = static_cast(*i); - targetEnv = iUDT; - } - -@@ -787,7 +848,7 @@ - - assert( actEnv != NULL); - -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = _t->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -804,7 +865,7 @@ - if( !callStack.back()->Contains( e1)) - { - // if( actEnv != NULL) -- actEnv->Guard( e1); -+ actEnv->DeleteAtExit( e1); - // else - // e1_guard.reset( e1); - } -@@ -814,7 +875,7 @@ - e1 = evalExpr->Eval(); - - // if( actEnv != NULL) -- actEnv->Guard( e1); -+ actEnv->DeleteAtExit( e1); - // else - // e1_guard.reset(e1); - } -@@ -882,7 +943,7 @@ - e1=expr(_t); - _t = _retTree; - -- auto_ptr e1_guard(e1); -+ Guard e1_guard(e1); - if( e1->True()) - { - res=l_ret_expr(_t); -@@ -950,7 +1011,7 @@ - match(antlr::RefAST(_t),ASSIGN); - _t = _t->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - - { - if (_t == ProgNodeP(antlr::nullAST) ) -@@ -985,7 +1046,7 @@ - e1=tmp_expr(_t); - _t = _retTree; - -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -995,7 +1056,7 @@ - _t = _retTree; - - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -1026,7 +1087,7 @@ - match(antlr::RefAST(_t),ASSIGN_ARRAYEXPR_MFCALL); - _t = _t->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - - { - if (_t == ProgNodeP(antlr::nullAST) ) -@@ -1061,7 +1122,7 @@ - e1=tmp_expr(_t); - _t = _retTree; - -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -1071,7 +1132,7 @@ - _t = _retTree; - - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -1102,7 +1163,7 @@ - match(antlr::RefAST(_t),ASSIGN_REPLACE); - _t = _t->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - - { - if (_t == ProgNodeP(antlr::nullAST) ) -@@ -1137,7 +1198,7 @@ - e1=tmp_expr(_t); - _t = _retTree; - -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -1147,7 +1208,7 @@ - _t = _retTree; - - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -1350,7 +1411,7 @@ - match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); - -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - newEnv=new EnvUDT( self, mp2, "", true); - -@@ -2015,7 +2076,7 @@ - ArrayIndexListT* aL; - ProgNodeP arrayindex_list_AST_in = (_t == ProgNodeP(ASTNULL)) ? ProgNodeP(antlr::nullAST) : _t; - -- IxExprListT cleanupList; // for cleanup -+ // IxExprListT cleanupList; // for cleanup - IxExprListT ixExprList; - SizeT nExpr; - BaseGDL* s; -@@ -2025,9 +2086,9 @@ - // match(antlr::RefAST(_t),ARRAYIX); - _t = _t->getFirstChild(); - -- aL = ax->arrIxList; -+ aL = ax->arrIxList; // vs. ax->arrIxListNoAssoc - assert( aL != NULL); -- -+ - nExpr = aL->NParam(); - if( nExpr == 0) - { -@@ -2037,6 +2098,8 @@ - } - - while( true) { -+ IxExprListT* cleanupList = aL->GetCleanupIx(); // for cleanup -+ - assert( _t != NULL); - if( NonCopyNode( _t->getType())) - { -@@ -2048,13 +2111,13 @@ - s=lib_function_call(_t); - //_t = _retTree; - if( !callStack.back()->Contains( s)) -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - else - { - s=_t->Eval(); //indexable_tmp_expr(_t); - //_t = _retTree; -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - - assert( s != NULL); -@@ -2065,7 +2128,7 @@ - _t = _t->getNextSibling(); - } - -- aL->Init( ixExprList, &cleanupList); -+ aL->Init( ixExprList);//, &cleanupList); - - _retTree = ax->getNextSibling();//retTree; - return aL; -@@ -2158,9 +2221,9 @@ - _t = _t->getFirstChild(); - - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - -- l_dot_array_expr(_t, aD.get()); -+ l_dot_array_expr(_t, aD.Get()); - _t = _retTree; - { // ( ... )+ - int _cnt37=0; -@@ -2168,7 +2231,7 @@ - if (_t == ProgNodeP(antlr::nullAST) ) - _t = ASTNULL; - if ((_t->getType() == ARRAYEXPR || _t->getType() == EXPR || _t->getType() == IDENTIFIER)) { -- tag_array_expr(_t, aD.get()); -+ tag_array_expr(_t, aD.Get()); - _t = _retTree; - } - else { -@@ -2184,23 +2247,23 @@ - - if( dec_inc == DECSTATEMENT) - { -- aD->Dec(); -+ aD.Get()->Dec(); - res = NULL; - } - else if( dec_inc == INCSTATEMENT) - { -- aD->Inc(); -+ aD.Get()->Inc(); - res = NULL; - } - else - { -- if( dec_inc == DEC) aD->Dec(); //*** aD->Assign( dec_inc); -- else if( dec_inc == INC) aD->Inc(); -+ if( dec_inc == DEC) aD.Get()->Dec(); //*** aD->Assign( dec_inc); -+ else if( dec_inc == INC) aD.Get()->Inc(); - // -- res=aD->ADResolve(); -+ res=aD.Get()->ADResolve(); - -- if( dec_inc == POSTDEC) aD->Dec(); -- else if( dec_inc == POSTINC) aD->Inc(); -+ if( dec_inc == POSTDEC) aD.Get()->Dec(); -+ else if( dec_inc == POSTINC) aD.Get()->Inc(); - } - - _retTree = _t; -@@ -2214,44 +2277,15 @@ - - ArrayIndexListT* aL; - BaseGDL** rP; -- //DStructGDL* structR; -- ArrayIndexListGuard guard; - - if( _t->getType() == ARRAYEXPR) - { - rP=l_indexable_expr(_t->getFirstChild()); - aL=arrayindex_list(_retTree); -- guard.reset(aL); - - _retTree = _t->getNextSibling(); - -- // check here for object and get struct -- // structR=dynamic_cast(*rP); -- // if( structR == NULL) -- if( (*rP)->Type() != GDL_STRUCT) -- { -- bool isObj = callStack.back()->IsObject(); -- if( isObj) -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( *rP, _t); -- // oStruct cannot be "Assoc_" -- aD->ADRoot( oStruct, guard.release()); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(*rP), -- true,false); -- } -- } -- else -- { -- DStructGDL* structR=static_cast(*rP); -- if( (*rP)->IsAssoc()) -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(*rP),true,false); -- aD->ADRoot( structR, guard.release() /* aL */); -- } -+ SetRootL( _t, aD, *rP, aL); - } - else - // case ARRAYEXPR_MFCALL: -@@ -2266,37 +2300,8 @@ - // case VARPTR: - { - rP=l_indexable_expr(_t); -- //_t = _retTree; _retTree set ok - -- // check here for object and get struct -- //structR = dynamic_cast(*rP); -- //if( structR == NULL) -- if( (*rP)->Type() != GDL_STRUCT) -- { -- bool isObj = callStack.back()->IsObject(); -- if( isObj) // member access to object? -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( *rP, _t); -- // oStruct cannot be "Assoc_" -- aD->ADRoot( oStruct); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(*rP), -- true,false); -- } -- } -- else -- { -- DStructGDL* structR=static_cast(*rP); -- if( (*rP)->IsAssoc()) -- { -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(*rP),true,false); -- } -- aD->ADRoot(structR); -- } -+ SetRootL( _t, aD, *rP, NULL); - } - return; - // _retTree = _t; -@@ -2385,7 +2390,6 @@ - _t = _retTree; - aL=arrayindex_list(_t); - _t = _retTree; -- aD->ADAddIx(aL); - _t = __t75; - _t = _t->getNextSibling(); - break; -@@ -2395,7 +2399,6 @@ - { - tag_expr(_t, aD); - _t = _retTree; -- aD->ADAddIx(NULL); - break; - } - default: -@@ -2429,7 +2432,7 @@ - e1=expr(_t); - _t = _retTree; - -- auto_ptr e1_guard(e1); -+ Guard e1_guard(e1); - - if( e1->True()) - { -@@ -2452,7 +2455,7 @@ - match(antlr::RefAST(_t),ASSIGN); - _t = _t->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - - { - if (_t == ProgNodeP(antlr::nullAST) ) -@@ -2491,7 +2494,7 @@ - { - e1=indexable_tmp_expr(_t); - _t = _retTree; -- r_guard.reset( e1); -+ r_guard.Init( e1); - break; - } - case FCALL_LIB: -@@ -2500,7 +2503,7 @@ - _t = _retTree; - - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); // guard if no global data -+ r_guard.Init( e1); // guard if no global data - - break; - } -@@ -2533,7 +2536,7 @@ - match(antlr::RefAST(_t),ASSIGN_ARRAYEXPR_MFCALL); - _t = _t->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - - { - if (_t == ProgNodeP(antlr::nullAST) ) -@@ -2572,7 +2575,7 @@ - { - e1=indexable_tmp_expr(_t); - _t = _retTree; -- r_guard.reset( e1); -+ r_guard.Init( e1); - break; - } - case FCALL_LIB: -@@ -2581,7 +2584,7 @@ - _t = _retTree; - - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); // guard if no global data -+ r_guard.Init( e1); // guard if no global data - - break; - } -@@ -2606,7 +2609,7 @@ - { - delete *tmp; - -- if( r_guard.get() == e1) -+ if( r_guard.Get() == e1) - *tmp = r_guard.release(); - else - *tmp = e1->Dup(); -@@ -2640,7 +2643,7 @@ - match(antlr::RefAST(_t),ASSIGN_REPLACE); - _t = _t->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - - { - if (_t == ProgNodeP(antlr::nullAST) ) -@@ -2675,7 +2678,7 @@ - e1=tmp_expr(_t); - _t = _retTree; - -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -2685,7 +2688,7 @@ - _t = _retTree; - - if( !callStack.back()->Contains( e1)) -- r_guard.reset( e1); -+ r_guard.Init( e1); - - break; - } -@@ -2737,7 +2740,7 @@ - { - delete *tmp; - -- if( r_guard.get() == e1) -+ if( r_guard.Get() == e1) - *tmp = r_guard.release(); - else - *tmp = e1->Dup(); -@@ -2784,12 +2787,15 @@ - match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); - -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - EnvUDT* newEnv; - -+ DObjGDL* selfObj = NULL; -+ if( self->Type() == GDL_OBJ) -+ selfObj = static_cast( self); - try { -- newEnv=new EnvUDT( self, mp2, "", true); -+ newEnv=new EnvUDT( selfObj, mp2, "", true); - self_guard.release(); - } - catch( GDLException& ex) -@@ -3117,7 +3123,7 @@ - // _t = _t->getFirstChild(); - // e1=expr(_t); - // _t = _retTree; -- // auto_ptr e1_guard(e1); -+ // Guard e1_guard(e1); - // if( e1->True()) - // { - // res=l_expr(_t, right); -@@ -3166,7 +3172,7 @@ - // res=l_sys_var(_t); - // // _t = _retTree; // ok - -- // auto_ptr conv_guard; //( rConv); -+ // Guard conv_guard; //( rConv); - // BaseGDL* rConv = right; - // if( !(*res)->EqType( right)) - // { -@@ -3224,7 +3230,7 @@ - // _t = _t->getFirstChild(); - - // SizeT nDot = tIn->nDot; -- // auto_ptr aD( new DotAccessDescT(nDot+1)); -+ // Guard aD( new DotAccessDescT(nDot+1)); - - // l_dot_array_expr(_t, aD.get()); - // _t = _retTree; -@@ -3867,7 +3873,7 @@ - ProgNodeP parameter_def_AST_in = (_t == ProgNodeP(ASTNULL)) ? ProgNodeP(antlr::nullAST) : _t; - - // as actEnv is not on the stack guard it here -- auto_ptr guard(actEnv); -+ Guard guard(actEnv); - - EnvBaseT* callerEnv = callStack.back(); - EnvBaseT* oldNewEnv = callerEnv->GetNewEnv(); -@@ -4059,7 +4065,7 @@ - match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); - -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - try { - newEnv=new EnvUDT( self, mp2, "", true); -@@ -4094,9 +4100,9 @@ - _t = _t->getFirstChild(); - - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - -- l_dot_array_expr(_t, aD.get()); -+ l_dot_array_expr(_t, aD.Get()); - _t = _retTree; - { // ( ... )+ - int _cnt119=0; -@@ -4104,7 +4110,7 @@ - if (_t == ProgNodeP(antlr::nullAST) ) - _t = ASTNULL; - if ((_t->getType() == ARRAYEXPR || _t->getType() == EXPR || _t->getType() == IDENTIFIER)) { -- tag_array_expr(_t, aD.get()); -+ tag_array_expr(_t, aD.Get()); - _t = _retTree; - } - else { -@@ -4123,7 +4129,7 @@ - "Struct expression not allowed in this context.", - true,false); - -- aD->ADAssign( right); -+ aD.Get()->ADAssign( right); - - res=NULL; - -@@ -4148,10 +4154,10 @@ - _t = _t->getFirstChild(); - e=expr(_t); - -- auto_ptr e_guard(e); -+ Guard e_guard(e); - - SizeT tagIx; -- int ret=e->Scalar2index(tagIx); -+ int ret=e->Scalar2Index(tagIx); - if( ret < 1) // this is a return code, not the index - throw GDLException( tIn, "Expression must be a scalar" - " >= 0 in this context: "+Name(e),true,false); -@@ -4183,17 +4189,6 @@ - _t = _t->getFirstChild(); - e=expr(_t); - _t = _retTree; -- -- auto_ptr e_guard(e); -- -- SizeT tagIx; -- int ret=e->Scalar2index(tagIx); -- if( ret < 1) // this is a return code, not the index -- throw GDLException( _t, "Expression must be a scalar" -- " >= 0 in this context: "+Name(e),true,false); -- -- aD->ADAdd( tagIx); -- - _t = __t73; - _t = _t->getNextSibling(); - break; -@@ -4203,10 +4198,6 @@ - i = _t; - match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); -- -- std::string tagName=i->getText(); -- aD->ADAdd( tagName); -- - break; - } - default: -@@ -4318,7 +4309,6 @@ - - BaseGDL* r; - ArrayIndexListT* aL; -- ArrayIndexListGuard guard; - - - if (_t == ProgNodeP(antlr::nullAST) ) -@@ -4334,58 +4324,11 @@ - _t = _retTree; - aL=arrayindex_list(_t); - _t = _retTree; -- guard.reset(aL); - _t = __t79; - _t = _t->getNextSibling(); - - // check here for object and get struct -- if( r->Type() != GDL_STRUCT) -- { -- // if( r->Type() != GDL_OBJ) -- // { -- // // check for Get/SetProperty -- // throw GDLException( _t, "Expression must be a" -- // " STRUCT in this context: "+ -- // Name(r),true,false); -- // } -- bool isObj = callStack.back()->IsObject(); -- if( isObj) -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( r, _t); -- -- // DStructGDL* obj = oStruct->Index( aL); -- -- if( aD->IsOwner()) delete r; -- aD->SetOwner( false); // object struct, not owned -- -- aD->ADRoot( oStruct, guard.release()); -- // aD->ADRoot( obj); -- -- // BaseGDL* obj = r->Index( aL); -- // auto_ptr objGuard( obj); // new object -> guard -- -- // DStructGDL* oStruct = ObjectStructCheckAccess( obj, _t); -- -- // // oStruct cannot be "Assoc_" -- // if( aD->IsOwner()) delete r; -- // aD->SetOwner( false); // object structs are never owned -- // aD->ADRoot( oStruct); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(r),true,false); -- } -- } -- else -- { -- if( r->IsAssoc()) -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(r),true,false); -- -- DStructGDL* structR=static_cast(r); -- aD->ADRoot( structR, guard.release()); -- } -+ SetRootR( _t, aD, r, aL); - - break; - } -@@ -4398,37 +4341,7 @@ - _t = _retTree; - - // check here for object and get struct -- // structR = dynamic_cast(r); -- // if( structR == NULL) -- if( r->Type() != GDL_STRUCT) -- { -- bool isObj = callStack.back()->IsObject(); -- if( isObj) // member access to object? -- { -- DStructGDL* oStruct = ObjectStructCheckAccess( r, _t); -- -- // oStruct cannot be "Assoc_" -- if( aD->IsOwner()) delete r; -- aD->SetOwner( false); // object structs are never owned -- aD->ADRoot( oStruct); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+Name(r),true,false); -- } -- } -- else -- { -- if( r->IsAssoc()) -- { -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+Name(r),true,false); -- } -- -- DStructGDL* structR=static_cast(r); -- aD->ADRoot(structR); -- } -+ SetRootR( _t, aD, r, NULL); - - break; - } -@@ -4986,9 +4899,9 @@ - _t = _t->getFirstChild(); - - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - -- l_dot_array_expr(_t, aD.get()); -+ l_dot_array_expr(_t, aD.Get()); - _t = _retTree; - { // ( ... )+ - int _cnt124=0; -@@ -4996,7 +4909,7 @@ - if (_t == ProgNodeP(antlr::nullAST) ) - _t = ASTNULL; - if ((_t->getType() == ARRAYEXPR || _t->getType() == EXPR || _t->getType() == IDENTIFIER)) { -- tag_array_expr(_t, aD.get()); -+ tag_array_expr(_t, aD.Get()); - _t = _retTree; - } - else { -@@ -5017,7 +4930,7 @@ - "Struct expression not allowed in this context.", - true,false); - -- aD->ADAssign( right); -+ aD.Get()->ADAssign( right); - - res=NULL; - -@@ -5030,7 +4943,7 @@ - ) { - ProgNodeP parameter_def_n_elements_AST_in = (_t == ProgNodeP(ASTNULL)) ? ProgNodeP(antlr::nullAST) : _t; - -- auto_ptr guard(actEnv); -+ Guard guard(actEnv); - _retTree = _t; - // bool interruptEnableIn = interruptEnable; - if( _retTree != NULL) -@@ -5111,7 +5024,7 @@ - ) { - ProgNodeP parameter_def_nocheck_AST_in = (_t == ProgNodeP(ASTNULL)) ? ProgNodeP(antlr::nullAST) : _t; - -- auto_ptr guard(actEnv); -+ Guard guard(actEnv); - - EnvBaseT* callerEnv = callStack.back(); - EnvBaseT* oldNewEnv = callerEnv->GetNewEnv(); -@@ -5163,146 +5076,13 @@ - _retTree = _t; - } - --ArrayIndexListT* GDLInterpreter::arrayindex_list_noassoc(ProgNodeP _t) { -- ArrayIndexListT* aL; -- ProgNodeP arrayindex_list_noassoc_AST_in = (_t == ProgNodeP(ASTNULL)) ? ProgNodeP(antlr::nullAST) : _t; -- -- IxExprListT cleanupList; // for cleanup -- IxExprListT ixExprList; -- SizeT nExpr; -- BaseGDL* s; -- -- // ProgNodeP retTree = _t->getNextSibling(); -- ProgNodeP ax = _t; -- // match(antlr::RefAST(_t),ARRAYIX); -- _t = _t->getFirstChild(); -- -- aL = ax->arrIxListNoAssoc; -- assert( aL != NULL); -- -- nExpr = aL->NParam(); -- if( nExpr == 0) -- { -- aL->Init(); -- _retTree = ax->getNextSibling();//retTree; -- return aL; -- } -- -- while( true) { -- assert( _t != NULL); -- if( NonCopyNode( _t->getType())) -- { -- s= _t->EvalNC(); //indexable_expr(_t); -- //_t = _retTree; -- } -- else if( _t->getType() == GDLTokenTypes::FCALL_LIB) -- { -- s=lib_function_call(_t); -- //_t = _retTree; -- if( !callStack.back()->Contains( s)) -- cleanupList.push_back( s); -- } -- else -- { -- s=_t->Eval(); //indexable_tmp_expr(_t); -- //_t = _retTree; -- cleanupList.push_back( s); -- } -- -- ixExprList.push_back( s); -- if( ixExprList.size() == nExpr) -- break; // allows some manual tuning -- -- _t = _t->getNextSibling(); -- } -- -- aL->Init( ixExprList, &cleanupList); -- -- _retTree = ax->getNextSibling();//retTree; -- return aL; -- -- -- ProgNodeP __t148 = _t; -- ProgNodeP tmp106_AST_in = _t; -- match(antlr::RefAST(_t),ARRAYIX); -- _t = _t->getFirstChild(); -- { // ( ... )* -- for (;;) { -- if (_t == ProgNodeP(antlr::nullAST) ) -- _t = ASTNULL; -- if ((_tokenSet_1.member(_t->getType()))) { -- { -- if (_t == ProgNodeP(antlr::nullAST) ) -- _t = ASTNULL; -- switch ( _t->getType()) { -- case CONSTANT: -- case DEREF: -- case SYSVAR: -- case VAR: -- case VARPTR: -- { -- s=indexable_expr(_t); -- _t = _retTree; -- break; -- } -- case FCALL_LIB: -- { -- s=lib_function_call(_t); -- _t = _retTree; -- break; -- } -- case ASSIGN: -- case ASSIGN_REPLACE: -- case ASSIGN_ARRAYEXPR_MFCALL: -- case ARRAYDEF: -- case ARRAYEXPR: -- case ARRAYEXPR_MFCALL: -- case EXPR: -- case FCALL: -- case FCALL_LIB_RETNEW: -- case MFCALL: -- case MFCALL_PARENT: -- case NSTRUC: -- case NSTRUC_REF: -- case POSTDEC: -- case POSTINC: -- case STRUC: -- case DEC: -- case INC: -- case DOT: -- case QUESTION: -- { -- s=indexable_tmp_expr(_t); -- _t = _retTree; -- break; -- } -- default: -- { -- throw antlr::NoViableAltException(antlr::RefAST(_t)); -- } -- } -- } -- } -- else { -- goto _loop151; -- } -- -- } -- _loop151:; -- } // ( ... )* -- _t = __t148; -- _t = _t->getNextSibling(); -- _retTree = _t; -- return aL; --} -- - void GDLInterpreter::arrayindex_list_overload(ProgNodeP _t, - IxExprListT& indexList - ) { - ProgNodeP arrayindex_list_overload_AST_in = (_t == ProgNodeP(ASTNULL)) ? ProgNodeP(antlr::nullAST) : _t; - - ArrayIndexListT* aL; -- IxExprListT cleanupList; // for cleanup -+ // IxExprListT cleanupList; // for cleanup - IxExprListT ixExprList; - SizeT nExpr; - BaseGDL* s; -@@ -5314,15 +5094,17 @@ - - aL = ax->arrIxListNoAssoc; - assert( aL != NULL); -- -+ - nExpr = aL->NParam(); - if( nExpr == 0) - { -- aL->InitAsOverloadIndex( ixExprList, NULL, indexList); -+ aL->InitAsOverloadIndex( ixExprList, /* NULL,*/ indexList); - _retTree = ax->getNextSibling();//retTree; - return; - } - -+ IxExprListT* cleanupList = aL->GetCleanupIx(); -+ - while( true) { - assert( _t != NULL); - if( NonCopyNode( _t->getType())) -@@ -5332,16 +5114,17 @@ - } - else if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- s=lib_function_call(_t); -+ // s=lib_function_call(_t); -+ s = static_cast(_t)->EvalFCALL_LIB(); - //_t = _retTree; - if( !callStack.back()->Contains( s)) -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - else - { - s=_t->Eval(); //indexable_tmp_expr(_t); - //_t = _retTree; -- cleanupList.push_back( s); -+ cleanupList->push_back( s); - } - - ixExprList.push_back( s); -@@ -5351,14 +5134,14 @@ - _t = _t->getNextSibling(); - } - -- aL->InitAsOverloadIndex( ixExprList, &cleanupList, indexList); -+ aL->InitAsOverloadIndex( ixExprList, /*&cleanupList,*/ indexList); - - _retTree = ax->getNextSibling();//retTree; - return; - - -- ProgNodeP __t153 = _t; -- ProgNodeP tmp107_AST_in = _t; -+ ProgNodeP __t148 = _t; -+ ProgNodeP tmp106_AST_in = _t; - match(antlr::RefAST(_t),ARRAYIX); - _t = _t->getFirstChild(); - { // ( ... )* -@@ -5419,13 +5202,13 @@ - } - } - else { -- goto _loop156; -+ goto _loop151; - } - - } -- _loop156:; -+ _loop151:; - } // ( ... )* -- _t = __t153; -+ _t = __t148; - _t = _t->getNextSibling(); - _retTree = _t; - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLInterpreter.hpp gdl/src/GDLInterpreter.hpp ---- gdl-0.9.3/src/GDLInterpreter.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLInterpreter.hpp 2013-07-31 09:41:43.636246754 -0600 -@@ -3,7 +3,7 @@ - - #include - #include "GDLInterpreterTokenTypes.hpp" --/* $ANTLR 2.7.7 (20110618): "gdlc.i.g" -> "GDLInterpreter.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.i.g" -> "GDLInterpreter.hpp"$ */ - #include - - -@@ -116,8 +116,11 @@ - static int GetFunIx( const std::string& subName); - static int GetProIx( ProgNodeP);//const std::string& subName); - static int GetProIx( const std::string& subName); -- DStructGDL* ObjectStruct( BaseGDL* self, ProgNodeP mp); -- DStructGDL* ObjectStructCheckAccess( BaseGDL* self, ProgNodeP mp); -+ DStructGDL* ObjectStruct( DObjGDL* self, ProgNodeP mp); -+ void SetRootR( ProgNodeP tt, DotAccessDescT* aD, BaseGDL* r, ArrayIndexListT* aL); -+ void SetRootL( ProgNodeP tt, DotAccessDescT* aD, BaseGDL* r, ArrayIndexListT* aL); -+ // DStructGDL* ObjectStructCheckAccess( DObjGDL* self, ProgNodeP mp); -+ // DStructDesc* GDLObjectDesc( DObjGDL* self, ProgNodeP mp); - - // code in: dinterpreter.cpp - static void SetFunIx( ProgNodeP f); // triggers read/compile -@@ -145,8 +148,10 @@ - { - public: - enum ExCode { -- NONE=0, // normal RETALL -- RUN // RETALL from .RUN command -+ NONE=0 // normal RETALL -+ ,RUN // RETALL from .RUN command -+ ,RESET // RETALL from .RESET command -+ ,FULL_RESET // RETALL from .FULL_RESET command - }; - - private: -@@ -263,6 +268,13 @@ - } - } - } -+ static void HeapErase( DPtr id) // for LIST -+ { -+ if( id != 0) -+ { -+ heap.erase( id); -+ } -+ } - static void FreeHeapDirect( DPtr id, HeapT::iterator it) - { - delete (*it).second.get(); -@@ -349,7 +361,7 @@ - } - static void DecRefObj( DObjGDL* p) - { -- SizeT nEl=p->N_Elements(); -+ SizeT nEl=p->Size();//N_Elements(); - for( SizeT ix=0; ix < nEl; ix++) - { - DObj id= (*p)[ix]; -@@ -426,7 +438,7 @@ - } - static void IncRefObj( DObjGDL* p) - { -- SizeT nEl=p->N_Elements(); -+ SizeT nEl=p->Size();//N_Elements(); - for( SizeT ix=0; ix < nEl; ix++) - { - DObj id= (*p)[ix]; -@@ -439,13 +451,15 @@ - static BaseGDL*& GetHeap( DPtr ID) - { - HeapT::iterator it=heap.find( ID); -- if( it == heap.end()) throw HeapException(); -+ if( it == heap.end()) -+ throw HeapException(); - return it->second.get(); - } - static DStructGDL*& GetObjHeap( DObj ID) - { - ObjHeapT::iterator it=objHeap.find( ID); -- if( it == objHeap.end()) throw HeapException(); -+ if( it == objHeap.end()) -+ throw HeapException(); - return it->second.get(); - } - -@@ -457,12 +471,12 @@ - if( it == objHeap.end()) return NULL; - return it->second.get()->Desc()->GetOperator( opIx); - } -- // static DStructGDL* GetObjHeapNoThrow( DObj ID) -- // { -- // ObjHeapT::iterator it=objHeap.find( ID); -- // if( it == objHeap.end()) return NULL; -- // return it->second.get(); -- // } -+ static DStructGDL* GetObjHeapNoThrow( DObj ID) -+ { -+ ObjHeapT::iterator it=objHeap.find( ID); -+ if( it == objHeap.end()) return NULL; -+ return it->second.get(); -+ } - // static DStructGDL*& GetObjHeap( DObj ID, ObjHeapT::iterator& it) - // { - // // ObjHeapT::iterator it=objHeap.find( ID); -@@ -576,6 +590,21 @@ - return ret; - } - -+ -+ static void ResetHeap() // purges both heaps -+ { -+ for( HeapT::iterator it=heap.begin(); it != heap.end(); ++it) -+ { -+ delete (*it).second.get(); -+ heap.erase( it->first); -+ } -+ for( ObjHeapT::iterator it=objHeap.begin(); it != objHeap.end(); ++it) -+ { -+ delete (*it).second.get(); -+ objHeap.erase( it->first); -+ } -+ } -+ - // name of data - static const std::string Name( BaseGDL* p) // const - { -@@ -592,6 +621,9 @@ - return "<(ptr to undefined expression not found on the heap)>"; - } - -+ -+ -+ - // compiler (lexer, parser, treeparser) def in dinterpreter.cpp - static void ReportCompileError( GDLException& e, const std::string& file = ""); - -@@ -639,17 +671,22 @@ - { - DString msgPrefix = SysVar::MsgPrefix(); - -- EnvStackT::reverse_iterator upEnv = callStack.rbegin(); -- //EnvStackT::reverse_iterator env = upEnv++; -- upEnv++; -- for(; -- upEnv != callStack.rend(); -- ++upEnv /*,++env*/) -+ // EnvStackT::reverse_iterator upEnv = callStack.rbegin(); -+ // //EnvStackT::reverse_iterator env = upEnv++; -+ // upEnv++; -+ // for(; -+ // upEnv != callStack.rend(); -+ // ++upEnv /*,++env*/) -+ -+ long actIx = callStack.size() - 2; -+ for( ; actIx >= 0; --actIx) - { -+ EnvStackT::pointer_type upEnv = callStack[ actIx]; -+ - std::cerr << msgPrefix << std::right << std::setw( w) << ""; -- std::cerr << std::left << std::setw(16) << (*upEnv)->GetProName(); -+ std::cerr << std::left << std::setw(16) << upEnv->GetProName(); - -- std::string file = (*upEnv)->GetFilename(); -+ std::string file = upEnv->GetFilename(); - if( file != "") - { - // ProgNodeP cNode= (*env)->CallingNode(); -@@ -661,14 +698,13 @@ - // { - // std::cerr << std::right << std::setw(6) << ""; - // } -- - // ProgNodeP cNode= (*env)->CallingNode(); - // if( cNode != NULL && cNode->getLine() != 0) - // { - // (*upEnv)->SetLineNumber( cNode->getLine()); - // } - -- int lineNumber = (*upEnv)->GetLineNumber(); -+ int lineNumber = upEnv->GetLineNumber(); - if( lineNumber != 0) - { - std::cerr << std::right << std::setw(6) << lineNumber; -@@ -823,7 +859,6 @@ - public: void parameter_def_nocheck(ProgNodeP _t, - EnvBaseT* actEnv - ); -- public: ArrayIndexListT* arrayindex_list_noassoc(ProgNodeP _t); - public: void arrayindex_list_overload(ProgNodeP _t, - IxExprListT& indexList - ); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLInterpreterTokenTypes.hpp gdl/src/GDLInterpreterTokenTypes.hpp ---- gdl-0.9.3/src/GDLInterpreterTokenTypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLInterpreterTokenTypes.hpp 2013-05-16 12:36:32.000000000 -0600 -@@ -1,7 +1,7 @@ - #ifndef INC_GDLInterpreterTokenTypes_hpp_ - #define INC_GDLInterpreterTokenTypes_hpp_ - --/* $ANTLR 2.7.7 (20110618): "gdlc.i.g" -> "GDLInterpreterTokenTypes.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.i.g" -> "GDLInterpreterTokenTypes.hpp"$ */ - - #ifndef CUSTOM_API - # define CUSTOM_API -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLInterpreterTokenTypes.txt gdl/src/GDLInterpreterTokenTypes.txt ---- gdl-0.9.3/src/GDLInterpreterTokenTypes.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLInterpreterTokenTypes.txt 2013-05-16 12:36:32.000000000 -0600 -@@ -1,4 +1,4 @@ --// $ANTLR 2.7.7 (20110618): gdlc.i.g -> GDLInterpreterTokenTypes.txt$ -+// $ANTLR 2.7.7 (20120518): gdlc.i.g -> GDLInterpreterTokenTypes.txt$ - GDLInterpreter // output token vocab name - ALL=4 - ASSIGN=5 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLLexer.cpp gdl/src/GDLLexer.cpp ---- gdl-0.9.3/src/GDLLexer.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLLexer.cpp 2013-07-08 12:39:21.384399178 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "gdlc.g" -> "GDLLexer.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.g" -> "GDLLexer.cpp"$ */ - - #include "includefirst.hpp" - -@@ -38,45 +38,45 @@ - { - literals["endcase"] = 98; - literals["case"] = 92; -+ literals["while"] = 88; - literals["repeat"] = 78; -- literals["endforeach"] = 101; - literals["ne"] = 117; -+ literals["endif"] = 102; - literals["end"] = 97; - literals["le"] = 114; - literals["then"] = 124; -- literals["begin"] = 91; - literals["endswitch"] = 104; -+ literals["until"] = 125; - literals["and"] = 90; - literals["endrep"] = 103; - literals["not"] = 118; -- literals["on_ioerror"] = 120; -+ literals["foreach"] = 32; - literals["mod"] = 116; -+ literals["forward_function"] = 107; - literals["do"] = 95; - literals["function"] = 108; - literals["endfor"] = 100; - literals["gt"] = 111; -+ literals["compile_opt"] = 94; - literals["inherits"] = 113; - literals["of"] = 119; - literals["or"] = 121; - literals["if"] = 112; - literals["pro"] = 122; - literals["xor"] = 126; -- literals["compile_opt"] = 94; - literals["ge"] = 109; - literals["goto"] = 110; - literals["for"] = 30; - literals["eq"] = 106; -- literals["forward_function"] = 107; -- literals["foreach"] = 32; -+ literals["on_ioerror"] = 120; - literals["endelse"] = 99; -- literals["until"] = 125; -+ literals["begin"] = 91; - literals["else"] = 96; - literals["lt"] = 115; - literals["endwhile"] = 105; - literals["switch"] = 123; - literals["common"] = 93; -- literals["endif"] = 102; -- literals["while"] = 88; -+ literals["endforeach"] = 101; - } - - antlr::RefToken GDLLexer::nextToken() -@@ -400,11 +400,11 @@ - } - } - else { -- goto _loop261; -+ goto _loop265; - } - - } -- _loop261:; -+ _loop265:; - } // ( ... )* - if ( _createToken && _token==antlr::nullToken && _ttype!=antlr::Token::SKIP ) { - _token = makeToken(_ttype); -@@ -1152,10 +1152,10 @@ - std::string::size_type _saveIndex; - - { -- bool synPredMatched313 = false; -+ bool synPredMatched317 = false; - if (((LA(1) == 0xd /* '\r' */ ) && (LA(2) == 0xa /* '\n' */ ) && (true))) { -- int _m313 = mark(); -- synPredMatched313 = true; -+ int _m317 = mark(); -+ synPredMatched317 = true; - inputState->guessing++; - try { - { -@@ -1163,12 +1163,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched313 = false; -+ synPredMatched317 = false; - } -- rewind(_m313); -+ rewind(_m317); - inputState->guessing--; - } -- if ( synPredMatched313 ) { -+ if ( synPredMatched317 ) { - match("\r\n"); - } - else if ((LA(1) == 0xa /* '\n' */ )) { -@@ -1419,18 +1419,18 @@ - } - } - { // ( ... )+ -- int _cnt331=0; -+ int _cnt335=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt331>=1 ) { goto _loop331; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt335>=1 ) { goto _loop335; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt331++; -+ _cnt335++; - } -- _loop331:; -+ _loop335:; - } // ( ... )+ - } - else { -@@ -1504,18 +1504,18 @@ - } - } - { // ( ... )+ -- int _cnt338=0; -+ int _cnt342=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt338>=1 ) { goto _loop338; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt342>=1 ) { goto _loop342; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt338++; -+ _cnt342++; - } -- _loop338:; -+ _loop342:; - } // ( ... )+ - } - else { -@@ -1939,27 +1939,27 @@ - _ttype = CONSTANT_OR_STRING_LITERAL; - std::string::size_type _saveIndex; - -- bool synPredMatched384 = false; -+ bool synPredMatched388 = false; - if (((LA(1) == 0x27 /* '\'' */ ) && (_tokenSet_4.member(LA(2))) && (_tokenSet_5.member(LA(3))))) { -- int _m384 = mark(); -- synPredMatched384 = true; -+ int _m388 = mark(); -+ synPredMatched388 = true; - inputState->guessing++; - try { - { - match('\'' /* charlit */ ); - { // ( ... )+ -- int _cnt382=0; -+ int _cnt386=0; - for (;;) { - if ((_tokenSet_4.member(LA(1)))) { - mH(false); - } - else { -- if ( _cnt382>=1 ) { goto _loop382; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt386>=1 ) { goto _loop386; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt382++; -+ _cnt386++; - } -- _loop382:; -+ _loop386:; - } // ( ... )+ - match('\'' /* charlit */ ); - { -@@ -1995,29 +1995,29 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched384 = false; -+ synPredMatched388 = false; - } -- rewind(_m384); -+ rewind(_m388); - inputState->guessing--; - } -- if ( synPredMatched384 ) { -+ if ( synPredMatched388 ) { - { - _saveIndex = text.length(); - match('\'' /* charlit */ ); - text.erase(_saveIndex); - { // ( ... )+ -- int _cnt387=0; -+ int _cnt391=0; - for (;;) { - if ((_tokenSet_4.member(LA(1)))) { - mH(false); - } - else { -- if ( _cnt387>=1 ) { goto _loop387; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt391>=1 ) { goto _loop391; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt387++; -+ _cnt391++; - } -- _loop387:; -+ _loop391:; - } // ( ... )+ - _saveIndex = text.length(); - match('\'' /* charlit */ ); -@@ -2114,27 +2114,27 @@ - } - } - else { -- bool synPredMatched393 = false; -+ bool synPredMatched397 = false; - if (((LA(1) == 0x27 /* '\'' */ ) && ((LA(2) >= 0x30 /* '0' */ && LA(2) <= 0x37 /* '7' */ )) && (_tokenSet_6.member(LA(3))))) { -- int _m393 = mark(); -- synPredMatched393 = true; -+ int _m397 = mark(); -+ synPredMatched397 = true; - inputState->guessing++; - try { - { - match('\'' /* charlit */ ); - { // ( ... )+ -- int _cnt391=0; -+ int _cnt395=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x37 /* '7' */ ))) { - mO(false); - } - else { -- if ( _cnt391>=1 ) { goto _loop391; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt395>=1 ) { goto _loop395; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt391++; -+ _cnt395++; - } -- _loop391:; -+ _loop395:; - } // ( ... )+ - match('\'' /* charlit */ ); - { -@@ -2161,29 +2161,29 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched393 = false; -+ synPredMatched397 = false; - } -- rewind(_m393); -+ rewind(_m397); - inputState->guessing--; - } -- if ( synPredMatched393 ) { -+ if ( synPredMatched397 ) { - { - _saveIndex = text.length(); - match('\'' /* charlit */ ); - text.erase(_saveIndex); - { // ( ... )+ -- int _cnt396=0; -+ int _cnt400=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x37 /* '7' */ ))) { - mO(false); - } - else { -- if ( _cnt396>=1 ) { goto _loop396; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt400>=1 ) { goto _loop400; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt396++; -+ _cnt400++; - } -- _loop396:; -+ _loop400:; - } // ( ... )+ - _saveIndex = text.length(); - match('\'' /* charlit */ ); -@@ -2280,27 +2280,27 @@ - } - } - else { -- bool synPredMatched402 = false; -+ bool synPredMatched406 = false; - if (((LA(1) == 0x27 /* '\'' */ ) && (LA(2) == 0x30 /* '0' */ || LA(2) == 0x31 /* '1' */ ) && (LA(3) == 0x27 /* '\'' */ || LA(3) == 0x30 /* '0' */ || LA(3) == 0x31 /* '1' */ ))) { -- int _m402 = mark(); -- synPredMatched402 = true; -+ int _m406 = mark(); -+ synPredMatched406 = true; - inputState->guessing++; - try { - { - match('\'' /* charlit */ ); - { // ( ... )+ -- int _cnt400=0; -+ int _cnt404=0; - for (;;) { - if ((LA(1) == 0x30 /* '0' */ || LA(1) == 0x31 /* '1' */ )) { - mB(false); - } - else { -- if ( _cnt400>=1 ) { goto _loop400; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt404>=1 ) { goto _loop404; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt400++; -+ _cnt404++; - } -- _loop400:; -+ _loop404:; - } // ( ... )+ - match('\'' /* charlit */ ); - { -@@ -2327,29 +2327,29 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched402 = false; -+ synPredMatched406 = false; - } -- rewind(_m402); -+ rewind(_m406); - inputState->guessing--; - } -- if ( synPredMatched402 ) { -+ if ( synPredMatched406 ) { - { - _saveIndex = text.length(); - match('\'' /* charlit */ ); - text.erase(_saveIndex); - { // ( ... )+ -- int _cnt405=0; -+ int _cnt409=0; - for (;;) { - if ((LA(1) == 0x30 /* '0' */ || LA(1) == 0x31 /* '1' */ )) { - mB(false); - } - else { -- if ( _cnt405>=1 ) { goto _loop405; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt409>=1 ) { goto _loop409; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt405++; -+ _cnt409++; - } -- _loop405:; -+ _loop409:; - } // ( ... )+ - _saveIndex = text.length(); - match('\'' /* charlit */ ); -@@ -2446,27 +2446,27 @@ - } - } - else { -- bool synPredMatched375 = false; -+ bool synPredMatched379 = false; - if (((LA(1) == 0x22 /* '\"' */ ) && ((LA(2) >= 0x30 /* '0' */ && LA(2) <= 0x37 /* '7' */ )) && (true))) { -- int _m375 = mark(); -- synPredMatched375 = true; -+ int _m379 = mark(); -+ synPredMatched379 = true; - inputState->guessing++; - try { - { - match('\"' /* charlit */ ); - { // ( ... )+ -- int _cnt373=0; -+ int _cnt377=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x37 /* '7' */ ))) { - mO(false); - } - else { -- if ( _cnt373>=1 ) { goto _loop373; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt377>=1 ) { goto _loop377; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt373++; -+ _cnt377++; - } -- _loop373:; -+ _loop377:; - } // ( ... )+ - { - switch ( LA(1)) { -@@ -2505,29 +2505,29 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched375 = false; -+ synPredMatched379 = false; - } -- rewind(_m375); -+ rewind(_m379); - inputState->guessing--; - } -- if ( synPredMatched375 ) { -+ if ( synPredMatched379 ) { - { - _saveIndex = text.length(); - match('\"' /* charlit */ ); - text.erase(_saveIndex); - { // ( ... )+ -- int _cnt378=0; -+ int _cnt382=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x37 /* '7' */ ))) { - mO(false); - } - else { -- if ( _cnt378>=1 ) { goto _loop378; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt382>=1 ) { goto _loop382; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt378++; -+ _cnt382++; - } -- _loop378:; -+ _loop382:; - } // ( ... )+ - if ( inputState->guessing==0 ) { - _ttype=CONSTANT_OCT_I; -@@ -2618,10 +2618,10 @@ - } - } - else { -- bool synPredMatched426 = false; -+ bool synPredMatched430 = false; - if (((_tokenSet_7.member(LA(1))) && (_tokenSet_8.member(LA(2))) && (true))) { -- int _m426 = mark(); -- synPredMatched426 = true; -+ int _m430 = mark(); -+ synPredMatched430 = true; - inputState->guessing++; - try { - { -@@ -2639,18 +2639,18 @@ - { - { - { // ( ... )+ -- int _cnt418=0; -+ int _cnt422=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt418>=1 ) { goto _loop418; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt422>=1 ) { goto _loop422; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt418++; -+ _cnt422++; - } -- _loop418:; -+ _loop422:; - } // ( ... )+ - { - switch ( LA(1)) { -@@ -2668,11 +2668,11 @@ - mD(false); - } - else { -- goto _loop421; -+ goto _loop425; - } - - } -- _loop421:; -+ _loop425:; - } // ( ... )* - { - mDBL(false); -@@ -2692,18 +2692,18 @@ - { - match('.' /* charlit */ ); - { // ( ... )+ -- int _cnt424=0; -+ int _cnt428=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt424>=1 ) { goto _loop424; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt428>=1 ) { goto _loop428; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt424++; -+ _cnt428++; - } -- _loop424:; -+ _loop428:; - } // ( ... )+ - { - mDBL(false); -@@ -2718,12 +2718,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched426 = false; -+ synPredMatched430 = false; - } -- rewind(_m426); -+ rewind(_m430); - inputState->guessing--; - } -- if ( synPredMatched426 ) { -+ if ( synPredMatched430 ) { - { - switch ( LA(1)) { - case 0x30 /* '0' */ : -@@ -2739,18 +2739,18 @@ - { - { - { // ( ... )+ -- int _cnt430=0; -+ int _cnt434=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt430>=1 ) { goto _loop430; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt434>=1 ) { goto _loop434; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt430++; -+ _cnt434++; - } -- _loop430:; -+ _loop434:; - } // ( ... )+ - { - switch ( LA(1)) { -@@ -2768,11 +2768,11 @@ - mD(false); - } - else { -- goto _loop433; -+ goto _loop437; - } - - } -- _loop433:; -+ _loop437:; - } // ( ... )* - { - mDBL(false); -@@ -2792,18 +2792,18 @@ - { - match('.' /* charlit */ ); - { // ( ... )+ -- int _cnt436=0; -+ int _cnt440=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt436>=1 ) { goto _loop436; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt440>=1 ) { goto _loop440; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt436++; -+ _cnt440++; - } -- _loop436:; -+ _loop440:; - } // ( ... )+ - { - mDBL(false); -@@ -2821,10 +2821,10 @@ - } - } - else { -- bool synPredMatched449 = false; -+ bool synPredMatched453 = false; - if (((_tokenSet_7.member(LA(1))) && (_tokenSet_9.member(LA(2))) && (true))) { -- int _m449 = mark(); -- synPredMatched449 = true; -+ int _m453 = mark(); -+ synPredMatched453 = true; - inputState->guessing++; - try { - { -@@ -2842,18 +2842,18 @@ - { - { - { // ( ... )+ -- int _cnt441=0; -+ int _cnt445=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt441>=1 ) { goto _loop441; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt445>=1 ) { goto _loop445; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt441++; -+ _cnt445++; - } -- _loop441:; -+ _loop445:; - } // ( ... )+ - { - switch ( LA(1)) { -@@ -2871,11 +2871,11 @@ - mD(false); - } - else { -- goto _loop444; -+ goto _loop448; - } - - } -- _loop444:; -+ _loop448:; - } // ( ... )* - { - if ((LA(1) == 0x65 /* 'e' */ )) { -@@ -2900,18 +2900,18 @@ - { - match('.' /* charlit */ ); - { // ( ... )+ -- int _cnt447=0; -+ int _cnt451=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt447>=1 ) { goto _loop447; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt451>=1 ) { goto _loop451; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt447++; -+ _cnt451++; - } -- _loop447:; -+ _loop451:; - } // ( ... )+ - { - if ((LA(1) == 0x65 /* 'e' */ )) { -@@ -2931,12 +2931,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched449 = false; -+ synPredMatched453 = false; - } -- rewind(_m449); -+ rewind(_m453); - inputState->guessing--; - } -- if ( synPredMatched449 ) { -+ if ( synPredMatched453 ) { - { - switch ( LA(1)) { - case 0x30 /* '0' */ : -@@ -2952,18 +2952,18 @@ - { - { - { // ( ... )+ -- int _cnt453=0; -+ int _cnt457=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt453>=1 ) { goto _loop453; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt457>=1 ) { goto _loop457; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt453++; -+ _cnt457++; - } -- _loop453:; -+ _loop457:; - } // ( ... )+ - { - switch ( LA(1)) { -@@ -2981,11 +2981,11 @@ - mD(false); - } - else { -- goto _loop456; -+ goto _loop460; - } - - } -- _loop456:; -+ _loop460:; - } // ( ... )* - { - if ((LA(1) == 0x65 /* 'e' */ )) { -@@ -3010,18 +3010,18 @@ - { - match('.' /* charlit */ ); - { // ( ... )+ -- int _cnt459=0; -+ int _cnt463=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt459>=1 ) { goto _loop459; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt463>=1 ) { goto _loop463; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt459++; -+ _cnt463++; - } -- _loop459:; -+ _loop463:; - } // ( ... )+ - { - if ((LA(1) == 0x65 /* 'e' */ )) { -@@ -3061,11 +3061,11 @@ - } - } - else { -- goto _loop409; -+ goto _loop413; - } - - } -- _loop409:; -+ _loop413:; - } // ( ... )* - { - if ((LA(1) == 0x22 /* '\"' */ )) { -@@ -3099,11 +3099,11 @@ - } - } - else { -- goto _loop413; -+ goto _loop417; - } - - } -- _loop413:; -+ _loop417:; - } // ( ... )* - { - if ((LA(1) == 0x27 /* '\'' */ )) { -@@ -3127,18 +3127,18 @@ - } - else if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ )) && (true) && (true)) { - { // ( ... )+ -- int _cnt462=0; -+ int _cnt466=0; - for (;;) { - if (((LA(1) >= 0x30 /* '0' */ && LA(1) <= 0x39 /* '9' */ ))) { - mD(false); - } - else { -- if ( _cnt462>=1 ) { goto _loop462; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt466>=1 ) { goto _loop466; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt462++; -+ _cnt466++; - } -- _loop462:; -+ _loop466:; - } // ( ... )+ - if ( inputState->guessing==0 ) { - _ttype=CONSTANT_I; -@@ -3255,11 +3255,11 @@ - } - } - else { -- goto _loop468; -+ goto _loop472; - } - - } -- _loop468:; -+ _loop472:; - } // ( ... )* - if ( inputState->guessing==0 ) { - _ttype=antlr::Token::SKIP; -@@ -3335,11 +3335,11 @@ - } - default: - { -- goto _loop472; -+ goto _loop476; - } - } - } -- _loop472:; -+ _loop476:; - } // ( ... )* - if ( inputState->guessing==0 ) { - -@@ -3365,7 +3365,7 @@ - match('!' /* charlit */ ); - } - { // ( ... )+ -- int _cnt476=0; -+ int _cnt480=0; - for (;;) { - switch ( LA(1)) { - case 0x5f /* '_' */ : -@@ -3420,12 +3420,12 @@ - } - default: - { -- if ( _cnt476>=1 ) { goto _loop476; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt480>=1 ) { goto _loop480; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - } -- _cnt476++; -+ _cnt480++; - } -- _loop476:; -+ _loop480:; - } // ( ... )+ - if ( inputState->guessing==0 ) { - -@@ -3464,18 +3464,18 @@ - std::string::size_type _saveIndex; - - { // ( ... )+ -- int _cnt480=0; -+ int _cnt484=0; - for (;;) { - if ((LA(1) == 0x9 /* '\t' */ || LA(1) == 0xc /* '\14' */ || LA(1) == 0x20 /* ' ' */ )) { - mW(false); - } - else { -- if ( _cnt480>=1 ) { goto _loop480; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} -+ if ( _cnt484>=1 ) { goto _loop484; } else {throw antlr::NoViableAltForCharException(LA(1), getFilename(), getLine(), getColumn());} - } - -- _cnt480++; -+ _cnt484++; - } -- _loop480:; -+ _loop484:; - } // ( ... )+ - if ( inputState->guessing==0 ) { - _ttype=antlr::Token::SKIP; -@@ -3516,11 +3516,11 @@ - } - default: - { -- goto _loop483; -+ goto _loop487; - } - } - } -- _loop483:; -+ _loop487:; - } // ( ... )* - if ( _createToken && _token==antlr::nullToken && _ttype!=antlr::Token::SKIP ) { - _token = makeToken(_ttype); -@@ -3544,11 +3544,11 @@ - } - } - else { -- goto _loop487; -+ goto _loop491; - } - - } -- _loop487:; -+ _loop491:; - } // ( ... )* - mEOL(false); - mSKIP_LINES(false); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLLexer.hpp gdl/src/GDLLexer.hpp ---- gdl-0.9.3/src/GDLLexer.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLLexer.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -2,7 +2,7 @@ - #define INC_GDLLexer_hpp_ - - #include --/* $ANTLR 2.7.7 (20110618): "gdlc.g" -> "GDLLexer.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.g" -> "GDLLexer.hpp"$ */ - #include - #include - #include -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLParser.cpp gdl/src/GDLParser.cpp ---- gdl-0.9.3/src/GDLParser.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLParser.cpp 2013-07-08 12:39:21.406398917 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "gdlc.g" -> "GDLParser.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.g" -> "GDLParser.cpp"$ */ - - #include "includefirst.hpp" - -@@ -6772,6 +6772,9 @@ - returnAST = RefDNode(antlr::nullAST); - antlr::ASTPair currentAST; - RefDNode arrayindex_list_AST = RefDNode(antlr::nullAST); -+ -+ int rank = 1; -+ - - switch ( LA(1)) { - case LSQUARE: -@@ -6810,7 +6813,7 @@ - } - { // ( ... )* - for (;;) { -- if ((LA(1) == COMMA)) { -+ if (((LA(1) == COMMA))&&(++rank <= MAXRANK)) { - match(COMMA); - arrayindex(); - if (inputState->guessing==0) { -@@ -7894,12 +7897,114 @@ - returnAST = member_function_call_dot_AST; - } - -+void GDLParser::arrayexpr_mfcall() { -+ returnAST = RefDNode(antlr::nullAST); -+ antlr::ASTPair currentAST; -+ RefDNode arrayexpr_mfcall_AST = RefDNode(antlr::nullAST); -+ RefDNode a1_AST = RefDNode(antlr::nullAST); -+ RefDNode t1_AST = RefDNode(antlr::nullAST); -+ antlr::RefToken id = antlr::nullToken; -+ RefDNode id_AST = RefDNode(antlr::nullAST); -+ RefDNode al_AST = RefDNode(antlr::nullAST); -+ RefDNode deref_arrayexpr_mfcall_AST = RefDNode(antlr::nullAST); -+ -+ RefDNode dot; -+ RefDNode tag; -+ int nDot; -+ -+ -+ switch ( LA(1)) { -+ case IDENTIFIER: -+ case INHERITS: -+ case LBRACE: -+ case SYSVARNAME: -+ { -+ array_expr_1st(); -+ if (inputState->guessing==0) { -+ a1_AST = returnAST; -+ } -+ { -+ nDot=tag_access_keeplast(); -+ if (inputState->guessing==0) { -+ t1_AST = returnAST; -+ } -+ if ( inputState->guessing==0 ) { -+ -+ if( --nDot > 0) -+ { -+ dot=astFactory->create(DOT,"DOT_A_MF"); -+ dot->SetNDot( nDot); -+ dot->SetLine( a1_AST->getLine()); -+ tag = RefDNode(astFactory->make((new antlr::ASTArray(3))->add(antlr::RefAST(dot))->add(antlr::RefAST(a1_AST))->add(antlr::RefAST(t1_AST)))); -+ } -+ -+ } -+ } -+ id = LT(1); -+ if ( inputState->guessing == 0 ) { -+ id_AST = astFactory->create(id); -+ } -+ match(IDENTIFIER); -+ arrayindex_list(); -+ if (inputState->guessing==0) { -+ al_AST = returnAST; -+ } -+ if ( inputState->guessing==0 ) { -+ arrayexpr_mfcall_AST = RefDNode(currentAST.root); -+ -+ if( nDot > 0) -+ arrayexpr_mfcall_AST = RefDNode(astFactory->make((new antlr::ASTArray(4))->add(antlr::RefAST(astFactory->create(ARRAYEXPR_MFCALL,"arrayexpr_mfcall")))->add(antlr::RefAST(tag))->add(antlr::RefAST(id_AST))->add(antlr::RefAST(al_AST)))); -+ else -+ arrayexpr_mfcall_AST = RefDNode(astFactory->make((new antlr::ASTArray(4))->add(antlr::RefAST(astFactory->create(ARRAYEXPR_MFCALL,"arrayexpr_mfcall")))->add(antlr::RefAST(a1_AST))->add(antlr::RefAST(id_AST))->add(antlr::RefAST(al_AST)))); -+ -+ currentAST.root = arrayexpr_mfcall_AST; -+ if ( arrayexpr_mfcall_AST!=RefDNode(antlr::nullAST) && -+ arrayexpr_mfcall_AST->getFirstChild() != RefDNode(antlr::nullAST) ) -+ currentAST.child = arrayexpr_mfcall_AST->getFirstChild(); -+ else -+ currentAST.child = arrayexpr_mfcall_AST; -+ currentAST.advanceChildToEnd(); -+ } -+ break; -+ } -+ case ASTERIX: -+ { -+ RefDNode tmp188_AST = RefDNode(antlr::nullAST); -+ if ( inputState->guessing == 0 ) { -+ tmp188_AST = astFactory->create(LT(1)); -+ } -+ match(ASTERIX); -+ arrayexpr_mfcall(); -+ if (inputState->guessing==0) { -+ deref_arrayexpr_mfcall_AST = returnAST; -+ } -+ if ( inputState->guessing==0 ) { -+ arrayexpr_mfcall_AST = RefDNode(currentAST.root); -+ arrayexpr_mfcall_AST = -+ RefDNode(astFactory->make((new antlr::ASTArray(2))->add(antlr::RefAST(astFactory->create(DEREF,"deref")))->add(antlr::RefAST(deref_arrayexpr_mfcall_AST)))); -+ currentAST.root = arrayexpr_mfcall_AST; -+ if ( arrayexpr_mfcall_AST!=RefDNode(antlr::nullAST) && -+ arrayexpr_mfcall_AST->getFirstChild() != RefDNode(antlr::nullAST) ) -+ currentAST.child = arrayexpr_mfcall_AST->getFirstChild(); -+ else -+ currentAST.child = arrayexpr_mfcall_AST; -+ currentAST.advanceChildToEnd(); -+ } -+ break; -+ } -+ default: -+ { -+ throw antlr::NoViableAltException(LT(1), getFilename()); -+ } -+ } -+ returnAST = arrayexpr_mfcall_AST; -+} -+ - void GDLParser::primary_expr() { - returnAST = RefDNode(antlr::nullAST); - antlr::ASTPair currentAST; - RefDNode primary_expr_AST = RefDNode(antlr::nullAST); - RefDNode d1_AST = RefDNode(antlr::nullAST); -- RefDNode d2_AST = RefDNode(antlr::nullAST); - RefDNode d3_AST = RefDNode(antlr::nullAST); - antlr::RefToken sl = antlr::nullToken; - RefDNode sl_AST = RefDNode(antlr::nullAST); -@@ -7982,10 +8087,10 @@ - break; - } - default: -- bool synPredMatched206 = false; -+ bool synPredMatched208 = false; - if (((_tokenSet_4.member(LA(1))) && (_tokenSet_5.member(LA(2))))) { -- int _m206 = mark(); -- synPredMatched206 = true; -+ int _m208 = mark(); -+ synPredMatched208 = true; - inputState->guessing++; - try { - { -@@ -7994,12 +8099,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched206 = false; -+ synPredMatched208 = false; - } -- rewind(_m206); -+ rewind(_m208); - inputState->guessing--; - } -- if ( synPredMatched206 ) { -+ if ( synPredMatched208 ) { - deref_dot_expr_keeplast(); - if (inputState->guessing==0) { - d1_AST = returnAST; -@@ -8029,10 +8134,10 @@ - primary_expr_AST = RefDNode(currentAST.root); - } - else { -- bool synPredMatched211 = false; -+ bool synPredMatched213 = false; - if (((_tokenSet_4.member(LA(1))) && (_tokenSet_5.member(LA(2))))) { -- int _m211 = mark(); -- synPredMatched211 = true; -+ int _m213 = mark(); -+ synPredMatched213 = true; - inputState->guessing++; - try { - { -@@ -8048,56 +8153,34 @@ - expr(); - } - else { -- goto _loop210; -+ goto _loop212; - } - - } -- _loop210:; -+ _loop212:; - } // ( ... )* - match(RBRACE); - } - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched211 = false; -+ synPredMatched213 = false; - } -- rewind(_m211); -+ rewind(_m213); - inputState->guessing--; - } -- if ( synPredMatched211 ) { -- deref_dot_expr_keeplast(); -- if (inputState->guessing==0) { -- d2_AST = returnAST; -- astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -- } -- RefDNode tmp188_AST = RefDNode(antlr::nullAST); -- if ( inputState->guessing == 0 ) { -- tmp188_AST = astFactory->create(LT(1)); -- astFactory->addASTChild(currentAST, antlr::RefAST(tmp188_AST)); -- } -- match(IDENTIFIER); -- arrayindex_list(); -+ if ( synPredMatched213 ) { -+ arrayexpr_mfcall(); - if (inputState->guessing==0) { - astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); - } -- if ( inputState->guessing==0 ) { -- primary_expr_AST = RefDNode(currentAST.root); -- primary_expr_AST = RefDNode(astFactory->make((new antlr::ASTArray(2))->add(antlr::RefAST(astFactory->create(ARRAYEXPR_MFCALL,"arrayexpr_mfcall")))->add(antlr::RefAST(primary_expr_AST)))); -- currentAST.root = primary_expr_AST; -- if ( primary_expr_AST!=RefDNode(antlr::nullAST) && -- primary_expr_AST->getFirstChild() != RefDNode(antlr::nullAST) ) -- currentAST.child = primary_expr_AST->getFirstChild(); -- else -- currentAST.child = primary_expr_AST; -- currentAST.advanceChildToEnd(); -- } - primary_expr_AST = RefDNode(currentAST.root); - } - else { -- bool synPredMatched213 = false; -+ bool synPredMatched215 = false; - if (((_tokenSet_4.member(LA(1))) && (_tokenSet_5.member(LA(2))))) { -- int _m213 = mark(); -- synPredMatched213 = true; -+ int _m215 = mark(); -+ synPredMatched215 = true; - inputState->guessing++; - try { - { -@@ -8106,12 +8189,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched213 = false; -+ synPredMatched215 = false; - } -- rewind(_m213); -+ rewind(_m215); - inputState->guessing--; - } -- if ( synPredMatched213 ) { -+ if ( synPredMatched215 ) { - deref_dot_expr_keeplast(); - if (inputState->guessing==0) { - d3_AST = returnAST; -@@ -8135,10 +8218,10 @@ - primary_expr_AST = RefDNode(currentAST.root); - } - else { -- bool synPredMatched215 = false; -+ bool synPredMatched217 = false; - if (((_tokenSet_4.member(LA(1))) && (_tokenSet_22.member(LA(2))))) { -- int _m215 = mark(); -- synPredMatched215 = true; -+ int _m217 = mark(); -+ synPredMatched217 = true; - inputState->guessing++; - try { - { -@@ -8146,12 +8229,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched215 = false; -+ synPredMatched217 = false; - } -- rewind(_m215); -+ rewind(_m217); - inputState->guessing--; - } -- if ( synPredMatched215 ) { -+ if ( synPredMatched217 ) { - deref_expr(); - if (inputState->guessing==0) { - astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -@@ -8234,10 +8317,10 @@ - primary_expr_AST = RefDNode(currentAST.root); - } - else { -- bool synPredMatched220 = false; -+ bool synPredMatched222 = false; - if (((LA(1) == IDENTIFIER || LA(1) == INHERITS) && (LA(2) == LBRACE || LA(2) == LSQUARE))) { -- int _m220 = mark(); -- synPredMatched220 = true; -+ int _m222 = mark(); -+ synPredMatched222 = true; - inputState->guessing++; - try { - { -@@ -8251,22 +8334,22 @@ - expr(); - } - else { -- goto _loop219; -+ goto _loop221; - } - - } -- _loop219:; -+ _loop221:; - } // ( ... )* - match(RBRACE); - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched220 = false; -+ synPredMatched222 = false; - } -- rewind(_m220); -+ rewind(_m222); - inputState->guessing--; - } -- if ( synPredMatched220 ) { -+ if ( synPredMatched222 ) { - { - if (((LA(1) == IDENTIFIER) && (LA(2) == LBRACE))&&( IsFun(LT(1)))) { - formal_function_call(); -@@ -8292,42 +8375,79 @@ - currentAST.advanceChildToEnd(); - } - } -- else if ((LA(1) == IDENTIFIER || LA(1) == INHERITS) && (LA(2) == LBRACE || LA(2) == LSQUARE)) { -- var(); -- if (inputState->guessing==0) { -- astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -+ else { -+ bool synPredMatched225 = false; -+ if (((LA(1) == IDENTIFIER || LA(1) == INHERITS) && (LA(2) == LBRACE || LA(2) == LSQUARE))) { -+ int _m225 = mark(); -+ synPredMatched225 = true; -+ inputState->guessing++; -+ try { -+ { -+ var(); -+ arrayindex_list(); -+ } -+ } -+ catch (antlr::RecognitionException& pe) { -+ synPredMatched225 = false; -+ } -+ rewind(_m225); -+ inputState->guessing--; - } -- arrayindex_list(); -- if (inputState->guessing==0) { -- astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -+ if ( synPredMatched225 ) { -+ var(); -+ if (inputState->guessing==0) { -+ astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -+ } -+ arrayindex_list(); -+ if (inputState->guessing==0) { -+ astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -+ } -+ if ( inputState->guessing==0 ) { -+ primary_expr_AST = RefDNode(currentAST.root); -+ -+ // std::cout << "***(IDENTIFIER LBRACE expr (COMMA expr)* RBRACE) 2" << std::endl; -+ -+ primary_expr_AST = RefDNode(astFactory->make((new antlr::ASTArray(2))->add(antlr::RefAST(astFactory->create(ARRAYEXPR_FCALL,"arrayexpr_fcall")))->add(antlr::RefAST(primary_expr_AST)))); -+ currentAST.root = primary_expr_AST; -+ if ( primary_expr_AST!=RefDNode(antlr::nullAST) && -+ primary_expr_AST->getFirstChild() != RefDNode(antlr::nullAST) ) -+ currentAST.child = primary_expr_AST->getFirstChild(); -+ else -+ currentAST.child = primary_expr_AST; -+ currentAST.advanceChildToEnd(); -+ } - } -- if ( inputState->guessing==0 ) { -- primary_expr_AST = RefDNode(currentAST.root); -- -- // std::cout << "***(IDENTIFIER LBRACE expr (COMMA expr)* RBRACE) 2" << std::endl; -- -- primary_expr_AST = RefDNode(astFactory->make((new antlr::ASTArray(2))->add(antlr::RefAST(astFactory->create(ARRAYEXPR_FCALL,"arrayexpr_fcall")))->add(antlr::RefAST(primary_expr_AST)))); -- currentAST.root = primary_expr_AST; -- if ( primary_expr_AST!=RefDNode(antlr::nullAST) && -- primary_expr_AST->getFirstChild() != RefDNode(antlr::nullAST) ) -- currentAST.child = primary_expr_AST->getFirstChild(); -- else -- currentAST.child = primary_expr_AST; -- currentAST.advanceChildToEnd(); -+ else if ((LA(1) == IDENTIFIER) && (LA(2) == LBRACE)) { -+ formal_function_call(); -+ if (inputState->guessing==0) { -+ astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -+ } -+ if ( inputState->guessing==0 ) { -+ primary_expr_AST = RefDNode(currentAST.root); -+ -+ primary_expr_AST = RefDNode(astFactory->make((new antlr::ASTArray(2))->add(antlr::RefAST(astFactory->create(FCALL,"fcall")))->add(antlr::RefAST(primary_expr_AST)))); -+ -+ currentAST.root = primary_expr_AST; -+ if ( primary_expr_AST!=RefDNode(antlr::nullAST) && -+ primary_expr_AST->getFirstChild() != RefDNode(antlr::nullAST) ) -+ currentAST.child = primary_expr_AST->getFirstChild(); -+ else -+ currentAST.child = primary_expr_AST; -+ currentAST.advanceChildToEnd(); -+ } - } -- } - else { - throw antlr::NoViableAltException(LT(1), getFilename()); - } -- -+ } - } - primary_expr_AST = RefDNode(currentAST.root); - } - else { -- bool synPredMatched223 = false; -+ bool synPredMatched227 = false; - if (((LA(1) == IDENTIFIER) && (LA(2) == LBRACE))) { -- int _m223 = mark(); -- synPredMatched223 = true; -+ int _m227 = mark(); -+ synPredMatched227 = true; - inputState->guessing++; - try { - { -@@ -8335,12 +8455,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched223 = false; -+ synPredMatched227 = false; - } -- rewind(_m223); -+ rewind(_m227); - inputState->guessing--; - } -- if ( synPredMatched223 ) { -+ if ( synPredMatched227 ) { - formal_function_call(); - if (inputState->guessing==0) { - astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -@@ -8359,10 +8479,10 @@ - primary_expr_AST = RefDNode(currentAST.root); - } - else { -- bool synPredMatched225 = false; -+ bool synPredMatched229 = false; - if (((_tokenSet_4.member(LA(1))) && (_tokenSet_22.member(LA(2))))) { -- int _m225 = mark(); -- synPredMatched225 = true; -+ int _m229 = mark(); -+ synPredMatched229 = true; - inputState->guessing++; - try { - { -@@ -8370,12 +8490,12 @@ - } - } - catch (antlr::RecognitionException& pe) { -- synPredMatched225 = false; -+ synPredMatched229 = false; - } -- rewind(_m225); -+ rewind(_m229); - inputState->guessing--; - } -- if ( synPredMatched225 ) { -+ if ( synPredMatched229 ) { - deref_expr(); - if (inputState->guessing==0) { - astFactory->addASTChild(currentAST, antlr::RefAST(returnAST)); -@@ -8728,11 +8848,11 @@ - } - } - else { -- goto _loop231; -+ goto _loop235; - } - - } -- _loop231:; -+ _loop235:; - } // ( ... )* - exponential_expr_AST = RefDNode(currentAST.root); - returnAST = exponential_expr_AST; -@@ -8814,11 +8934,11 @@ - } - } - else { -- goto _loop235; -+ goto _loop239; - } - - } -- _loop235:; -+ _loop239:; - } // ( ... )* - multiplicative_expr_AST = RefDNode(currentAST.root); - returnAST = multiplicative_expr_AST; -@@ -9131,11 +9251,11 @@ - } - } - else { -- goto _loop242; -+ goto _loop246; - } - - } -- _loop242:; -+ _loop246:; - } // ( ... )* - additive_expr_AST = RefDNode(currentAST.root); - returnAST = additive_expr_AST; -@@ -9271,11 +9391,11 @@ - } - } - else { -- goto _loop247; -+ goto _loop251; - } - - } -- _loop247:; -+ _loop251:; - } // ( ... )* - relational_expr_AST = RefDNode(currentAST.root); - returnAST = relational_expr_AST; -@@ -9337,11 +9457,11 @@ - } - } - else { -- goto _loop251; -+ goto _loop255; - } - - } -- _loop251:; -+ _loop255:; - } // ( ... )* - boolean_expr_AST = RefDNode(currentAST.root); - returnAST = boolean_expr_AST; -@@ -9393,11 +9513,11 @@ - } - } - else { -- goto _loop255; -+ goto _loop259; - } - - } -- _loop255:; -+ _loop259:; - } // ( ... )* - logical_expr_AST = RefDNode(currentAST.root); - returnAST = logical_expr_AST; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLParser.hpp gdl/src/GDLParser.hpp ---- gdl-0.9.3/src/GDLParser.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLParser.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -2,7 +2,7 @@ - #define INC_GDLParser_hpp_ - - #include --/* $ANTLR 2.7.7 (20110618): "gdlc.g" -> "GDLParser.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.g" -> "GDLParser.hpp"$ */ - #include - #include - #include "GDLTokenTypes.hpp" -@@ -194,6 +194,7 @@ - public: void deref_dot_expr(); - public: bool member_function_call(); - public: void member_function_call_dot(); -+ public: void arrayexpr_mfcall(); - public: void primary_expr(); - public: void decinc_expr(); - public: void exponential_expr(); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlpsstream.cpp gdl/src/gdlpsstream.cpp ---- gdl-0.9.3/src/gdlpsstream.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlpsstream.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -18,7 +18,7 @@ - #include "includefirst.hpp" - - //#include -- -+#include "graphics.hpp" - #include "gdlpsstream.hpp" - - using namespace std; -@@ -47,4 +47,3 @@ - } - page++; - }; -- -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlpsstream.hpp gdl/src/gdlpsstream.hpp ---- gdl-0.9.3/src/gdlpsstream.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlpsstream.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -27,11 +27,11 @@ - int page; - bool encapsulated; - public: -- GDLPSStream( int nx, int ny, int pfont, bool encaps): -+ GDLPSStream( int nx, int ny, int pfont, bool encaps, int color): - #ifdef _MSC_VER -- GDLGStream( nx, ny, pfont == 1 ? "psttf" : "ps") -+ GDLGStream( nx, ny, /*pfont == 1 ? "psttf" :*/ (color==0)?"ps":"psc") - #else -- GDLGStream::GDLGStream( nx, ny, pfont == 1 ? "psttf" : "ps") -+ GDLGStream::GDLGStream( nx, ny, /*pfont == 1 ? "psttf" :*/(color==0)?"ps":"psc") - #endif - { - encapsulated = encaps; -@@ -43,6 +43,7 @@ - void eop(); - - void Init(); -+ - }; - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLTokenTypes.hpp gdl/src/GDLTokenTypes.hpp ---- gdl-0.9.3/src/GDLTokenTypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLTokenTypes.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -1,7 +1,7 @@ - #ifndef INC_GDLTokenTypes_hpp_ - #define INC_GDLTokenTypes_hpp_ - --/* $ANTLR 2.7.7 (20110618): "gdlc.g" -> "GDLTokenTypes.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.g" -> "GDLTokenTypes.hpp"$ */ - - #ifndef CUSTOM_API - # define CUSTOM_API -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLTokenTypes.txt gdl/src/GDLTokenTypes.txt ---- gdl-0.9.3/src/GDLTokenTypes.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLTokenTypes.txt 2013-05-16 12:36:33.000000000 -0600 -@@ -1,4 +1,4 @@ --// $ANTLR 2.7.7 (20110618): gdlc.g -> GDLTokenTypes.txt$ -+// $ANTLR 2.7.7 (20120518): gdlc.g -> GDLTokenTypes.txt$ - GDL // output token vocab name - ALL=4 - ASSIGN=5 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLTreeParser.cpp gdl/src/GDLTreeParser.cpp ---- gdl-0.9.3/src/GDLTreeParser.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLTreeParser.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -1,4 +1,4 @@ --/* $ANTLR 2.7.7 (20110618): "gdlc.tree.g" -> "GDLTreeParser.cpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.tree.g" -> "GDLTreeParser.cpp"$ */ - - #include "includefirst.hpp" - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLTreeParser.hpp gdl/src/GDLTreeParser.hpp ---- gdl-0.9.3/src/GDLTreeParser.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLTreeParser.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -3,7 +3,7 @@ - - #include - #include "GDLTreeParserTokenTypes.hpp" --/* $ANTLR 2.7.7 (20110618): "gdlc.tree.g" -> "GDLTreeParser.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.tree.g" -> "GDLTreeParser.hpp"$ */ - #include - - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLTreeParserTokenTypes.hpp gdl/src/GDLTreeParserTokenTypes.hpp ---- gdl-0.9.3/src/GDLTreeParserTokenTypes.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLTreeParserTokenTypes.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -1,7 +1,7 @@ - #ifndef INC_GDLTreeParserTokenTypes_hpp_ - #define INC_GDLTreeParserTokenTypes_hpp_ - --/* $ANTLR 2.7.7 (20110618): "gdlc.tree.g" -> "GDLTreeParserTokenTypes.hpp"$ */ -+/* $ANTLR 2.7.7 (20120518): "gdlc.tree.g" -> "GDLTreeParserTokenTypes.hpp"$ */ - - #ifndef CUSTOM_API - # define CUSTOM_API -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/GDLTreeParserTokenTypes.txt gdl/src/GDLTreeParserTokenTypes.txt ---- gdl-0.9.3/src/GDLTreeParserTokenTypes.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/GDLTreeParserTokenTypes.txt 2013-05-16 12:36:33.000000000 -0600 -@@ -1,4 +1,4 @@ --// $ANTLR 2.7.7 (20110618): gdlc.tree.g -> GDLTreeParserTokenTypes.txt$ -+// $ANTLR 2.7.7 (20120518): gdlc.tree.g -> GDLTreeParserTokenTypes.txt$ - GDLTreeParser // output token vocab name - ALL=4 - ASSIGN=5 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlwidget.cpp gdl/src/gdlwidget.cpp ---- gdl-0.9.3/src/gdlwidget.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlwidget.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -651,7 +651,7 @@ - } - - // define grid object -- wxFlexGridSizer *buttonSizer = new wxFlexGridSizer( rows, cols ); -+ wxFlexGridSizer *buttonSizer = new wxFlexGridSizer( (int)rows, (int) cols, 0, 0 ); - switch(mode) - { - case NORMAL: -@@ -927,7 +927,7 @@ - DSub *sub = proList[ proIx]; - // EnvUDT* e; - // e = new EnvUDT( NULL, sub); --// std::auto_ptr< EnvUDT> e_guard( e); -+// Guard< EnvUDT> e_guard( e); - // StackSizeGuard guard( GDLInterpreter::CallStack()); - // GDLInterpreter::CallStack().push_back( e); - -@@ -969,7 +969,7 @@ - trAST = treeParser.getAST(); - - ProgNodeP progAST = ProgNode::NewProgNode( trAST); -- std::auto_ptr< ProgNode> progAST_guard( progAST); -+ Guard< ProgNode> progAST_guard( progAST); - - // necessary for correct FOR loop handling - assert( dynamic_cast(caller) != NULL); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlxstream.cpp gdl/src/gdlxstream.cpp ---- gdl-0.9.3/src/gdlxstream.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlxstream.cpp 2013-06-03 14:22:52.000000000 -0600 -@@ -130,10 +130,11 @@ - PLFLT xp; PLFLT yp; - PLINT xleng; PLINT yleng; - PLINT plxoff; PLINT plyoff; -- gpage( xp, yp, xleng, yleng, plxoff, plyoff); -+ plstream::gpage( xp, yp, xleng, yleng, plxoff, plyoff); - - xoff = plxoff; - yoff = plyoff; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"GDLXStream::GetGeometry(%ld %ld %ld %ld)\n", xSize, ySize, xoff, yoff); - } - - // plplot 5.3 does not provide the clear function for c++ -@@ -144,8 +145,10 @@ - // RGB_HLS( a,b,c,&d,&e,&f); - char dummy; - gesc( &dummy); -- -- ::c_plclear(); -+// this mimics better the *DL behaviour. -+ ::c_plbop(); -+ //plclear clears only the current subpage. -+// ::c_plclear(); - } - - void GDLXStream::Clear( DLong bColor) -@@ -175,6 +178,7 @@ - ::c_plbop(); - plscolbg (r1, g1, b1); - -+//plclear clears only the current subpage. - // ::c_plclear(); - // - // plscolbg (r0, g0, b0); -@@ -194,15 +198,11 @@ - XLowerWindow(dev->xwd->display, dev->window); - } - --// note by AC on 2012-Aug-16 Help/suggestions welcome --// I don't know how to find the sub-window number (third parametre --// in call XIconifyWindow()) -- - void GDLXStream::Iconic() - { - XwDev *dev = (XwDev *) pls->dev; - XwDisplay *xwd = (XwDisplay *) dev->xwd; -- XIconifyWindow(dev->xwd->display, dev->window,0); -+ XIconifyWindow(xwd->display, dev->window,xwd->screen); - } - - void GDLXStream::DeIconic() -@@ -211,5 +211,259 @@ - XwDisplay *xwd = (XwDisplay *) dev->xwd; - XMapWindow(dev->xwd->display, dev->window); - } -+void GDLXStream::Flush() -+{ -+ XwDev *dev = (XwDev *) pls->dev; -+ XwDisplay *xwd = (XwDisplay *) dev->xwd; -+ XFlush( xwd->display); -+} -+void GDLXStream::WarpPointer(DLong x, DLong y) -+{ -+ XwDev *dev = (XwDev *) pls->dev; -+ XwDisplay *xwd = (XwDisplay *) dev->xwd; -+ XWarpPointer( xwd->display, None, dev->window, 0, 0, 0, 0, x, dev->height-y ); -+} -+void GDLXStream::setDoubleBuffering() -+{ -+ XwDev *dev = (XwDev *) pls->dev; -+ dev->write_to_window = 0; -+ pls->db = 1; -+} -+void GDLXStream::unSetDoubleBuffering() -+{ -+ XwDev *dev = (XwDev *) pls->dev; -+ dev->write_to_window = 1; -+ pls->db = 0; -+} -+bool GDLXStream::hasDoubleBuffering() -+{ -+ return true; -+} -+bool GDLXStream::GetGin( PLGraphicsIn *gin, int mode) -+{ -+ bool status=true; -+ bool warp=false; -+ int dx,dy; -+ XwDev *dev = (XwDev *) pls->dev; -+ XwDisplay *xwd = (XwDisplay *) dev->xwd; -+ if (mode == 0) -+ { -+ Window root, child; -+ int root_x, root_y, x,y; -+ unsigned int state; -+ XQueryPointer(xwd->display, dev->window, &root, &child, -+ &root_x, &root_y, &x, &y, &state ) ; -+ gin->pX = x; -+ gin->pY = dev->height - y; -+ gin->state = state; -+ gin->dX = (PLFLT) gin->pX / ( dev->width - 1 ); -+ gin->dY = (PLFLT) gin->pY / ( dev->height - 1 ); -+ gin->string[0] = '\0'; -+ gin->keysym = 0x20; -+ gin->button = 0; -+ return true; -+ } -+ int x, x1, xmin = 0, xmax = (int) dev->width - 1; -+ int y, y1, ymin = 0, ymax = (int) dev->height - 1; -+ XWMHints gestw; -+ XSizeHints sizehints,initialstate; -+ long hints_supplied; -+ /* get normal state of the window */ -+ XGetWMNormalHints(xwd->display, dev->window,&initialstate,&hints_supplied); -+ /* force fixed size to prevent a change of window size with the cursor*/ -+ sizehints.min_width=sizehints.max_width=dev->width; -+ sizehints.min_height=sizehints.max_height=dev->height; -+ sizehints.flags=(PMinSize|PMaxSize); -+ XSetWMNormalHints(xwd->display, dev->window,&sizehints); -+ /* add focus to the window on (all) displays */ -+ gestw.input = TRUE; -+ gestw.flags = InputHint; -+ XSetWMHints(xwd->display, dev->window, &gestw); -+ -+ unsigned long event_mask= PointerMotionMask | KeyPressMask; -+ switch (mode) -+ { -+ case 1: -+ case 3: -+ event_mask |= ButtonPressMask; -+ break; -+ case 4: -+ event_mask |= ButtonPressMask | ButtonReleaseMask; -+ break; -+ case 2: -+ event_mask |= ButtonPressMask | ButtonReleaseMask; -+ } -+ -+ XEvent event; -+ //do our own event handling -+ int first=0; -+ XSelectInput(xwd->display, dev->window, event_mask); -+ XRaiseWindow(xwd->display, dev->window); -+ XFlush(xwd->display); -+ while(1) -+ { -+ XWindowEvent(xwd->display, dev->window, event_mask, &event); -+ switch (event.type) -+ { -+ int nchars; -+ KeySym mykey; -+ -+ case KeyPress: // exit in error if ^C -+ gin->pX = event.xkey.x; -+ gin->pY = event.xkey.y; -+ gin->state = event.xkey.state; -+ nchars = XLookupString(&event.xkey, gin->string, PL_MAXKEY - 1, &mykey, NULL); -+ gin->string[nchars] = '\0'; -+ gin->keysym = (unsigned int) mykey; -+ if (gin->state&4 && (gin->keysym==67 || gin->keysym==99)) -+ { -+ status=false; -+ goto end; -+ } -+ warp=false; -+ dx=0; -+ dy=0; -+ switch(mykey) -+ { -+ case XK_Cancel: -+ case XK_Break: -+ status = false; -+ goto end; -+ case XK_Left: -+ dx=-1; warp=true; -+ break; -+ case XK_Up: -+ dy=-1; warp=true; -+ break; -+ case XK_Right: -+ dx=1; warp=true; -+ break; -+ case XK_Down: -+ dy=1; warp=true; -+ break; -+ } -+ if (warp) -+ { -+ // Each modifier key added increases the multiplication factor by 5 -+ // Shift -+ if ( gin->state & 0x01 ) -+ { -+ dx *= 5; -+ dy *= 5; -+ } -+ // Caps Lock -+ if ( gin->state & 0x02 ) -+ { -+ dx *= 5; -+ dy *= 5; -+ } -+ // Control -+ if ( gin->state & 0x04 ) -+ { -+ dx *= 5; -+ dy *= 5; -+ } -+ // Alt -+ if ( gin->state & 0x08 ) -+ { -+ dx *= 5; -+ dy *= 5; -+ } -+ // Bounds checking so that we don't send cursor out of window -+ x1 = gin->pX + dx; -+ y1 = gin->pY + dy; -+ if ( x1 < xmin ) -+ dx = xmin - gin->pX; -+ if ( y1 < ymin ) -+ dy = ymin - gin->pY; -+ if ( x1 > xmax ) -+ dx = xmax - gin->pX; -+ if ( y1 > ymax ) -+ dy = ymax - gin->pY; -+ XWarpPointer( xwd->display, dev->window, None, 0, 0, 0, 0, dx, dy ); -+ } -+ break; -+ case MotionNotify: -+ gin->pX = event.xmotion.x; -+ gin->pY = event.xmotion.y; -+ gin->state = event.xmotion.state; -+ gin->string[0] = '\0'; -+ gin->keysym = 0x20; -+ // fprintf(stderr,"motion %d %d, state %d\n",gin->pX,gin->pY,gin->state); -+ if (mode==2) goto end; // crosshair not available if we exit on motion!!! -+ if(event.type==MotionNotify){ -+ x=event.xmotion.x; y=event.xmotion.y; -+ } -+ else { -+ x=event.xcrossing.x; y=event.xcrossing.y; -+ } -+ if (!first) -+ first=1; -+ else -+ { -+ XDrawLines( xwd->display, dev->window, xwd->gcXor, dev->xhair_x, 2, -+ CoordModeOrigin ); -+ XDrawLines( xwd->display, dev->window, xwd->gcXor, dev->xhair_y, 2, -+ CoordModeOrigin ); -+ } -+ dev->xhair_x[0].x = (short) xmin; dev->xhair_x[0].y = (short) y; -+ dev->xhair_x[1].x = (short) xmax; dev->xhair_x[1].y = (short) y; -+ dev->xhair_y[0].x = (short) x; dev->xhair_y[0].y = (short) ymin; -+ dev->xhair_y[1].x = (short) x; dev->xhair_y[1].y = (short) ymax; -+ XDrawLines( xwd->display, dev->window, xwd->gcXor, dev->xhair_x, 2, -+ CoordModeOrigin ); -+ XDrawLines( xwd->display, dev->window, xwd->gcXor, dev->xhair_y, 2, -+ CoordModeOrigin ); -+ break; -+ case ButtonPress: -+ gin->pX = event.xbutton.x; -+ gin->pY = event.xbutton.y; -+ gin->state = event.xbutton.state; -+ gin->button = event.xbutton.button; -+ gin->string[0] = '\0'; -+ gin->keysym = 0x20; -+ XSync(xwd->display, true); -+ if (mode==4) break; -+ goto end; //always exit on this event -+ case ButtonRelease: -+ gin->pX = event.xbutton.x; -+ gin->pY = event.xbutton.y; -+ gin->state = event.xbutton.state; -+ gin->button = event.xbutton.button; -+ gin->string[0] = '\0'; -+ gin->keysym = 0x20; -+ XSync(xwd->display, true); -+ goto end; //always exit on this event -+ default: -+ break; -+ } -+ } -+ end: if(first) { -+ XDrawLines( xwd->display, dev->window, xwd->gcXor, dev->xhair_x, 2, -+ CoordModeOrigin ); -+ XDrawLines( xwd->display, dev->window, xwd->gcXor, dev->xhair_y, 2, -+ CoordModeOrigin ); -+ } -+ gin->pY = dev->height - gin->pY; -+ gin->dX = (PLFLT) gin->pX / ( dev->width - 1 ); -+ gin->dY = (PLFLT) gin->pY / ( dev->height - 1 ); -+ //give back plplot's handling: -+ XSelectInput(xwd->display, dev->window,dev->event_mask); -+ /* restore old hints */ -+ XSetWMNormalHints(xwd->display, dev->window, &initialstate); -+ /* remove focus to the window on (all) displays */ -+ gestw.input = FALSE; -+ gestw.flags = InputHint; -+ XSetWMHints(xwd->display, dev->window, &gestw); -+ /* give back the right to change the window size*/ -+ sizehints.min_width=0; -+ sizehints.max_width=XWidthOfScreen(XDefaultScreenOfDisplay(xwd->display)); -+ sizehints.min_height=32; -+ sizehints.max_height=XHeightOfScreen(XDefaultScreenOfDisplay(xwd->display)); -+ sizehints.flags=(PMinSize|PMaxSize); -+ XSetWMNormalHints(xwd->display, dev->window,&sizehints); -+ XFlush(xwd->display); -+ return status; -+} - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gdlxstream.hpp gdl/src/gdlxstream.hpp ---- gdl-0.9.3/src/gdlxstream.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gdlxstream.hpp 2013-06-03 14:22:52.000000000 -0600 -@@ -53,6 +53,12 @@ - void Lower(); - void Iconic(); - void DeIconic(); -+ bool GetGin(PLGraphicsIn *gin, int mode); -+ void WarpPointer(DLong x, DLong y); -+ void Flush(); -+ void setDoubleBuffering(); -+ void unSetDoubleBuffering(); -+ bool hasDoubleBuffering(); - }; - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/graphics.cpp gdl/src/graphics.cpp ---- gdl-0.9.3/src/graphics.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/graphics.cpp 2013-07-08 12:39:21.922392804 -0600 -@@ -176,7 +176,7 @@ - - void Graphics::DestroyDevices() - { -- Purge( deviceList); -+ PurgeContainer( deviceList); - actDevice = NULL; - } - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/graphics.hpp gdl/src/graphics.hpp ---- gdl-0.9.3/src/graphics.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/graphics.hpp 2013-02-25 17:04:24.000000000 -0700 -@@ -172,9 +172,15 @@ - virtual bool SetFileName( const std::string& f) { return false;} - virtual bool Decomposed( bool value) { return false;} - virtual DLong GetDecomposed() { return -1;} -+ virtual bool SetGraphicsFunction( DLong value) { return false;} -+ virtual DLong GetGraphicsFunction() { return -1;} -+ virtual bool CursorStandard( int value) { return false;} -+ virtual bool CursorCrosshair() { return false;} -+ virtual bool UnsetFocus() { return false;} -+ virtual bool EnableBackingStore(bool enable) { return false;} - virtual bool SetXPageSize( const float xs) { return false;} - virtual bool SetYPageSize( const float ys) { return false;} -- virtual bool SetColor() { return false;} -+ virtual bool SetColor(const long color=0) { return false;} - virtual bool SetScale(const float) { return false;} - virtual bool SetXOffset(const float) { return false;} - virtual bool SetYOffset(const float) { return false;} -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gshhs.cpp gdl/src/gshhs.cpp ---- gdl-0.9.3/src/gshhs.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gshhs.cpp 2013-07-08 12:39:21.923392792 -0600 -@@ -66,10 +66,12 @@ - if (!mapSet) - e->Throw("Map transform not established (MAP_SET)."); - -- gkw_color(e, actStream); -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); - - actStream->NoSub(); - -+ bool forget=false; -+ - DDouble *sx, *sy; - GetSFromPlotStructs(&sx, &sy); - -@@ -191,7 +193,7 @@ - char source = (src == 1) ? 'W' : 'C'; // Either WVS or CIA (WDBII) pedigree - if (river) source = tolower ((int)source); // Lower case c means river-lake - int line = (h.area) ? 0 : 1; // Either Polygon (0) or Line (1) (if no area) -- -+ - /* - double area = 0.1 * h.area; // Now im km^2 - double f_area = 0.1 * h.area_full; // Now im km^2 -@@ -210,19 +212,21 @@ - printf ("%c %6d%8d%2d%2c%13.3f%13.3f%10.5f%10.5f%10.5f%10.5f %s %s\n", c, h.id, h.n, level, source, area, f_area, ww, ee, ss, nn, container, ancestor); - } - */ -- -- double lon_last, lat_last; -+ double lon_last, lat_last, olon; - PLFLT *lons, *lats; -+ SizeT k,l; - if (kw_fill && !line) - { -- lons = (PLFLT*)malloc(h.n * sizeof(PLFLT)); -+ lons = (PLFLT*)malloc(h.n *2* sizeof(PLFLT)); - if (lons == NULL) - e->Throw("Failed to allocate memory (lons)"); -- lats = (PLFLT*)malloc(h.n * sizeof(PLFLT)); -+ lats = (PLFLT*)malloc(h.n *2* sizeof(PLFLT)); - if (lats == NULL) - e->Throw("Failed to allocate memory (lats)"); - } -- for (int k = 0; k < h.n; k++) -+// Message("in file" + files[i] + " for " + (line ? "line" : "polygon") -+// + i2s(h.id) + ",size " + i2s(h.n)+", level"+i2s(level)); -+ for (k = 0, l=0 ; k < h.n; k++) - { - struct POINT p; - if (fread ((void *)&p, (size_t)sizeof(struct POINT), (size_t)1, fp) != 1) -@@ -230,7 +234,6 @@ - e->Throw("Error reading file" + files[i] + " for " + (line ? "line" : "polygon") - + i2s(h.id) + ", point " + i2s(k)); - } -- - if (!(line && kw_fill)) - { - // byte order -@@ -244,7 +247,7 @@ - double lon = p.x * GSHHS_SCL; - if ((greenwich && p.x > max_east) || (h.west > 180000000)) lon -= 360.0; - double lat = p.y * GSHHS_SCL; -- -+ - #ifdef USE_LIBPROJ4 - // map projection - if (mapSet) // ... always true -@@ -256,24 +259,40 @@ - lat = odata.y; - } - #endif -- -+ if (k != 0) { //very crude patch --- will not avoid spurious lines & artifacts! -+ if(fabs(olon-lon) > 0.5*abs(xEnd-xStart)) forget=true; -+ olon=lon; -+ } - // drawing line or recording data for drawing a polygon afterwards - if (!kw_fill) - { -- if (k != 0) actStream->join(lon_last, lat_last, lon, lat); -+ if (k != 0) { -+ if (forget) forget=false; else actStream->join(lon_last, lat_last, lon, lat); -+ } - lon_last = lon; - lat_last = lat; - } - else - { -- lons[k] = lon; -- lats[k] = lat; -+ if (forget) { -+ forget=false; -+ if (l>2) actStream->fill(l, lons, lats); // TODO: PL_MAXPOLY is 256 :( -+ l=0; -+ lons[l] = lon; -+ lats[l] = lat; -+ l++; -+ } else -+ { -+ lons[l] = lon; -+ lats[l] = lat; -+ l++; -+ } - } - } - } - if (kw_fill && !line) - { -- actStream->fill(h.n, lons, lats); // TODO: PL_MAXPOLY is 256 :( -+ if (l>2) actStream->fill(l, lons, lats); // TODO: PL_MAXPOLY is 256 :( - free(lons); - free(lats); - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gsl_fun.cpp gdl/src/gsl_fun.cpp ---- gdl-0.9.3/src/gsl_fun.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gsl_fun.cpp 2013-07-08 12:39:21.926392757 -0600 -@@ -102,6 +102,7 @@ - namespace lib { - - using namespace std; -+ using std::isnan; - - const int szdbl=sizeof(double); - const int szflt=sizeof(float); -@@ -133,6 +134,8 @@ - gsl_set_error_handler( GDLGenericGSLErrorHandler); - } - -+ -+ - BaseGDL* invert_fun( EnvT* e) - { - SizeT nParam=e->NParam(1); -@@ -148,9 +151,10 @@ - BaseGDL* p0 = e->GetParDefined( 0); - - SizeT nEl = p0->N_Elements(); -+ - if( nEl == 0) - e->Throw( "Variable is undefined: " + e->GetParString(0)); -- -+ - if (p0->Rank() > 2) - e->Throw( "Input must be a square matrix:" + e->GetParString(0)); - -@@ -199,7 +203,7 @@ - if (nParam == 2) e->SetPar(1,new DLongGDL( singular)); - return res; - } -- if( p0->Type() == GDL_DOUBLE) { -+ if(( p0->Type() == GDL_DOUBLE) || e->KeywordSet("DOUBLE")) { - DDoubleGDL* res = static_cast - (p0->Convert2(GDL_DOUBLE, BaseGDL::COPY)); - if ((*res)[0] == 0.0) { -@@ -234,7 +238,7 @@ - { - DComplexGDL* p0C = static_cast( p0); - DComplexGDL* res = new DComplexGDL( p0C->Dim(), BaseGDL::NOZERO); -- auto_ptr resGuard( res); -+ Guard resGuard( res); - - float f32_2[2]; - double f64_2[2]; -@@ -285,7 +289,7 @@ - { - DComplexDblGDL* p0C = static_cast( p0); - DComplexDblGDL* res = new DComplexDblGDL( p0C->Dim(), BaseGDL::NOZERO); -- auto_ptr resGuard( res); -+ Guard resGuard( res); - - gsl_matrix_complex *mat = - gsl_matrix_complex_alloc(p0->Dim(0), p0->Dim(1)); -@@ -316,11 +320,16 @@ - resGuard.release(); - return res; - } -- else if( p0->Type() == GDL_DOUBLE) -+ else if (( p0->Type() == GDL_DOUBLE) || e->KeywordSet("DOUBLE")) - { -- DDoubleGDL* p0D = static_cast( p0); -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2(GDL_DOUBLE,BaseGDL::COPY)); -+ -+ -+ // DDoubleGDL* p0D = static_cast( p0); - DDoubleGDL* res = new DDoubleGDL( p0->Dim(), BaseGDL::NOZERO); -- auto_ptr resGuard( res); -+ Guard resGuard( res); - - gsl_matrix *mat = gsl_matrix_alloc(p0->Dim(0), p0->Dim(1)); - GDLGuard g1( mat, gsl_matrix_free); -@@ -368,11 +377,11 @@ - // if (p0->Type() == STRING) { - DFloatGDL* p0SS = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- auto_ptr p0SSGuard( p0SS); -+ Guard p0SSGuard( p0SS); - //} - - DFloatGDL* res = new DFloatGDL( p0->Dim(), BaseGDL::NOZERO); -- auto_ptr resGuard( res); -+ Guard resGuard( res); - - gsl_matrix *mat = gsl_matrix_alloc(p0->Dim(0), p0->Dim(1)); - GDLGuard g1( mat, gsl_matrix_free); -@@ -630,23 +639,23 @@ - - T* res; - T* tabtemp=new T(p0->Dim()); -- auto_ptr tabtempGuard( tabtemp); -+ Guard tabtempGuard( tabtemp); - -- auto_ptr resGuard; -+ Guard resGuard; - if (overwrite == 0) - { - res = new T( p0->Dim(), BaseGDL::ZERO); -- resGuard.reset( res); -+ resGuard.Reset( res); - } - else - res = (T*) p0; - - DComplexGDL* tabfft = new DComplexGDL(p0->Dim()); -- auto_ptr tabfftGuard( tabfft); -+ Guard tabfftGuard( tabfft); - - DComplexGDL* p0C = static_cast - (p0->Convert2( GDL_COMPLEX, BaseGDL::COPY)); -- auto_ptr p0CGuard( p0C); -+ Guard p0CGuard( p0C); - - int dec=0; - int temp=0; -@@ -944,7 +953,7 @@ - overwrite = 0; - DComplexGDL* p0C = static_cast - (p0->Convert2( GDL_COMPLEX, BaseGDL::COPY)); -- auto_ptr guard_p0C( p0C); -+ Guard guard_p0C( p0C); - return fft_template< DComplexGDL> (p0C, nEl, dbl, overwrite, - direct,dimension); - -@@ -1210,7 +1219,7 @@ - seed0 = (*p0L)[ 0]; - - r = gsl_rng_alloc (gsl_rng_mt19937); -- rGuard.Set( r); -+ rGuard.Init( r); - gsl_rng_set (r, seed0); - - seed0 += dim.NDimElements() * seedMul; // avoid repetition in next call -@@ -1229,7 +1238,7 @@ - } - - r = gsl_rng_alloc (gsl_rng_mt19937); -- rGuard.Set( r); -+ rGuard.Init( r); - gsl_rng_set (r, seed0); - - seed0 += dim.NDimElements() * seedMul; // avoid repetition in next call -@@ -1247,7 +1256,7 @@ - seed0 = (*seed)[0]; - - r = gsl_rng_alloc (gsl_rng_mt19937); -- rGuard.Set( r); -+ rGuard.Init( r); - - // AC 2012/10/02 need to comment that to avoid crash when "seed" is set outside - // GDLGuard g1( r, gsl_rng_free); -@@ -1350,6 +1359,22 @@ - } - #endif - -+ // Alain C., 26 February 2013 -+ // this is a temporary workaround of an in accuracy in the GSL (up to 1.15) -+ // when working on 64b version and integer bin size ... -+ // GDL bug report 618683 -+ // http://sourceforge.net/tracker/?func=detail&aid=3602623&group_id=97659&atid=618683 -+ // GSL bug report thread -+ // http://lists.gnu.org/archive/html/bug-gsl/2013-02/msg00006.html -+ -+ static void gdl_make_uniform (gsl_histogram * h, size_t n, double xmin, double xmax) -+ { -+ size_t i; -+ for (i = 0; i <= n; i++) -+ h->range[i] = xmin + (double) i * (xmax-xmin)/((double) n); -+ } -+ -+ - BaseGDL* histogram_fun( EnvT* e) - { - double a; -@@ -1391,14 +1416,17 @@ - if( binsizeKW != NULL && nbinsKW != NULL && maxKW != NULL) - e->Throw( "Conflicting keywords."); - -- DDoubleGDL *p0D = dynamic_cast(p0); -- auto_ptr guard; -- if( p0D == NULL) -+ DDoubleGDL *p0D; -+ Guard guard; -+ if( p0->Type() != GDL_DOUBLE) - { - p0D = static_cast(p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard.reset( p0D); -+ guard.Init( p0D); - } -- -+ else -+ { -+ p0D = static_cast(p0); -+ } - // get min max - // use MinMax here when NAN will be supported - -@@ -1440,9 +1468,11 @@ - e->AssureDoubleScalarKW(e->KeywordIx("MIN"), a); - // max - if (maxKW == NULL) -- { -+ { -+ if( p0->Type() == GDL_BYTE) -+ b = 255.0; - // !MAX && BINSIZE && NBINS -> determine MAX -- if (binsizeKW != NULL && nbinsKW != NULL) -+ else if (binsizeKW != NULL && nbinsKW != NULL) - b = a + bsize * nbins; - // SA: !MAX && !BINSIZE && NBINS -> binsize = (max - min) / (nbins - 1) - else if (binsizeKW == NULL && nbinsKW != NULL) -@@ -1450,8 +1480,6 @@ - bsize = (maxVal - minVal) / (nbins - 1); - b = a + nbins * bsize; - } -- else if( p0->Type() == GDL_BYTE) -- b = 255.0; - else - b = maxVal; - } -@@ -1502,6 +1530,9 @@ - GDLGuard hhGuard( hh, gsl_histogram_free); - gsl_histogram_set_ranges_uniform( hh, a, b); - -+ // temporary revisited computation of bin values ... -+ gdl_make_uniform (hh, hh->n, a, b); -+ - // Set maxVal from keyword if present - if (maxKW != NULL) e->AssureDoubleScalarKW(e->KeywordIx("MAX"), maxVal); - -@@ -1684,7 +1715,7 @@ - - return(res); - } -- -+ - DDoubleGDL* interpolate_1dim(EnvT* e, const gdl_interp1d_type* interp_type, - DDoubleGDL* array, DDoubleGDL* x, bool use_missing, - DDouble missing, DDouble gamma) -@@ -1697,13 +1728,10 @@ - SizeT rankLeft = array->Rank()-1; - - //initialize output array with correct dimensions -- DLong dims[MAXRANK]; // initialization does not honor MAXRANK: = {0, 0, 0, 0, 0, 0, 0, 0} -- // sub-optimal: --// for( int i=0;iDim(i); -- for (; i < MAXRANK; ++i) dims[i] = 0; // see above -+ for (; i < MAXRANK; ++i) dims[i] = 0; - - SizeT resRank = rankLeft; - SizeT chunksize; -@@ -1757,6 +1785,8 @@ - //here we use a padded temp array (1D only): - for (SizeT k = 0; k < nxa-1; ++k) temp[k]=(*array)[k*ninterp+iterate]; temp[nxa-1]=temp[nxa-2]; //pad! - gdl_interp1d_init(interpolant, xa, temp, nxa, use_missing?missing_GIVEN:missing_NEAREST, missing, gamma); -+#pragma omp parallel if (chunksize >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= chunksize)) -+#pragma omp for - for (SizeT i = 0; i < chunksize; ++i) - { - double x = xval[i]; -@@ -1798,34 +1828,30 @@ - } - - //initialize output array with correct dimensions -- DLong dims[MAXRANK]; // initialization does not honor MAXRANK: = {0, 0, 0, 0, 0, 0, 0, 0} -- // sub-optimal: --// for( int i=0;iDim(i); -- for (; i < MAXRANK; ++i) dims[i] = 0; // see above -+ for (; i < MAXRANK; ++i) dims[i] = 0; - - SizeT resRank = rankLeft; - SizeT chunksize; - if (grid) -+ { -+ dims[resRank++] = nx; -+ if (resRank > MAXRANK - 1) -+ e->Throw("Rank of resulting array is currently limited to " + i2s(MAXRANK) + "."); -+ dims[resRank++] = ny; -+ chunksize = nx*ny; -+ } else -+ { -+ for (SizeT i = 0; i < x->Rank(); ++i) - { -- dims[resRank++] = nx; -- if (resRank>MAXRANK-1) -- e->Throw("Rank of resulting array is currently limited to " + i2s(MAXRANK) + "."); -- dims[resRank++] = ny; -- chunksize=nx*ny; -- } -- else -- { -- for (SizeT i = 0; i < x->Rank(); ++i) -- { -- dims[resRank++] = x->Dim(i); -- if (resRank>MAXRANK) -- e->Throw("Rank of resulting array is currently limited to " + i2s(MAXRANK) + "."); -- } -- chunksize=nx; -+ dims[resRank++] = x->Dim(i); -+ if (resRank > MAXRANK) -+ e->Throw("Rank of resulting array is currently limited to " + i2s(MAXRANK) + "."); - } -+ chunksize = nx; -+ } - dimension dim((DLong *)dims, resRank); - DDoubleGDL *res; - res = new DDoubleGDL(dim, BaseGDL::NOZERO); -@@ -1857,42 +1883,43 @@ - double *yval = new double[chunksize]; - ArrayGuard yvalGuard( yval); - if (grid) -+ { -+ for (SizeT j = 0, count=0; j < ny; j++) - { -- for (SizeT i = 0, count = 0; i < nx; i++) -- { -- for (SizeT j = 0; j < ny; j++) -- { -- count = INDEX_2D(i, j, nx, ny); -- xval[count] = (*x)[i]; -- yval[count] = (*y)[j]; -- } -- } -+ for (SizeT i = 0, count = 0; i < nx; i++) -+ { -+ count = INDEX_2D(i, j, nx, ny); -+ xval[count] = (*x)[i]; -+ yval[count] = (*y)[j]; -+ } - } -- else -+ } else -+ { -+ for (SizeT count = 0; count < chunksize; ++count) - { -- for (SizeT count=0; count < chunksize; ++count) -- { -- xval[count]=(*x)[count]; -- yval[count]=(*y)[count]; -- } -+ xval[count] = (*x)[count]; -+ yval[count] = (*y)[count]; - } -+ } - //construct 2d intermediate array, subset of array with stride ninterp - double *temp = new double[nxa*nya]; - ArrayGuard tempGuard( temp); - // Interpolate iteratively ninterp times: - // loop could be multihreaded easily - for (SizeT iterate = 0; iterate < ninterp; ++iterate) -- { -- -- for (SizeT k = 0; k < nxa*nya; ++k) temp[k]=(*array)[k*ninterp+iterate]; -- gdl_interp2d_init(interpolant, xa, ya, temp, nxa, nya, use_missing?missing_GIVEN:missing_NEAREST, missing, gamma); -- for (SizeT i = 0; i < chunksize; ++i) -- { -- double x = xval[i]; -- double y = yval[i]; -- (*res)[i*ninterp+iterate] = gdl_interp2d_eval(interpolant, xa, ya, temp, x, y, accx, accy); -- } -+ { -+ -+ for (SizeT k = 0; k < nxa * nya; ++k) temp[k] = (*array)[k * ninterp + iterate]; -+ gdl_interp2d_init(interpolant, xa, ya, temp, nxa, nya, use_missing ? missing_GIVEN : missing_NEAREST, missing, gamma); -+#pragma omp parallel if (chunksize >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= chunksize)) -+#pragma omp for -+ for (SizeT i = 0; i < chunksize; ++i) -+ { -+ double x = xval[i]; -+ double y = yval[i]; -+ (*res)[i * ninterp + iterate] = gdl_interp2d_eval(interpolant, xa, ya, temp, x, y, accx, accy); - } -+ } - - // gsl_interp_accel_free(accx); - // gsl_interp_accel_free(accy); -@@ -1929,11 +1956,12 @@ - } - - //initialize output array with correct dimensions -- DLong dims[MAXRANK] = {0, 0, 0, 0, 0, 0, 0, 0}; -- SizeT resRank; -+ DLong dims[MAXRANK]; -+ SizeT i = 0; -+ for (; i < rankLeft; ++i) dims[i] = array->Dim(i); -+ for (; i < MAXRANK; ++i) dims[i] = 0; -+ SizeT resRank= rankLeft; - SizeT chunksize; -- for (SizeT i = 0; i < rankLeft; ++i) dims[i] = array->Dim(i); -- resRank = rankLeft; - if (grid) - { - dims[resRank++] = nx; -@@ -1994,30 +2022,29 @@ - double *zval = new double[chunksize]; - ArrayGuard zvalGuard( zval); - if (grid) -+ { -+ for (SizeT k = 0, count = 0; k < nz; ++k) - { -- for (SizeT i = 0, count = 0; i < nx; ++i) -- { -- for (SizeT j = 0; j < ny; ++j) -- { -- for (SizeT k = 0; k < nz; ++k) -- { -- count = INDEX_3D(i, j, k, nx, ny, nz); -- xval[count] = (*x)[i]; -- yval[count] = (*y)[j]; -- zval[count] = (*z)[k]; -- } -- } -- } -+ for (SizeT j = 0; j < ny; ++j) -+ { -+ for (SizeT i = 0; i < nx; ++i) -+ { -+ count = INDEX_3D(i, j, k, nx, ny, nz); -+ xval[count] = (*x)[i]; -+ yval[count] = (*y)[j]; -+ zval[count] = (*z)[k]; -+ } -+ } - } -- else -+ } else -+ { -+ for (SizeT count = 0; count < chunksize; ++count) - { -- for (SizeT count = 0; count < chunksize; ++count) -- { -- xval[count]=(*x)[count]; -- yval[count]=(*y)[count]; -- zval[count]=(*z)[count]; -- } -+ xval[count] = (*x)[count]; -+ yval[count] = (*y)[count]; -+ zval[count] = (*z)[count]; - } -+ } - //construct 3d intermediate array, subset of array with stride ninterp - double *temp = new double[nxa*nya*nza]; - ArrayGuard tempGuard( temp); -@@ -2028,6 +2055,8 @@ - { - for (SizeT k = 0; k < nxa*nya*nza; ++k) temp[k]=(*array)[k*ninterp+iterate]; - gdl_interp3d_init(interpolant, xa, ya, za, temp, nxa, nya, nza, use_missing?missing_GIVEN:missing_NEAREST, missing); -+#pragma omp parallel if (chunksize >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= chunksize)) -+#pragma omp for - for (SizeT i = 0; i < chunksize; ++i) - { - double x = xval[i]; -@@ -2069,10 +2098,10 @@ - DDoubleGDL* p1D; - DDoubleGDL* p2D; - DDoubleGDL* p3D; -- auto_ptr guard0; -- auto_ptr guard1; -- auto_ptr guard2; -- auto_ptr guard3; -+ Guard guard0; -+ Guard guard1; -+ Guard guard2; -+ Guard guard3; - - if (nParam < 2) e->Throw("Incorrect number of arguments."); - -@@ -2084,7 +2113,7 @@ - else - { - p0D = static_cast(p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard0.reset(p0D); -+ guard0.Init(p0D); - } - - BaseGDL* p1 = e->GetParDefined(1); -@@ -2092,7 +2121,7 @@ - else - { - p1D = static_cast(p1->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard1.reset(p1D); -+ guard1.Init(p1D); - } - - BaseGDL* p2 = NULL; -@@ -2102,7 +2131,7 @@ - else - { - p2D = static_cast(p2->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard2.reset(p2D); -+ guard2.Init(p2D); - } - } - -@@ -2113,7 +2142,7 @@ - else - { - p3D = static_cast(p3->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard3.reset(p3D); -+ guard3.Init(p3D); - } - } - -@@ -2255,13 +2284,13 @@ - gsl_linalg_hermtd_decomp (mat, tau); - gsl_linalg_hermtd_unpack (mat, tau, Q, diag, subdiag); - -- DLong dims[2] = {p0->Dim(0), p0->Dim(0)}; -+ SizeT dims[2] = {p0->Dim(0), p0->Dim(0)}; - dimension dim0(dims, (SizeT) 2); - BaseGDL** p0Co = &e->GetPar( 0); - GDLDelete((*p0Co)); - *p0Co = new DComplexGDL(dim0, BaseGDL::NOZERO); - -- DLong n = p0->Dim(0); -+ SizeT n = p0->Dim(0); - dimension dim1(&n, (SizeT) 1); - BaseGDL** p1F = &e->GetPar( 1); - GDLDelete((*p1F)); -@@ -2320,13 +2349,13 @@ - gsl_linalg_hermtd_decomp (mat, tau); - gsl_linalg_hermtd_unpack (mat, tau, Q, diag, subdiag); - -- DLong dims[2] = {p0->Dim(0), p0->Dim(0)}; -+ SizeT dims[2] = {p0->Dim(0), p0->Dim(0)}; - dimension dim0(dims, (SizeT) 2); - BaseGDL** p0Co = &e->GetPar( 0); - GDLDelete((*p0Co)); - *p0Co = new DComplexDblGDL(dim0, BaseGDL::NOZERO); - -- DLong n = p0->Dim(0); -+ SizeT n = p0->Dim(0); - dimension dim1(&n, (SizeT) 1); - BaseGDL** p1D = &e->GetPar( 1); - GDLDelete((*p1D)); -@@ -2371,13 +2400,13 @@ - gsl_linalg_symmtd_decomp (mat, tau); - gsl_linalg_symmtd_unpack (mat, tau, Q, diag, subdiag); - -- DLong dims[2] = {p0->Dim(0), p0->Dim(0)}; -+ SizeT dims[2] = {p0->Dim(0), p0->Dim(0)}; - dimension dim0(dims, (SizeT) 2); - BaseGDL** p0Do = &e->GetPar( 0); - GDLDelete((*p0Do)); - *p0Do = new DDoubleGDL(dim0, BaseGDL::NOZERO); - -- DLong n = p0->Dim(0); -+ SizeT n = p0->Dim(0); - dimension dim1(&n, (SizeT) 1); - BaseGDL** p1D = &e->GetPar( 1); - GDLDelete((*p1D)); -@@ -2442,13 +2471,13 @@ - gsl_linalg_symmtd_decomp (mat, tau); - gsl_linalg_symmtd_unpack (mat, tau, Q, diag, subdiag); - -- DLong dims[2] = {p0->Dim(0), p0->Dim(0)}; -+ SizeT dims[2] = {p0->Dim(0), p0->Dim(0)}; - dimension dim0(dims, (SizeT) 2); - BaseGDL** p0Fo = &e->GetPar( 0); - GDLDelete((*p0Fo)); - *p0Fo = new DFloatGDL(dim0, BaseGDL::NOZERO); - -- DLong n = p0->Dim(0); -+ SizeT n = p0->Dim(0); - dimension dim1(&n, (SizeT) 1); - BaseGDL** p1F = &e->GetPar( 1); - GDLDelete((*p1F)); -@@ -2514,7 +2543,7 @@ - ); - // TODO: no guarding if res is an optimized constant - // NO!!! the return value of call_fun() is always owned by the caller (constants are Dup()ed) -- auto_ptr res_guard(res); -+ Guard res_guard(res); - // sanity checks - // if (res->Rank() != 1 || res->N_Elements() != x->size) - //AC for iCosmo -@@ -2539,8 +2568,8 @@ - if (res != dres) - { - // prevent 'res' from being deleted again -- res_guard.release(); -- res_guard.reset (dres); -+ res_guard.Release(); -+ res_guard.Init(dres); - } - // copying from GDL to GSL - for (size_t i = 0; i < x->size; i++) gsl_vector_set(f, i, (*dres)[i]); -@@ -2590,7 +2619,7 @@ - //AC for iCosmo - //if (p0->Rank() != 1) e->Throw("the first argument is expected to be a vector"); - BaseGDL* par = p0->Convert2(GDL_DOUBLE, BaseGDL::COPY); -- auto_ptr par_guard(par); -+ Guard par_guard(par); - - // 2-nd argument : name of user function defining the system - DString fun; -@@ -2732,12 +2761,12 @@ - // 2-nd argument : initial bound - BaseGDL* p1 = e->GetParDefined(1); - BaseGDL* par1 = p1->Convert2(GDL_DOUBLE, BaseGDL::COPY); -- auto_ptr par1_guard(par1); -+ Guard par1_guard(par1); - - // 3-th argument : final bound - BaseGDL* p2 = e->GetParDefined(2); - BaseGDL* par2 = p2->Convert2(GDL_DOUBLE, BaseGDL::COPY); -- auto_ptr par2_guard(par2); -+ Guard par2_guard(par2); - - // 1-st argument : name of user function defining the system - DString fun; -@@ -2789,7 +2818,37 @@ - } - } - -- gsl_integration_workspace *w = gsl_integration_workspace_alloc (1000); -+ // Definition of JMAX -+ int pos; -+ DLong wsize =static_cast(pow(2.0, (20-1))); -+ if(e->KeywordSet("JMAX")) -+ { -+ pos = e->KeywordIx("JMAX"); -+ e->AssureLongScalarKWIfPresent(pos, wsize); -+ wsize=static_cast(pow(2.0, (wsize-1))); -+ } -+ -+ // eps value: -+ double eps, eps_default; -+ bool isDouble = e->KeywordSet("DOUBLE") || p1->Type() == GDL_DOUBLE || p2->Type() == GDL_DOUBLE; -+ if (isDouble) {eps_default=1.e-12;} else {eps_default=1.e-6;} -+ -+ if (e->KeywordSet("EPS")) { -+ pos = e->KeywordIx("EPS"); -+ e->AssureDoubleScalarKWIfPresent(pos, eps); -+ if (eps < 0.0) { -+ Message(e->GetProName() + ": EPS must be positive ! Value set to Default."); -+ eps=eps_default; -+ } -+ if(!isfinite(eps)) { -+ Message(e->GetProName() + ": EPS must be finite ! Value set to Default."); -+ eps=eps_default; -+ } -+ } else { -+ eps=eps_default; -+ } -+ -+ gsl_integration_workspace *w = gsl_integration_workspace_alloc (wsize); - GDLGuard g1( w, gsl_integration_workspace_free); - - first=(*static_cast(par1))[0]; -@@ -2801,8 +2860,7 @@ - - if (debug) cout << "Boundaries : "<< first << " " << last <GetParDefined(1); - par1 = p1->Convert2(GDL_DOUBLE, BaseGDL::COPY); -- auto_ptr par1_guard(par1); -+ Guard par1_guard(par1); - - BaseGDL* p2 = NULL; - BaseGDL* par2 = NULL; -@@ -2853,9 +2911,14 @@ - // 3-th argument : final bound - p2 = e->GetParDefined(2); - par2 = p2->Convert2(GDL_DOUBLE, BaseGDL::COPY); -- auto_ptr par2_guard(par2); -+ Guard par2_guard(par2); - } - -+ // do we need to compute/return in double ? -+ bool isDouble = e->KeywordSet("DOUBLE") || p1->Type() == GDL_DOUBLE; -+ if (!e->KeywordSet("MIDEXP")) -+ if (p2->Type() == GDL_DOUBLE) isDouble=true; -+ - // 1-st argument : name of user function defining the system - DString fun; - e->AssureScalarPar(0, fun); -@@ -2924,28 +2987,25 @@ - } - else res=new DDoubleGDL(par1->Dim(), BaseGDL::NOZERO); - -- // eps value: -- double eps; -+ // managing eps value: -+ double eps, eps_default; -+ if (isDouble) {eps_default=1.e-12;} else {eps_default=1.e-6;} - int pos; -- if(!e->KeywordSet("MIDEXP")) -- { -- if (e->KeywordSet("EPS")) -- { -- pos = e->KeywordIx("EPS"); -- e->AssureDoubleScalarKWIfPresent(pos, eps); -- if(!isfinite(eps)) eps=1e-6; -- } -- else if (e->KeywordSet("DOUBLE") || p1->Type() == GDL_DOUBLE || p2->Type() == GDL_DOUBLE) eps = 1e-12; -- else eps = 1e-6; -- } -- else if (e->KeywordSet("EPS")) -- { -- pos = e->KeywordIx("EPS"); -- e->AssureDoubleScalarKWIfPresent(pos, eps); -- if(!isfinite(eps)) eps=1e-6; -- } -- else if ((e->KeywordSet("DOUBLE") && e->KeywordSet("MIDEXP")) || p1->Type() == GDL_DOUBLE) eps = 1e-12; -- else eps = 1e-6; -+ -+ if (e->KeywordSet("EPS")) { -+ pos = e->KeywordIx("EPS"); -+ e->AssureDoubleScalarKWIfPresent(pos, eps); -+ if (eps < 0.0) { -+ Message(e->GetProName() + ": EPS must be positive ! Value set to Default."); -+ eps=eps_default; -+ } -+ if(!isfinite(eps)) { -+ Message(e->GetProName() + ": EPS must be finite ! Value set to Default."); -+ eps=eps_default; -+ } -+ } else { -+ eps=eps_default; -+ } - - // Definition of JMAX - DLong wsize =static_cast(pow(2.0, (20-1))); -@@ -2979,7 +3039,7 @@ - e->KeywordSet("JMAX") || e->KeywordSet("K")) - { - gsl_integration_qag(&F, first, last, 0, eps, -- GSL_INTEG_GAUSS61, wsize, w, &result, &error); -+ wsize, GSL_INTEG_GAUSS61, w, &result, &error); - } - else - { -@@ -2997,13 +3057,9 @@ - - // gsl_integration_workspace_free (w); - -- if (!e->KeywordSet("MIDEXP")) -- { -- if (e->KeywordSet("DOUBLE") || p1->Type() == GDL_DOUBLE || p2->Type() == GDL_DOUBLE) return res; -- else return res->Convert2(GDL_FLOAT, BaseGDL::CONVERT); -- } -- else if (e->KeywordSet("DOUBLE") || p1->Type() == GDL_DOUBLE) return res; -+ if (isDouble) return res; - else return res->Convert2(GDL_FLOAT, BaseGDL::CONVERT); -+ - } - - -@@ -3094,7 +3150,7 @@ - BaseGDL* p0 = e->GetNumericArrayParDefined(0); - DComplexDblGDL* init = e->GetParAs(0); - BaseGDL* par0 = p0->Convert2(GDL_COMPLEXDBL, BaseGDL::COPY); -- auto_ptr par0_guard(par0); -+ Guard par0_guard(par0); - - if (init->N_Elements() != 3) - { -@@ -3624,8 +3680,8 @@ - ? BaseGDL::CONVERT - : BaseGDL::COPY - )); -- auto_ptr ret_guard; -- if (ret != p0) ret_guard.reset(ret); -+ Guard ret_guard; -+ if (ret != p0) ret_guard.Reset(ret); - - // GSL error handling - gsl_error_handler_t* old_handler = gsl_set_error_handler(&gsl_err_2_gdl_warn); -@@ -3843,7 +3899,7 @@ - if (dbl) res = new DComplexDblGDL(dim); - else res = new DComplexGDL(dim); - } -- auto_ptr res_guard(res); -+ Guard res_guard(res); - - // computing the result - if (dbl) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gsl_fun.hpp gdl/src/gsl_fun.hpp ---- gdl-0.9.3/src/gsl_fun.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gsl_fun.hpp 2013-07-31 09:41:43.927245740 -0600 -@@ -63,6 +63,13 @@ - BaseGDL* zeropoly(EnvT* e); - BaseGDL* spher_harm(EnvT* e); - -+ template< typename T1, typename T2> -+ int cp2data2_template( BaseGDL* p0, T2* data, SizeT nEl, -+ SizeT offset, SizeT stride_in, SizeT stride_out); -+ template< typename T> -+ int cp2data_template( BaseGDL* p0, T* data, SizeT nEl, -+ SizeT offset, SizeT stride_in, SizeT stride_out); -+ - } // namespace - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/gsl_matrix.cpp gdl/src/gsl_matrix.cpp ---- gdl-0.9.3/src/gsl_matrix.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/gsl_matrix.cpp 2013-07-08 12:39:21.927392745 -0600 -@@ -38,9 +38,9 @@ - - using namespace std; - -- const int szdbl=sizeof(double); -- const int szflt=sizeof(float); -- const int szlng=sizeof(long); -+ const int szdbl=sizeof(DDouble); -+ const int szflt=sizeof(DFloat); -+ const int szlng=sizeof(DLong); - - void ludc_pro( EnvT* e) - { -@@ -97,7 +97,7 @@ - } - - // copying over p0 the updated matrix -- DLong dims[2] = {p0->Dim(0), p0->Dim(0)}; -+ SizeT dims[2] = {p0->Dim(0), p0->Dim(0)}; - dimension dim0(dims, (SizeT) 2); - - BaseGDL** p0Do = &e->GetPar( 0); -@@ -116,7 +116,7 @@ - // { p0->Convert2(GDL_FLOAT, BaseGDL::CONVERT); } - - // copying over p1 the permutation vector -- DLong n = p0->Dim(0); -+ SizeT n = p0->Dim(0); - dimension dim1(&n, (SizeT) 1); - BaseGDL** p1D = &e->GetPar( 1); - GDLDelete((*p1D)); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/hash.cpp gdl/src/hash.cpp ---- gdl-0.9.3/src/hash.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/hash.cpp 2013-07-26 17:43:05.000000000 -0600 -@@ -0,0 +1,2338 @@ -+/*************************************************************************** -+ hash.cpp - for HASH objects -+ ------------------- -+ begin : July 22 2013 -+ copyright : (C) 2013 by M. Schellens et al. -+ email : m_schellens@users.sf.net -+ -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#include "includefirst.hpp" -+ -+#include "nullgdl.hpp" -+#include "datatypes.hpp" -+#include "envt.hpp" -+#include "dpro.hpp" -+#include "dinterpreter.hpp" -+#include "list.hpp" -+ -+std::string ValidTagName( const std::string in) -+{ -+ if( in.length() == 0) -+ return "_"; -+ std::string result = StrUpCase( in); -+ SizeT i = 0; -+ if( result[0] >= '0' && result[0] <= '9') -+ { -+ result = "_" + result; -+ ++i; -+ } -+ else if( result[0] == '!') -+ { -+ ++i; -+ } -+ for( ; i= 'A' && result[i] <= 'Z') || -+ (result[i] >= '0' && result[i] <= '9') || -+ result[i] == '$')) -+ result[i] = '_'; -+ } -+ return result; -+} -+ -+ -+// if not found returns -(pos +1) -+DLong HashIndex( DStructGDL* hashTable, BaseGDL* key) -+{ -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ assert( key != NULL && key != NullGDL::GetSingleInstance()); -+ -+ DLong searchIxStart = 0; -+ DLong searchIxEnd = hashTable->N_Elements(); -+ -+ for(;;) -+ { -+ DLong searchIx = (searchIxStart + searchIxEnd) / 2; -+ if( (*static_cast( hashTable->GetTag( pKeyTag, searchIx)))[0] == 0) -+ { -+ DLong checkIx = searchIx-1; -+ while( checkIx >= searchIxStart && -+ (*static_cast(hashTable->GetTag( pKeyTag, checkIx)))[0] == 0) -+ --checkIx; -+ if( checkIx < searchIxStart) -+ { -+ checkIx = searchIx+1; -+ while( checkIx < searchIxEnd && -+ (*static_cast(hashTable->GetTag( pKeyTag, checkIx)))[0] == 0) -+ ++checkIx; -+ if( checkIx == searchIxEnd) -+ { -+ // only empty elements found in interval -+ return -(searchIx + 1); -+ } -+ } -+ searchIx = checkIx; -+ } -+ DPtr kID = (*static_cast( hashTable->GetTag( pKeyTag, searchIx)))[0]; -+ assert( kID != 0); -+ int hashCompare = key->HashCompare( BaseGDL::interpreter->GetHeap( kID)); -+ if( hashCompare == 0) -+ return searchIx; -+ -+ if( searchIxStart == searchIxEnd) -+ { -+ return -(searchIxStart + 1); -+ } -+ -+ if( hashCompare == -1) // key < hashKey[searchIx] -+ searchIxEnd = searchIx; -+ else -+ { // key > hashKey[searchIx] -+ searchIxStart = searchIx+1; -+ if( searchIxStart >= hashTable->N_Elements()) -+ { -+ return -(hashTable->N_Elements() + 1); -+ } -+ } -+ if( searchIxStart == searchIxEnd && searchIx == searchIxStart) -+ { -+ return -(searchIxStart + 1); -+ } -+ } -+} -+ -+// copies all keys and values -+DStructGDL* CopyHashTable( DStructGDL* hashStruct, DStructGDL* hashTable, DLong nSizeNew) -+{ -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+// DStructDesc* hashDesc = hashStruct->Desc(); -+// DStructDesc* entryDesc = hashTable->Desc(); -+ -+ DLong nSize = hashTable->N_Elements();//(*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0]; -+ DLong nCount = (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0]; -+ -+ assert( nSizeNew >= nCount); -+ -+ DStructGDL* newHashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(nSizeNew)); -+ -+ // copy old table to new one, insert holes -+ SizeT nAdd = 0; -+ for( SizeT oldIx=0; oldIx(hashTable->GetTag( pKeyTag, oldIx)))[0] == 0) -+ continue; -+ -+ SizeT newIx = nAdd * nSizeNew / nCount; -+ assert( newIx >= nAdd); -+ -+ ++nAdd; -+ -+ DPtr keyP = (*static_cast(hashTable->GetTag( pKeyTag, oldIx)))[0]; -+ // create new heap copy -+ BaseGDL* key = BaseGDL::interpreter->GetHeap( keyP); -+ assert( key != NULL); -+ DPtr newKeyP = BaseGDL::interpreter->NewHeap( 1, key->Dup()); -+ -+ (*static_cast(newHashTable->GetTag( pKeyTag, newIx)))[0] = newKeyP; -+ -+ -+ DPtr valP = (*static_cast(hashTable->GetTag( pValueTag, oldIx)))[0]; -+ // create new heap copy -+ BaseGDL* value = BaseGDL::interpreter->GetHeap( valP); -+ if( value != NULL) -+ value = value->Dup(); -+ DPtr newValP = BaseGDL::interpreter->NewHeap( 1, value); -+ (*static_cast(newHashTable->GetTag( pValueTag, newIx)))[0] = newValP; -+ } -+ -+// SizeT oldIx = 0; -+// for( SizeT nAdd=0; nAdd(hashTable->GetTag( pKeyTag, oldIx)))[0] == 0) -+// ++oldIx; -+// assert( oldIx < nSize); -+// -+// SizeT newIx = nAdd * nSizeNew / nCount; -+// assert( newIx >= nAdd); -+// -+// DPtr keyP = (*static_cast(hashTable->GetTag( pKeyTag, oldIx)))[0]; -+// // create new heap copy -+// BaseGDL* key = BaseGDL::interpreter->GetHeap( keyP); -+// assert( key != NULL); -+// DPtr newKeyP = BaseGDL::interpreter->NewHeap( 1, key->Dup()); -+// -+// (*static_cast(newHashTable->GetTag( pKeyTag, newIx)))[0] = newKeyP; -+// -+// -+// DPtr valP = (*static_cast(hashTable->GetTag( pValueTag, oldIx)))[0]; -+// // create new heap copy -+// BaseGDL* value = BaseGDL::interpreter->GetHeap( valP); -+// if( value != NULL) -+// value = value->Dup(); -+// DPtr newValP = BaseGDL::interpreter->NewHeap( 1, value); -+// (*static_cast(newHashTable->GetTag( pValueTag, newIx)))[0] = newValP; -+// -+// } -+ return newHashTable; -+} -+ -+ -+// keeps the keys and values -+void GrowHashTable( DStructGDL* hashStruct, DStructGDL*& hashTable, DLong nSizeNew) -+{ -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+// DStructDesc* hashDesc = hashStruct->Desc(); -+// DStructDesc* entryDesc = hashTable->Desc(); -+ -+ DLong nSize = hashTable->N_Elements();//(*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0]; -+ DLong nCount = (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0]; -+ -+ DStructGDL* newHashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(nSizeNew)); -+ -+ assert( nSizeNew > nCount); -+ -+ // copy old table to new one, insert holes -+ SizeT nAdd = 0; -+ for( SizeT oldIx=0; oldIx(hashTable->GetTag( pKeyTag, oldIx)))[0] == 0) -+ continue; -+ -+ SizeT newIx = nAdd * nSizeNew / nCount; // +1 : keep bottom free -+ assert( newIx >= nAdd); -+ -+ ++nAdd; -+ -+ (*static_cast(newHashTable->GetTag( pKeyTag, newIx)))[0] = -+ (*static_cast(hashTable->GetTag( pKeyTag, oldIx)))[0]; -+ // prevent ref-count cleanup -+ (*static_cast(hashTable->GetTag( pKeyTag, oldIx)))[0] = 0; -+ -+ (*static_cast(newHashTable->GetTag( pValueTag, newIx)))[0] = -+ (*static_cast(hashTable->GetTag( pValueTag, oldIx)))[0]; -+ // prevent ref-count cleanup -+ (*static_cast(hashTable->GetTag( pValueTag, oldIx)))[0] = 0; -+ } -+ -+// SizeT oldIx = 0; -+// for( SizeT nAdd=0; nAdd(hashTable->GetTag( pKeyTag, oldIx)))[0] == 0) -+// oldIx++; -+// assert( oldIx < nSize); -+// -+// SizeT newIx = nAdd * nSizeNew / nCount; // +1 : keep bottom free -+// assert( newIx >= nAdd); -+// -+// (*static_cast(newHashTable->GetTag( pKeyTag, newIx)))[0] = -+// (*static_cast(hashTable->GetTag( pKeyTag, oldIx)))[0]; -+// // prevent ref-count cleanup -+// (*static_cast(hashTable->GetTag( pKeyTag, oldIx)))[0] = 0; -+// -+// (*static_cast(newHashTable->GetTag( pValueTag, newIx)))[0] = -+// (*static_cast(hashTable->GetTag( pValueTag, oldIx)))[0]; -+// // prevent ref-count cleanup -+// (*static_cast(hashTable->GetTag( pValueTag, oldIx)))[0] = 0; -+// -+// } -+ -+ DPtr hashTableID = (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0]; -+ assert( BaseGDL::interpreter->GetHeap( hashTableID) == hashTable); -+ // delete old -+ delete hashTable; -+ // set new instead -+ BaseGDL::interpreter->GetHeap( hashTableID) = newHashTable; -+ // update nSize -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = newHashTable->N_Elements(); -+ // return the new table -+ hashTable = newHashTable; -+} -+ -+ -+ -+BaseGDL* RemoveFromHashTable( EnvUDT* e, DStructGDL* hashStruct, BaseGDL* key) -+{ -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ // our current table -+ DPtr thisTableID = (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTable = static_cast(BaseGDL::interpreter->GetHeap( thisTableID)); -+ -+ DLong hashIndex = -1; -+ if( key == NULL) // special case - remove random -+ { -+ // remove last element -+ for( DLong h=hashTable->N_Elements()-1; h>=0; --h) -+ { -+ DPtr kID = (*static_cast(hashTable->GetTag( pKeyTag, h)))[0]; -+ if( kID != 0) -+ { -+ hashIndex = h; -+ break; -+ } -+ } -+ if( hashIndex < 0) // nothing found - ok for empty table :-) -+ return NullGDL::GetSingleInstance(); -+// ThrowFromInternalUDSub( e, "Internal error. Please report. Random hash index not found."); -+ } -+ else -+ { -+ hashIndex = HashIndex( hashTable, key); -+ if( hashIndex < 0) -+ ThrowFromInternalUDSub( e, "Key does not exist."); -+ } -+ -+ DPtr kID = (*static_cast(hashTable->GetTag( pKeyTag, hashIndex)))[0]; -+ DPtr vID = (*static_cast(hashTable->GetTag( pValueTag, hashIndex)))[0]; -+ -+ BaseGDL* retValue = BaseGDL::interpreter->GetHeap( vID); -+ BaseGDL::interpreter->GetHeap( vID) = NULL; -+ -+ BaseGDL::interpreter->FreeHeap( kID); -+ BaseGDL::interpreter->FreeHeap( vID); -+ -+ (*static_cast(hashTable->GetTag( pKeyTag, hashIndex)))[0] = 0; -+ (*static_cast(hashTable->GetTag( pValueTag, hashIndex)))[0] = 0; -+ -+ --((*static_cast( hashStruct->GetTag( nCountTag, 0)))[0]); -+ return retValue; -+} -+ -+ -+// must pass hashTable as reference as it might be changed (GrowHashTable) -+void InsertIntoHashTable( DStructGDL* hashStruct, DStructGDL*& hashTable, BaseGDL* key, BaseGDL* value) -+{ -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+// DStructDesc* hashDesc = hashStruct->Desc(); -+// DStructDesc* entryDesc = hashTable->Desc(); -+ -+// DLong nSize = (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0]; -+ DLong nSize = hashTable->N_Elements();//(*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0]; -+ assert( nSize == (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0]); -+ DLong nCount = (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0]; -+ -+// SizeT actPosPtr = 0; -+// std::cout << "inserting: "; -+// key->ToStream( std::cout, 80, &actPosPtr); -+// std::cout << ":"; -+// value->ToStream( std::cout, 80, &actPosPtr); -+ -+ if( nCount == 0) -+ { -+ assert( nSize >= 1); -+ DLong insertPos = nSize / 2; -+// std::cout << " at " << i2s(insertPos) << std::endl; -+ DPtr pID = BaseGDL::interpreter->NewHeap(1,value); -+ (*static_cast(hashTable->GetTag( pValueTag, insertPos)))[0] = pID; -+ DPtr kID = BaseGDL::interpreter->NewHeap(1,key); -+ (*static_cast(hashTable->GetTag( pKeyTag, insertPos)))[0] = kID; -+ (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0] = 1; -+ return; -+ } -+ -+ // must be done here, otherwise hashIndex will be not in sync -+ if( nSize <= (nCount * 10 / 8)) // grow on 80% occupation. TODO: find optimal value -+ { -+// std::cout << " grow table "<< i2s(nSize) << " -> " << i2s(nSize * 2) << std::endl; -+ -+ // deletes hashTable, replaces it by new one, updates nSize -+ GrowHashTable( hashStruct, hashTable, nSize * 2); // grow to 50% occupation. TODO: find optimal value -+// nSize = (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0]; -+ nSize = hashTable->N_Elements(); -+ } -+ -+ DLong hashIndex = HashIndex( hashTable, key); -+ if( hashIndex >= 0) // hit -> overwrite -+ { -+// std::cout << " (ovwrt) at "<< i2s(hashIndex) <(hashTable->GetTag( pValueTag, hashIndex)))[0]; -+ DPtr kID = (*static_cast(hashTable->GetTag( pKeyTag, hashIndex)))[0]; -+ GDLDelete( BaseGDL::interpreter->GetHeap( vID)); -+ GDLDelete( BaseGDL::interpreter->GetHeap( kID)); -+ BaseGDL::interpreter->GetHeap( vID) = value; -+ BaseGDL::interpreter->GetHeap( kID) = key; -+ return; -+ } -+ -+// std::cout << " nSize = "<< i2s(nSize) < insert -+ DLong insertPos = -(hashIndex + 1); -+ -+// std::cout << " try "<< i2s(insertPos) << "... "; -+ -+ // make some space -+ DLong nextFreeElementIx = insertPos; -+ for( ; nextFreeElementIx < nSize; ++nextFreeElementIx) -+ { -+ // shuffle against top -+ // insert at insertPos as old insertPos is shuffled up -+ if( (*static_cast(hashTable->GetTag( pKeyTag, nextFreeElementIx)))[0] == 0) -+ { -+ // shuffle elements away to make space for new element -+ // we could optimize this by using a new DStructGDL function -+ for( DLong i=nextFreeElementIx; i>insertPos; --i) -+ { -+ (*static_cast(hashTable->GetTag( pKeyTag, i)))[0] = -+ (*static_cast(hashTable->GetTag( pKeyTag, i-1)))[0]; -+ -+ (*static_cast(hashTable->GetTag( pValueTag, i)))[0] = -+ (*static_cast(hashTable->GetTag( pValueTag, i-1)))[0]; -+ -+// std::cout << i2s(i-1) << " -> " << i2s(i) << std::endl; -+ } -+ break; -+ } -+ } -+ -+ if( nextFreeElementIx >= nSize) -+ { -+ // shuffle against bottom -+ // insert at insertPos-1 as old insertPos stays at insertPos -+ --insertPos; -+ nextFreeElementIx = insertPos; -+ for( ; nextFreeElementIx >= 0; --nextFreeElementIx) -+ { -+ if( (*static_cast(hashTable->GetTag( pKeyTag, nextFreeElementIx)))[0] == 0) -+ { -+ for( DLong i=nextFreeElementIx; i " << i2s(i) << " kID:";//std::endl; -+// std::cout << (*static_cast(hashTable->GetTag( pKeyTag, i+1)))[0]; -+// std::cout << " vID:" << (*static_cast(hashTable->GetTag( pValueTag, i+1)))[0]; -+// std::cout << std::endl; -+ -+ (*static_cast(hashTable->GetTag( pKeyTag, i)))[0] = -+ (*static_cast(hashTable->GetTag( pKeyTag, i+1)))[0]; -+ -+ (*static_cast(hashTable->GetTag( pValueTag, i)))[0] = -+ (*static_cast(hashTable->GetTag( pValueTag, i+1)))[0]; -+ -+// std::cout << i2s(i+1) << " -> " << i2s(i) << std::endl; -+ } -+ break; -+ } -+ } -+ } -+ -+ assert( nextFreeElementIx >= 0 && nextFreeElementIx < nSize); -+ -+ // insert the element -+ // overwrite, the (now overwritten) pointers are already moved or are NULL -+ DPtr kID = BaseGDL::interpreter->NewHeap(1,key); -+ (*static_cast(hashTable->GetTag( pKeyTag, insertPos)))[0] = kID; -+ DPtr pID = BaseGDL::interpreter->NewHeap(1,value); -+ (*static_cast(hashTable->GetTag( pValueTag, insertPos)))[0] = pID; -+ -+// std::cout << " at "<< i2s(insertPos) << "(" << i2s(kID) << "," << i2s(pID) << ")" <( hashStruct->GetTag( nCountTag, 0)))[0] = ++nCount; -+} -+ -+ -+ -+void HASH__ToStream( DStructGDL* oStructGDL, std::ostream& o, SizeT w, SizeT* actPosPtr) -+{ -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ SizeT nCount = (*static_cast(oStructGDL->GetTag( nCountTag, 0)))[0]; -+// SizeT nSize = (*static_cast(oStructGDL->GetTag( nSizeTag, 0)))[0]; -+ -+ DPtr pHashTable = (*static_cast( oStructGDL->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+ DLong nSize = hashTable->N_Elements(); -+ -+ SizeT ix = 0; -+ for( SizeT i=0; i(hashTable->GetTag( pKeyTag, ix)))[0] == 0) -+ ++ix; -+ assert( ix < nSize); -+ -+ DPtr pKey = (*static_cast(hashTable->GetTag( pKeyTag, ix)))[0]; -+ DPtr pValue = (*static_cast(hashTable->GetTag( pValueTag, ix)))[0]; -+ -+ BaseGDL* key = BaseGDL::interpreter->GetHeap( pKey); -+ assert( key != NULL); -+ -+ BaseGDL* value = BaseGDL::interpreter->GetHeap( pValue); -+ if( value == NULL) value = NullGDL::GetSingleInstance(); -+ -+// std::cout << "("<ToStream( o, w, actPosPtr); -+ o << ":"; -+ value->ToStream( o, w, actPosPtr); -+ if( (i+1) < nCount) -+ o << std::endl; -+ } -+} -+ -+DLong GetInitialTableSize( DLong nEntries) -+{ -+ DLong initialTableSize = 4; -+ DLong minEntries = nEntries * 2; // initial min 50% filling. TODO: find optimal value -+ while( initialTableSize < minEntries) initialTableSize <<= 1; //*= 2; -+ return initialTableSize; -+} -+ -+// checks wether referenced values are equal (recursively) -+bool PtrDerefEqual( DPtrGDL* l, DPtrGDL* r) -+{ -+ SizeT nEl = l->N_Elements(); -+ if( nEl != r->N_Elements()) -+ return false; -+ for( SizeT i=0; iGetHeap( pL); -+ BaseGDL* derefR = BaseGDL::interpreter->GetHeap( pR); -+ if( derefL == NullGDL::GetSingleInstance()) -+ derefL = NULL; -+ if( derefR == NullGDL::GetSingleInstance()) -+ derefR = NULL; -+ if( derefL == NULL && derefR == NULL) -+ continue; -+ if( derefL == NULL || derefR == NULL) -+ return false; -+ if( derefL->Type() != derefR->Type()) -+ return false; -+ if( derefL->Type() == GDL_PTR) -+ { -+ // recursion here -+ if( !PtrDerefEqual( static_cast( derefL), static_cast( derefR))) -+ return false; -+ } -+ else if( !derefL->ArrayEqual( derefR)) -+ return false; -+ } -+ return true; -+} -+ -+ -+ -+ -+ -+namespace lib { -+ -+ -+ -+ BaseGDL* HASH___OverloadIsTrue( EnvUDT* e) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ const int kwSELFIx = 0; -+ -+ SizeT nParam = e->NParam(1); // SELF -+ -+ BaseGDL* selfP = e->GetKW( kwSELFIx); -+ DStructGDL* self = GetSELF( selfP, e); -+ -+ DLong nCount = (*static_cast( self->GetTag( nCountTag, 0)))[0]; -+ -+ if( nCount == 0) -+ return new DByteGDL(0); -+ else -+ return new DByteGDL(1); -+ } -+ -+ -+ -+ BaseGDL* HASH___OverloadNEOp( EnvUDT* e) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ SizeT nParam = e->NParam(); // number of parameters actually given -+ // more precise error message -+ if( nParam < 3) // consider SELF -+ ThrowFromInternalUDSub( e, "Two parameters are needed: LEFT, RIGHT."); -+ -+ BaseGDL* l = e->GetKW(1); -+ if( l == NullGDL::GetSingleInstance()) -+ l = NULL; -+ -+ BaseGDL* r = e->GetKW(2); -+ if( r == NullGDL::GetSingleInstance()) -+ r = NULL; -+ -+ if( (l == NULL && r == NULL)) -+ ThrowFromInternalUDSub( e, "At least one parameter must be defined and a HASH."); -+ -+ DStructGDL* leftStruct = NULL; -+ DObj leftID = 0; -+ if( l != NULL && l->Type() == GDL_OBJ) -+ { -+ DObjGDL* left = static_cast(l); -+ leftID = (*left)[0]; -+ if( leftID == 0) -+ { // null object -> compare to !NULL -+ l = NULL; -+ } -+ else -+ { -+ try { -+ leftStruct = BaseGDL::interpreter->GetObjHeap( leftID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Left parameter object ID <"+i2s(leftID)+"> not found."); -+ } -+ if( !leftStruct->Desc()->IsParent("HASH")) -+ leftStruct = NULL; -+ } -+ } -+ DStructGDL* rightStruct = NULL; -+ DObj rightID = 0; -+ if( r != NULL && r->Type() == GDL_OBJ) -+ { -+ DObjGDL* right = static_cast(r); -+ rightID = (*right)[0]; -+ if( rightID == 0) -+ { // null object -> compare to !NULL -+ r = NULL; -+ } -+ else -+ { -+ try { -+ rightStruct = BaseGDL::interpreter->GetObjHeap( rightID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Right parameter object ID <"+i2s(rightID)+"> not found."); -+ } -+ if( !rightStruct->Desc()->IsParent("HASH")) -+ rightStruct = NULL; -+ } -+ } -+ -+ DStructGDL* hashStruct = NULL; -+ DStructGDL* hashTable = NULL; -+ DStructGDL* compareStruct = NULL; -+ DStructGDL* compareTable = NULL; -+ BaseGDL* compare = NULL; -+ if( leftStruct != NULL) -+ { -+ hashStruct = leftStruct; -+ DPtr pHashTable = (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0]; -+ hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+ if( rightStruct != NULL) -+ { -+ compareStruct = rightStruct; -+ DPtr pHashTable = (*static_cast( compareStruct->GetTag( pDataTag, 0)))[0]; -+ compareTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ } -+ else -+ { -+ compare = r; -+ } -+ } -+ else if( rightStruct != NULL) -+ { -+ hashStruct = rightStruct; -+ DPtr pHashTable = (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0]; -+ hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+ compare = l; -+ } -+ else -+ ThrowFromInternalUDSub( e, "At least one parameter must be a HASH."); -+ -+ DLong nSize = hashTable->N_Elements(); -+// DLong nCount = (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0]; -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pListDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // the result list -+ DStructDesc* listDesc= structDesc::LIST; -+ DStructDesc* containerDesc= structDesc::GDL_CONTAINER_NODE; -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct -+ BaseGDL* newObj = new DObjGDL( objID); // the list object -+ Guard newObjGuard( newObj); -+ -+ -+ DLong nCountList = 0; -+ DStructGDL* cStructLast = NULL; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ for( SizeT i=0; i(hashTable->GetTag( pKeyTag, i)))[0]; -+ if( kID == 0) -+ continue; -+ -+ BaseGDL* key = BaseGDL::interpreter->GetHeap( kID); -+ assert( key != NULL); -+ -+ if( compareStruct == NULL) // against value -+ { -+ DPtr vID = (*static_cast(hashTable->GetTag( pValueTag, i)))[0]; -+ BaseGDL* v = BaseGDL::interpreter->GetHeap( vID); -+ -+ BaseGDL* vCmp = compare; -+ -+ if( v == NULL || v == NullGDL::GetSingleInstance()) -+ { -+ if( vCmp == NULL /*&& vCmp == NullGDL::GetSingleInstance()*/) -+ continue; -+ } -+ if( vCmp == NULL /*|| vCmp == NullGDL::GetSingleInstance()*/) -+ { -+ if( v == NULL && v == NullGDL::GetSingleInstance()) -+ continue; -+ } -+ if( v != NULL && vCmp != NULL) -+ { -+ if( v->Type() == vCmp->Type()) -+ { -+ -+ if( v->Type() == GDL_PTR) -+ { -+ if( PtrDerefEqual( static_cast(v), static_cast(vCmp))) -+ continue; -+ } -+ else if( v->ArrayEqual( vCmp)) -+ continue; -+ } -+ } -+ } -+ else // against other HASH -+ { -+ DLong insertIx = HashIndex(compareTable, key); -+ if( insertIx >= 0) // found -+ { -+ -+ DPtr vID = (*static_cast(hashTable->GetTag( pValueTag, i)))[0]; -+ BaseGDL* v = BaseGDL::interpreter->GetHeap( vID); -+ -+ DPtr vCmpID = (*static_cast(compareTable->GetTag( pValueTag, insertIx)))[0]; -+ BaseGDL* vCmp = BaseGDL::interpreter->GetHeap( vCmpID); -+ -+ if( v == NULL || v == NullGDL::GetSingleInstance()) -+ { -+ if( vCmp == NULL || vCmp == NullGDL::GetSingleInstance()) -+ continue; -+ } -+ if( vCmp == NULL || vCmp == NullGDL::GetSingleInstance()) -+ { -+ if( v == NULL || v == NullGDL::GetSingleInstance()) -+ continue; -+ } -+ if( v != NULL && vCmp != NULL) -+ { -+ if( v->Type() == vCmp->Type()) -+ { -+ -+ if( v->Type() == GDL_PTR) -+ { -+ if( PtrDerefEqual( static_cast(v), static_cast(vCmp))) -+ continue; -+ } -+ else if( v->ArrayEqual( vCmp)) -+ continue; -+ } -+ } -+ } -+ } -+ -+ // not equal or not found -> insert into LIST -+ DPtr dID = e->Interpreter()->NewHeap(1,key->Dup()); -+ -+ cStruct = new DStructGDL( containerDesc, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pListDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ ++nCountList; -+ } // for -+ -+ // now check other HASH (if it is a HASH) -+ // add all keys not in first HASH -+ if( compareStruct != NULL) -+ { -+ DLong nSizeCmp = compareTable->N_Elements(); -+ for( SizeT i=0; i(compareTable->GetTag( pKeyTag, i)))[0]; -+ if( kID == 0) -+ continue; -+ -+ BaseGDL* key = BaseGDL::interpreter->GetHeap( kID); -+ assert( key != NULL); -+ -+ DLong insertIx = HashIndex(hashTable, key); -+ if( insertIx >= 0) // found -+ { -+ // this key was already handled (inserted or not) during the first compare -+ continue; -+ } -+ -+ // not equal -> insert into LIST -+ DPtr dID = e->Interpreter()->NewHeap(1,key->Dup()); -+ -+ cStruct = new DStructGDL( containerDesc, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pListDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ ++nCountList; -+ } // for -+ } -+ -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = nCountList; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } // HASH___OverloadNEOp -+ -+ -+ -+ BaseGDL* HASH___OverloadEQOp( EnvUDT* e) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ SizeT nParam = e->NParam(); // number of parameters actually given -+ // more precise error message -+ if( nParam < 3) // consider SELF -+ ThrowFromInternalUDSub( e, "Two parameters are needed: LEFT, RIGHT."); -+ -+ BaseGDL* l = e->GetKW(1); -+ if( l == NullGDL::GetSingleInstance()) -+ l = NULL; -+ -+ BaseGDL* r = e->GetKW(2); -+ if( r == NullGDL::GetSingleInstance()) -+ r = NULL; -+ -+ if( (l == NULL && r == NULL)) -+ ThrowFromInternalUDSub( e, "At least one parameter must be defined and a HASH."); -+ -+ DStructGDL* leftStruct = NULL; -+ DObj leftID = 0; -+ if( l != NULL && l->Type() == GDL_OBJ) -+ { -+ DObjGDL* left = static_cast(l); -+ leftID = (*left)[0]; -+ if( leftID == 0) -+ { // null object -> compare to !NULL -+ l = NULL; -+ } -+ else -+ { -+ try { -+ leftStruct = BaseGDL::interpreter->GetObjHeap( leftID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Left parameter object ID <"+i2s(leftID)+"> not found."); -+ } -+ if( !leftStruct->Desc()->IsParent("HASH")) -+ leftStruct = NULL; -+ } -+ } -+ DStructGDL* rightStruct = NULL; -+ DObj rightID = 0; -+ if( r != NULL && r->Type() == GDL_OBJ) -+ { -+ DObjGDL* right = static_cast(r); -+ rightID = (*right)[0]; -+ if( rightID == 0) -+ { // null object -> compare to !NULL -+ r = NULL; -+ } -+ else -+ { -+ try { -+ rightStruct = BaseGDL::interpreter->GetObjHeap( rightID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Right parameter object ID <"+i2s(rightID)+"> not found."); -+ } -+ if( !rightStruct->Desc()->IsParent("HASH")) -+ rightStruct = NULL; -+ } -+ } -+ -+ DStructGDL* hashStruct = NULL; -+ DStructGDL* hashTable = NULL; -+ DStructGDL* compareStruct = NULL; -+ DStructGDL* compareTable = NULL; -+ BaseGDL* compare = NULL; -+ if( leftStruct != NULL) -+ { -+ hashStruct = leftStruct; -+ DPtr pHashTable = (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0]; -+ hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+ if( rightStruct != NULL) -+ { -+ compareStruct = rightStruct; -+ DPtr pHashTable = (*static_cast( compareStruct->GetTag( pDataTag, 0)))[0]; -+ compareTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ } -+ else -+ { -+ compare = r; -+ } -+ } -+ else if( rightStruct != NULL) -+ { -+ hashStruct = rightStruct; -+ DPtr pHashTable = (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0]; -+ hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+ compare = l; -+ } -+ else -+ ThrowFromInternalUDSub( e, "At least one parameter must be a HASH."); -+ -+ DLong nSize = hashTable->N_Elements(); -+ DLong nCount = (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0]; -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pListDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // the result list -+ DStructDesc* listDesc= structDesc::LIST; -+ DStructDesc* containerDesc= structDesc::GDL_CONTAINER_NODE; -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct -+ BaseGDL* newObj = new DObjGDL( objID); // the list object -+ Guard newObjGuard( newObj); -+ -+ -+ DLong nCountList = 0; -+ DStructGDL* cStructLast = NULL; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ for( SizeT i=0; i(hashTable->GetTag( pKeyTag, i)))[0]; -+ if( kID == 0) -+ continue; -+ -+ BaseGDL* key = BaseGDL::interpreter->GetHeap( kID); -+ assert( key != NULL); -+ -+ if( compareStruct == NULL) // against value -+ { -+ DPtr vID = (*static_cast(hashTable->GetTag( pValueTag, i)))[0]; -+ BaseGDL* v = BaseGDL::interpreter->GetHeap( vID); -+ -+ BaseGDL* vCmp = compare; -+ -+ if( v == NULL || v == NullGDL::GetSingleInstance()) -+ { -+ if( vCmp != NULL /*&& vCmp != NullGDL::GetSingleInstance()*/) -+ continue; -+ } -+ if( vCmp == NULL /*|| vCmp == NullGDL::GetSingleInstance()*/) -+ { -+ if( v != NULL && v != NullGDL::GetSingleInstance()) -+ continue; -+ } -+ if( v != NULL) -+ { -+ if( v->Type() != vCmp->Type()) -+ continue; -+ -+ if( v->Type() == GDL_PTR) -+ { -+ if( !PtrDerefEqual( static_cast(v), static_cast(vCmp))) -+ continue; -+ } -+ else if( !v->ArrayEqual( vCmp)) -+ continue; -+ } -+ } -+ else // against other HASH -+ { -+ DLong insertIx = HashIndex(compareTable, key); -+ if( insertIx < 0) // not found -+ continue; -+ -+ DPtr vID = (*static_cast(hashTable->GetTag( pValueTag, i)))[0]; -+ BaseGDL* v = BaseGDL::interpreter->GetHeap( vID); -+ -+ DPtr vCmpID = (*static_cast(compareTable->GetTag( pValueTag, insertIx)))[0]; -+ BaseGDL* vCmp = BaseGDL::interpreter->GetHeap( vCmpID); -+ -+ if( v == NULL || v == NullGDL::GetSingleInstance()) -+ { -+ if( vCmp != NULL && vCmp != NullGDL::GetSingleInstance()) -+ continue; -+ } -+ if( vCmp == NULL || vCmp == NullGDL::GetSingleInstance()) -+ { -+ if( v != NULL && v != NullGDL::GetSingleInstance()) -+ continue; -+ } -+ if( v != NULL) -+ { -+ if( v->Type() != vCmp->Type()) -+ continue; -+ -+ if( v->Type() == GDL_PTR) -+ { -+ if( !PtrDerefEqual( static_cast(v), static_cast(vCmp))) -+ continue; -+ } -+ else if( !v->ArrayEqual( vCmp)) -+ continue; -+ } -+ } -+ -+ // equal -> insert into LIST -+ DPtr dID = e->Interpreter()->NewHeap(1,key->Dup()); -+ -+ cStruct = new DStructGDL( containerDesc, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pListDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ ++nCountList; -+ } // for -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = nCountList; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ -+ -+ BaseGDL* HASH___OverloadPlus( EnvUDT* e) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ SizeT nParam = e->NParam(); // number of parameters actually given -+ // more precise error message -+ if( nParam < 3) -+ ThrowFromInternalUDSub( e, "Two parameters are needed: LEFT, RIGHT."); -+ -+ // default behavior: Exact like scalar indexing -+ BaseGDL* l = e->GetKW(1); -+ if(l == NULL || (l->Type() != GDL_OBJ && l->Type() != GDL_STRUCT)) -+ ThrowFromInternalUDSub( e, "Left parameter must be a HASH or STRUCT."); -+ -+ BaseGDL* r = e->GetKW(2); -+ if(r == NULL || (r->Type() != GDL_OBJ && r->Type() != GDL_STRUCT)) -+ ThrowFromInternalUDSub( e, "Right parameter must be a HASH or STRUCT."); -+ -+ // new hash -+ DStructGDL* hashStruct= new DStructGDL( structDesc::HASH, dimension()); -+ DObj objID= e->NewObjHeap( 1, hashStruct); // owns hashStruct, sets ref count to 1 -+ BaseGDL* newObj = new DObjGDL( objID); // the return HASH object -+ Guard newObjGuard( newObj); -+ -+ DStructGDL* leftStruct = NULL; -+ DObj leftID = 0; -+ if( l->Type() == GDL_OBJ) -+ { -+ DObjGDL* left = static_cast(l); -+ leftID = (*left)[0]; -+ try { -+ leftStruct = BaseGDL::interpreter->GetObjHeap( leftID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Left parameter object ID <"+i2s(leftID)+"> not found."); -+ } -+ if( !leftStruct->Desc()->IsParent("HASH")) -+ ThrowFromInternalUDSub( e, "Left parameter object ("+leftStruct->Desc()->Name()+") must be a HASH."); -+ } -+ else -+ { -+ leftStruct = static_cast(l); -+ } -+ -+ DStructGDL* rightStruct = NULL; -+ DObj rightID = 0; -+ if( r->Type() == GDL_OBJ) -+ { -+ DObjGDL* right = static_cast(r); -+ rightID = (*right)[0]; -+ try { -+ rightStruct = BaseGDL::interpreter->GetObjHeap( rightID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Right parameter object ID <"+i2s(rightID)+"> not found."); -+ } -+ if( !rightStruct->Desc()->IsParent("HASH")) -+ ThrowFromInternalUDSub( e, "Right parameter object ("+rightStruct->Desc()->Name()+") must be a HASH."); -+ } -+ else -+ { -+ rightStruct = static_cast(r); -+ } -+ -+ if( leftID != 0 && rightID != 0) -+ { -+ // merge sort them together -+ DLong nCountL = (*static_cast(leftStruct->GetTag( nCountTag, 0)))[0]; -+ DLong nCountR = (*static_cast(rightStruct->GetTag( nCountTag, 0)))[0]; -+ -+ DPtr pHashTableL = (*static_cast( leftStruct->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTableL = static_cast(BaseGDL::interpreter->GetHeap( pHashTableL)); -+ DPtr pHashTableR = (*static_cast( rightStruct->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTableR = static_cast(BaseGDL::interpreter->GetHeap( pHashTableR)); -+ -+ DLong nSizeL = hashTableL->N_Elements(); -+ DLong nSizeR = hashTableR->N_Elements(); -+ -+ DLong nCountMax = nCountL + nCountR; -+ -+ // new hash table -+ DLong initialTableSize = GetInitialTableSize( nCountMax); -+ DStructGDL* hashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, hashTable); // owns hashTable, sets ref count to 1 -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ -+ DLong nSize = hashTable->N_Elements(); -+ -+ assert( nSize >= nCountMax); -+ -+ if( nCountMax == 0) // two empty HASH -+ { -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = nSize; -+ // nCount was set to zero at init -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ DLong leftIx = -1; -+ DLong rightIx = -1; -+ // advance both to 1st -+ if( nCountL > 0) -+ while( (*static_cast(hashTableL->GetTag( pKeyTag, ++leftIx)))[0] == 0); -+ if( leftIx == -1) -+ leftIx = nSizeL; -+ if( nCountR > 0) -+ while( (*static_cast(hashTableR->GetTag( pKeyTag, ++rightIx)))[0] == 0); -+ if( rightIx == -1) -+ rightIx = nSizeR; -+ -+ DLong nCount = nCountMax; -+ for( SizeT el=0; el(hashTableL->GetTag( pKeyTag, leftIx)))[0]; -+ keyL = BaseGDL::interpreter->GetHeap( kIDL); -+ assert( keyL != NULL); -+ -+ if( rightIx < nSizeR) -+ { -+ DPtr kIDR = (*static_cast(hashTableR->GetTag( pKeyTag, rightIx)))[0]; -+ keyR = BaseGDL::interpreter->GetHeap( kIDR); -+ assert( keyR != NULL); -+ -+ // both valid -> compare -+ hashCompare = keyL->HashCompare( keyR); -+ if( hashCompare == 0) -+ --nCount; -+ } -+ else -+ { -+ // right finish -> use left -+ hashCompare = -1; -+ } -+ } -+ else -+ { -+ // left finish -> use right -+ if( rightIx >= nSizeR) -+ assert( rightIx < nSizeR); -+ -+ DPtr kIDR = (*static_cast(hashTableR->GetTag( pKeyTag, rightIx)))[0]; -+ keyR = BaseGDL::interpreter->GetHeap( kIDR); -+ assert( keyR != NULL); -+ -+ hashCompare = 1; -+ } -+ -+ DLong insertIx = el * nSize / nCountMax; -+ if( hashCompare == -1) // keyL smaller -> use left -+ { -+ DPtr kID = BaseGDL::interpreter->NewHeap(1,keyL->Dup()); -+ (*static_cast(hashTable->GetTag( pKeyTag, insertIx)))[0] = kID; -+ -+ DPtr vSrcID = (*static_cast(hashTableL->GetTag( pValueTag, leftIx)))[0]; -+ BaseGDL* value = BaseGDL::interpreter->GetHeap( vSrcID); -+ if( value != NULL) -+ value = value->Dup(); -+ -+ DPtr vID = BaseGDL::interpreter->NewHeap(1,value); -+ (*static_cast(hashTable->GetTag( pValueTag, insertIx)))[0] = vID; -+ -+ // advance l -+ while( (++leftIx < nSizeL) && (*static_cast(hashTableL->GetTag( pKeyTag, leftIx)))[0] == 0); -+ } -+ else // keyL larger or equal -> use right -+ { -+ DPtr kID = BaseGDL::interpreter->NewHeap(1,keyR->Dup()); -+ (*static_cast(hashTable->GetTag( pKeyTag, insertIx)))[0] = kID; -+ -+ DPtr vSrcID = (*static_cast(hashTableR->GetTag( pValueTag, rightIx)))[0]; -+ BaseGDL* value = BaseGDL::interpreter->GetHeap( vSrcID); -+ if( value != NULL) -+ value = value->Dup(); -+ -+ DPtr vID = BaseGDL::interpreter->NewHeap(1,value); -+ (*static_cast(hashTable->GetTag( pValueTag, insertIx)))[0] = vID; -+ -+ // advance r -+ while( (++rightIx < nSizeR) && (*static_cast(hashTableR->GetTag( pKeyTag, rightIx)))[0] == 0); -+ -+ if( hashCompare == 0) // advance r also if equal keys -+ while( (++leftIx < nSizeL) && (*static_cast(hashTableL->GetTag( pKeyTag, leftIx)))[0] == 0); -+ } -+ } -+ -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = nSize; -+ (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0] = nCount; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ DStructGDL* newHashTable; -+ -+ // at least one is struct -+ if( leftID != 0) // left is HASH -+ { -+ DLong nCountL = (*static_cast(leftStruct->GetTag( nCountTag, 0)))[0]; -+ -+ DPtr pHashTableL = (*static_cast( leftStruct->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTableL = static_cast(BaseGDL::interpreter->GetHeap( pHashTableL)); -+ -+ // right must be struct -+ DLong nCountR = rightStruct->NTags(); -+ -+ DLong nCount = nCountL + nCountR; -+ -+ DLong initialTableSize = GetInitialTableSize( nCount); -+ newHashTable = CopyHashTable( leftStruct, hashTableL, initialTableSize); -+ DPtr hashTableID= e->NewHeap( 1, newHashTable); // owns hashTable, sets ref count to 1 -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0] = nCountL; -+ } -+ else if( rightID != 0) // right is HASH -+ { -+ DLong nCountR = (*static_cast(rightStruct->GetTag( nCountTag, 0)))[0]; -+ -+ DPtr pHashTableR = (*static_cast( rightStruct->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTableR = static_cast(BaseGDL::interpreter->GetHeap( pHashTableR)); -+ -+ // right must be struct -+ DLong nCountL = leftStruct->NTags(); -+ -+ DLong nCount = nCountL + nCountR; -+ -+ DLong initialTableSize = GetInitialTableSize( nCount); -+ newHashTable = CopyHashTable( rightStruct, hashTableR, initialTableSize); -+ DPtr hashTableID= e->NewHeap( 1, newHashTable); // owns hashTable, sets ref count to 1 -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0] = nCountR; -+ } -+ else // both are struct -+ { -+ DLong nCountL = leftStruct->NTags(); -+ DLong nCountR = rightStruct->NTags(); -+ DLong nCount = nCountL + nCountR; -+ DLong initialTableSize = GetInitialTableSize( nCount); -+ newHashTable = new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, newHashTable); // owns hashTable, sets ref count to 1 -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ // set to zero at init //(*static_cast( hashStruct->GetTag( nCountTag, 0)))[0] = 0; -+ } -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = newHashTable->N_Elements(); -+ -+ if( leftID == 0) // add left struct -+ { -+ DStructDesc* desc = leftStruct->Desc(); -+ for( SizeT t=0; tNTags(); ++t) -+ { -+ DStringGDL *structKey = new DStringGDL( desc->TagName(t)); -+ BaseGDL* structData = leftStruct->GetTag(t,0); -+ assert(structData != NULL); -+ structData = structData->Dup(); -+ -+ InsertIntoHashTable( hashStruct, newHashTable, structKey, structData); -+ } -+ -+ } -+ if( rightID == 0) // add right struct -+ { -+ DStructDesc* desc = rightStruct->Desc(); -+ for( SizeT t=0; tNTags(); ++t) -+ { -+ DStringGDL *structKey = new DStringGDL( desc->TagName(t)); -+ BaseGDL* structData = rightStruct->GetTag(t,0); -+ assert(structData != NULL); -+ structData = structData->Dup(); -+ -+ InsertIntoHashTable( hashStruct, newHashTable, structKey, structData); -+ } -+ -+ } -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ -+ BaseGDL* hash__tostruct( EnvUDT* e) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ const int kwMISSINGIx = 0; // pushed 2nd -+ const int kwSKIPPEDIx = 1; -+ const int kwSELFIx = 2; -+ -+ SizeT nParam = e->NParam(1); // SELF -+ -+ BaseGDL* selfP = e->GetKW( kwSELFIx); -+ DStructGDL* self = GetSELF( selfP, e); -+ -+ DPtr pHashTable = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+// DLong nSize = (*static_cast( self->GetTag( nSizeTag, 0)))[0]; -+ DLong nSize = hashTable->N_Elements(); -+ DLong nCount = (*static_cast( self->GetTag( nCountTag, 0)))[0]; -+ -+ BaseGDL* missing = e->GetKW( kwMISSINGIx); -+ BaseGDL** skipped = NULL; -+ if( e->GlobalKW( kwSKIPPEDIx)) -+ skipped = &e->GetKW(kwSKIPPEDIx); -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pListDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ DStructDesc* listDesc= structDesc::LIST; -+ DStructDesc* containerDesc= structDesc::GDL_CONTAINER_NODE; -+ -+ DStructGDL* listStruct = NULL; -+ BaseGDL* newObj = NULL; -+ Guard newListObjGuard; -+ if( skipped != NULL) -+ { -+ listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct -+ newObj = new DObjGDL( objID); // the list object -+ newListObjGuard.Init( newObj); -+ } -+ -+ DStructDesc* nStructDesc = new DStructDesc( "$truct"); -+ // instance takes care of nStructDesc since it is unnamed -+ // dimension dim( 1); -+ // DStructGDL* instance = new DStructGDL( nStructDesc, dim); -+ DStructGDL* instance = new DStructGDL( nStructDesc); -+ Guard instance_guard(instance); -+ -+ DStructGDL* cStructLast = NULL; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ -+ for( SizeT el=0; el(hashTable->GetTag( pKeyTag, el)))[0]; -+ if( pKey == 0) -+ continue; -+ -+ DPtr pValue = (*static_cast(hashTable->GetTag( pValueTag, el)))[0]; -+ assert( pValue != 0); -+ -+ BaseGDL* key = BaseGDL::interpreter->GetHeap( pKey); -+ assert( key != NULL); -+ -+ BaseGDL* value = BaseGDL::interpreter->GetHeap( pValue); -+ if( value == NULL || value == NullGDL::GetSingleInstance()) -+ { -+ value = missing; -+ } -+ // we are not owner of value here -+ -+ bool added = false; -+ if( key->Type() == GDL_STRING && value != NULL) -+ { -+ assert( key->N_Elements() == 1); -+ DString keyString = (*static_cast(key))[0]; -+ -+ DString tagString = ValidTagName( keyString); -+ -+ if( nStructDesc->TagIndex( tagString) == -1) -+ { -+ instance->NewTag( tagString, value->Dup()); -+ added = true; -+ } -+ } -+ -+ if( !added && listStruct != NULL) // add key to skipped -+ { -+ key = key->Dup(); -+ DPtr dID = e->Interpreter()->NewHeap(1,key); -+ -+ cStruct = new DStructGDL( containerDesc, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pListDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ } -+ } -+ -+ if( skipped != NULL) -+ { -+ GDLDelete( *skipped); -+ newListObjGuard.Release(); -+ *skipped = newObj; -+ } -+ -+ if( instance->NTags() == 0) -+ return NullGDL::GetSingleInstance(); -+ -+ instance_guard.Release(); -+ return instance; -+ } -+ -+ BaseGDL* hash__keysvalues( EnvUDT* e, bool keys); -+ -+ BaseGDL* hash__values( EnvUDT* e) -+ { -+ return hash__keysvalues( e, false); -+ } -+ BaseGDL* hash__keys( EnvUDT* e) -+ { -+ return hash__keysvalues( e, true); -+ } -+ BaseGDL* hash__keysvalues( EnvUDT* e, bool doKeys) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ const int kwSELFIx = 0; -+ -+ SizeT nParam = e->NParam(1); // SELF -+ -+ BaseGDL* selfP = e->GetKW( kwSELFIx); -+ DStructGDL* self = GetSELF( selfP, e); -+ -+// DLong nSize = (*static_cast( self->GetTag( nSizeTag, 0)))[0]; -+ DLong nCount = (*static_cast( self->GetTag( nCountTag, 0)))[0]; -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pListDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ DStructDesc* listDesc= structDesc::LIST; -+ DStructDesc* containerDesc= structDesc::GDL_CONTAINER_NODE; -+ -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct -+ BaseGDL* newObj = new DObjGDL( objID); // the list object -+ Guard newObjGuard( newObj); -+ -+ DPtr pHashTable = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* hashTable = static_cast(BaseGDL::interpreter->GetHeap( pHashTable)); -+ -+ DLong nSize = hashTable->N_Elements(); -+ -+ unsigned sourceTag; -+ if( doKeys) -+ { -+ sourceTag = pKeyTag; -+ } -+ else // do values -+ { -+ sourceTag = pValueTag; -+ } -+ -+ DStructGDL* cStructLast = NULL; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ SizeT ix = 0; -+ for( SizeT i=0; i(hashTable->GetTag( pKeyTag, ix)))[0] == 0) -+ ++ix; -+ assert( ix < nSize); -+ -+ DPtr pSource = (*static_cast(hashTable->GetTag( sourceTag, ix)))[0]; -+ BaseGDL* source = BaseGDL::interpreter->GetHeap( pSource); -+ assert( !doKeys || source != NULL); -+ -+ if( source != NULL) // NULL is ok for values -+ source = source->Dup(); -+ DPtr dID = e->Interpreter()->NewHeap(1,source); -+ -+ cStruct = new DStructGDL( containerDesc, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pListDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ } -+ -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = nCount; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ BaseGDL* hash__haskey( EnvUDT* e) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ // see overload.cpp -+ const int kwSELFIx = 0; -+ const int kwKEYIx = 1; -+ -+ SizeT nParam = e->NParam(2); // SELF, KEYLIST -+ -+ BaseGDL* selfP = e->GetKW( kwSELFIx); -+ DStructGDL* self = GetSELF( selfP, e); -+ -+ BaseGDL* keyList = e->GetKW( kwKEYIx); -+ if( keyList == NULL || keyList == NullGDL::GetSingleInstance()) -+ ThrowFromInternalUDSub( e, "Key must be a scalar string or number."); -+ if( keyList->Type() != GDL_STRING && !NumericType(keyList->Type())) -+ ThrowFromInternalUDSub( e, "Key must be a scalar string or number."); -+ -+ DPtr thisTableID = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* thisHashTable = static_cast(e->Interpreter()->GetHeap( thisTableID)); -+ -+ if( keyList->N_Elements() == 1) -+ { -+ DLong hashIndex = HashIndex( thisHashTable, keyList); -+ if( hashIndex >= 0) -+ return new DLongGDL( 1); -+ return new DLongGDL( 0); -+ } -+ -+ SizeT keyListN_Elements = keyList->N_Elements(); -+ DIntGDL* result = new DIntGDL( dimension(keyListN_Elements)); // zero -+ Guard resultGuard( result); -+ for( SizeT i=0; iNewIx( i); -+ Guard keyGuard( key); -+ DLong hashIndex = HashIndex( thisHashTable, key); -+ if( hashIndex >= 0) -+ (*result)[ i] = 1; -+ } -+ resultGuard.Release(); -+ return result; -+ } -+ -+ -+ BaseGDL* hash__remove( EnvUDT* e, bool asFunction); -+ -+ BaseGDL* hash__remove_fun( EnvUDT* e) -+ { -+ return hash__remove( e, true); -+ } -+ void hash__remove_pro( EnvUDT* e) -+ { -+ hash__remove( e, false); -+ } -+ -+ BaseGDL* hash__remove( EnvUDT* e, bool asFunction) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ // see overload.cpp -+ const int kwALLIx = 0; -+ const int kwSELFIx = 1; -+ const int kwINDEXIx = 2; -+ -+ bool kwALL = false; -+ if (e->KeywordSet(kwALLIx)){ kwALL = true;} -+ -+ SizeT nParam = e->NParam(1); // minimum SELF -+ -+ BaseGDL* selfP = e->GetKW( kwSELFIx); -+ DStructGDL* self = GetSELF( selfP, e); -+ -+ if( kwALL) -+ { -+ if( asFunction) -+ { -+// DLong nSize = (*static_cast( self->GetTag( nSizeTag, 0)))[0]; -+ DLong nCount = (*static_cast( self->GetTag( nCountTag, 0)))[0]; -+ -+ DLong initialTableSize = GetInitialTableSize( 0); -+ -+ // our current table -+ DPtr thisTableID = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* thisHashTable = static_cast(e->Interpreter()->GetHeap( thisTableID)); -+ -+ DLong nSize = thisHashTable->N_Elements(); -+ -+ // new hash -+ DStructGDL* hashStruct= new DStructGDL( structDesc::HASH, dimension()); -+ DObj objID= e->NewObjHeap( 1, hashStruct); // owns hashStruct, sets ref count to 1 -+ BaseGDL* newObj = new DObjGDL( objID); // the return HASH object -+ Guard newObjGuard( newObj); -+ -+ // our new hash table -+ DStructGDL* hashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, hashTable); // owns hashTable, sets ref count to 1 -+ -+ // set our table to new empty table -+ (*static_cast( self->GetTag( pDataTag, 0)))[0] = hashTableID; -+ (*static_cast( self->GetTag( nSizeTag, 0)))[0] = initialTableSize; -+ (*static_cast( self->GetTag( nCountTag, 0)))[0] = 0; -+ -+ // set our old table to new HASH -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = thisTableID; -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = nSize; -+ (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0] = nCount; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ else -+ { -+ DLong initialTableSize = GetInitialTableSize( 0); -+ -+ // our current table -+ DPtr thisTableID = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* thisHashTable = static_cast(e->Interpreter()->GetHeap( thisTableID)); -+ -+ // our new hash table -+ DStructGDL* hashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, hashTable); // owns hashTable, sets ref count to 1 -+ -+ // set our table to new empty table -+ (*static_cast( self->GetTag( pDataTag, 0)))[0] = hashTableID; -+ (*static_cast( self->GetTag( nSizeTag, 0)))[0] = initialTableSize; -+ (*static_cast( self->GetTag( nCountTag, 0)))[0] = 0; -+ -+ // trigger ref-count delete of all elements -+ BaseGDL::interpreter->FreeHeap( thisTableID); -+ -+ return NULL; -+ } -+ } -+ -+ BaseGDL* index = NULL; -+ if( nParam >= 2) -+ index = e->GetKW(kwINDEXIx); -+ -+ if( index == NULL) -+ { -+ BaseGDL* removedElement = RemoveFromHashTable( e, self, NULL); -+ if( !asFunction) -+ { -+ GDLDelete( removedElement); -+ removedElement = NULL; -+ } -+ return removedElement; -+ } -+ -+ if( index->N_Elements() == 1) -+ { -+ BaseGDL* removedElement = RemoveFromHashTable( e, self, index); -+ if( !asFunction) -+ { -+ GDLDelete( removedElement); -+ removedElement = NULL; -+ } -+ return removedElement; -+ } -+ -+ if( asFunction) -+ { -+ // new hash -+ DStructGDL* hashStruct= new DStructGDL( structDesc::HASH, dimension()); -+ DObj objID= e->NewObjHeap( 1, hashStruct); // owns hashStruct, sets ref count to 1 -+ BaseGDL* newObj = new DObjGDL( objID); // the return HASH object -+ Guard newObjGuard( newObj); -+ -+ SizeT nRemove = index->N_Elements(); -+ -+ DLong initialTableSize = GetInitialTableSize( nRemove); -+ -+ // new hash table -+ // our current table (for the descriptor) -+// DPtr thisTableID = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+// DStructGDL* thisHashTable = static_cast(e->Interpreter()->GetHeap( thisTableID)); -+ DStructGDL* hashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, hashTable); // owns hashTable, sets ref count to 1 -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = initialTableSize; -+// (*static_cast( hashStruct->GetTag( nCountTag, 0)))[0] = 0; // already init to zero -+ -+ for( SizeT r=0; rNewIx( r); -+ Guard removeKeyGuard( removeKey); -+ BaseGDL* removedElement = RemoveFromHashTable( e, self, removeKey); -+ InsertIntoHashTable( hashStruct, hashTable, removeKeyGuard.release(), removedElement); -+ } -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ else -+ { -+ SizeT nRemove = index->N_Elements(); -+ for( SizeT r=0; rNewIx( r); -+ Guard removeKeyGuard( removeKey); -+ BaseGDL* removedElement = RemoveFromHashTable( e, self, removeKey); -+ GDLDelete( removedElement); -+ } -+ return NULL; -+ } -+ } -+ -+ void HASH___OverloadBracketsLeftSide( EnvUDT* e) -+ { -+ // SELF -+ //->AddPar("OBJREF")->AddPar("RVALUE")->AddPar("ISRANGE"); -+ //->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); -+ //->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ const unsigned par1Ix = 4; -+ -+ -+ SizeT nParam = e->NParam(1); // number of parameters actually given -+ if( nParam < 5) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Four parameters are needed: OBJREF, RVALUE, ISRANGE, SUB1."); -+ if( nParam > 5) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Only one dimensional access allowed."); -+ -+ // handle DOT access -+ bool dotAccess = false; -+ -+ BaseGDL** objRef = &e->GetKW(1); -+ if( *objRef == NULL || *objRef == NullGDL::GetSingleInstance()) -+ { -+ if( !e->GlobalKW(1)) -+ ThrowFromInternalUDSub( e, "Parameter 1 (OBJREF) is undefined."); -+ dotAccess = true; -+ } -+ BaseGDL* rValue = e->GetKW(2); -+ if( rValue == NULL) -+ { -+ rValue = NullGDL::GetSingleInstance(); -+ } -+ -+ BaseGDL* selfP = e->GetKW( 0); -+ DStructGDL* self = GetSELF( selfP, e); -+ -+ BaseGDL* isRange = e->GetKW(3); -+ if( isRange == NULL) -+ ThrowFromInternalUDSub( e, "Parameter 2 (ISRANGE) is undefined."); -+ SizeT nIsRange = isRange->N_Elements(); -+ if( nIsRange > (nParam - 4)) //- SELF and ISRANGE -+ ThrowFromInternalUDSub( e, "Parameter 2 (ISRANGE) must have "+i2s(nParam-4)+" elements."); -+ Guard isRangeLongGuard; -+ DLongGDL* isRangeLong; -+ if( isRange->Type() == GDL_LONG) -+ isRangeLong = static_cast( isRange); -+ else -+ { -+ try{ -+ isRangeLong = static_cast( isRange->Convert2( GDL_LONG, BaseGDL::COPY)); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ isRangeLongGuard.Reset( isRangeLong); -+ } -+ -+ BaseGDL* parX = e->GetKW( par1Ix); // implicit SELF, ISRANGE, par1..par8 -+ if( parX == NULL) -+ ThrowFromInternalUDSub( e, "Parameter is undefined: " + e->Caller()->GetString(e->GetKW( par1Ix))); -+ -+ DLong isRangeX = (*isRangeLong)[0]; -+ if( isRangeX != 0 && isRangeX != 1) -+ { -+// if( (isRangeX == 2 || isRangeX == 3) && rValue == NullGDL::GetSingleInstance()) -+// { -+// dotAccess = true; -+// isRangeX -= 2; -+// } -+// else -+ ThrowFromInternalUDSub( e, "Value of parameter 1 (ISRANGE["+i2s(0)+"]) is out of allowed range."); -+ } -+ if( isRangeX == 1) -+ { -+ if( parX->N_Elements() != 3) -+ { -+ ThrowFromInternalUDSub( e, "Range vector must have 3 elements: " + e->Caller()->GetString(e->GetKW( par1Ix))); -+ } -+ -+ DLongGDL* parXLong; -+ Guard parXLongGuard; -+ if( parX->Type() != GDL_LONG) -+ { -+ try{ -+ parXLong = static_cast( parX->Convert2( GDL_LONG, BaseGDL::COPY)); -+ parXLongGuard.Reset( parXLong); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ } -+ else -+ { -+ parXLong = static_cast( parX); -+ } -+ if( (*parXLong)[0] != 0 || (*parXLong)[1] != -1 || (*parXLong)[2] != 1) -+ ThrowFromInternalUDSub( e, "Subscript range is not allowed: [" + -+ i2s((*parXLong)[0])+":"+ i2s((*parXLong)[1])+":"+i2s((*parXLong)[2])+"]"); -+ -+ ThrowFromInternalUDSub( e, "Due to compatibility, setting all [*] to one value is not allowed. " -+ "Please report if you would appreciate this functionality."); -+ -+ // full access [*] -+ } -+ -+ DPtr thisTableID = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* thisHashTable = static_cast(e->Interpreter()->GetHeap( thisTableID)); -+ -+ // non-range (keyed) -+ SizeT par1N_Elements = parX->N_Elements(); -+ -+ if( par1N_Elements == 1) // single key -+ { -+ if( dotAccess) // -> objRef is NULL (or !NULL) -+ { -+ if( rValue != NullGDL::GetSingleInstance()) -+ { -+ ThrowFromInternalUDSub( e, "For struct access (OBJREF is !NULL), RVALUE must be !NULL as well."); -+ } -+ -+ DLong hashIndex = HashIndex( thisHashTable, parX); -+ if( hashIndex < 0) -+ ThrowFromInternalUDSub( e, "Key not found."); -+ -+ *objRef = thisHashTable->GetTag( pValueTag, hashIndex)->Dup(); -+ return; -+ } -+ -+ bool stolen = e->StealLocalKW( par1Ix); -+ if( !stolen) parX = parX->Dup(); // if called explicitely -+ InsertIntoHashTable( self, thisHashTable, parX, rValue->Dup()); -+ return; -+ } -+ if( dotAccess) -+ { -+ ThrowFromInternalUDSub( e, "Only single value struct access is allowed."); -+ } -+ -+ if( rValue != NULL && rValue != NullGDL::GetSingleInstance()) -+ { -+ if( rValue->N_Elements() != par1N_Elements) -+ { -+ ThrowFromInternalUDSub( e, "Key and Value must have the same number of elements."); -+ } -+ } -+ -+ if( rValue != NULL && rValue != NullGDL::GetSingleInstance()) -+ { -+ for( SizeT k=0; kNewIx(k), rValue->NewIx(k)); -+ } -+ } -+ else -+ { -+ for( SizeT k=0; kNewIx(k), NULL); -+ } -+ } -+ } -+ -+ -+ -+ BaseGDL* HASH___OverloadBracketsRightSide( EnvUDT* e) -+ { -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ const unsigned par1Ix = 2; -+ -+ SizeT nParam = e->NParam(1); // number of parameters actually given -+ // int envSize = e->EnvSize(); // number of parameters + keywords 'e' (pro) has defined -+ if( nParam < 3) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Two parameters are needed: ISRANGE, SUB1 [, ...]."); -+ if( nParam > 3) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Only one dimensional access allowed."); -+ -+ BaseGDL* selfP = e->GetKW( 0); -+// if( selfP->Type() != GDL_OBJ) -+// ThrowFromInternalUDSub( e, "SELF is not of type OBJECT."); -+// if( !selfP->Scalar()) -+// ThrowFromInternalUDSub( e, "SELF must be a scalar OBJECT."); -+// -+// DObjGDL* selfObj = static_cast( selfP); -+// DObj selfID = (*selfObj)[0]; -+// DStructGDL* self = e->Interpreter()->GetObjHeap( selfID); -+ DStructGDL* self = GetSELF( selfP, e); -+ -+ DPtr thisTableID = (*static_cast( self->GetTag( pDataTag, 0)))[0]; -+ DStructGDL* thisHashTable = static_cast(e->Interpreter()->GetHeap( thisTableID)); -+ -+ // default behavior: Exact like scalar indexing -+ BaseGDL* isRange = e->GetKW(1); -+ if( isRange == NULL) -+ ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) is undefined."); -+ SizeT nIsRange = isRange->N_Elements(); -+ if( nIsRange > (nParam - 2)) //- SELF and ISRANGE -+ ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) must have "+i2s(nParam-2)+" elements."); -+ Guard isRangeLongGuard; -+ DLongGDL* isRangeLong; -+ if( isRange->Type() == GDL_LONG) -+ isRangeLong = static_cast( isRange); -+ else -+ { -+ try{ -+ isRangeLong = static_cast( isRange->Convert2( GDL_LONG, BaseGDL::COPY)); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ isRangeLongGuard.Reset( isRangeLong); -+ } -+ -+ BaseGDL* index = NULL; -+ BaseGDL* parX = e->GetKW( par1Ix); // implicit SELF, ISRANGE, par1..par8 -+ if( parX == NULL) -+ ThrowFromInternalUDSub( e, "Parameter is undefined: " + e->Caller()->GetString(e->GetKW( par1Ix))); -+ -+ DLong isRangeX = (*isRangeLong)[0]; -+ if( isRangeX != 0 && isRangeX != 1) -+ { -+ ThrowFromInternalUDSub( e, "Value of parameter 1 (ISRANGE["+i2s(0)+"]) is out of allowed range."); -+ } -+ if( isRangeX == 1) -+ { -+ if( parX->N_Elements() != 3) -+ { -+ ThrowFromInternalUDSub( e, "Range vector must have 3 elements: " + e->Caller()->GetString(e->GetKW( par1Ix))); -+ } -+ DLongGDL* parXLong; -+ Guard parXLongGuard; -+ if( parX->Type() != GDL_LONG) -+ { -+ try{ -+ parXLong = static_cast( parX->Convert2( GDL_LONG, BaseGDL::COPY)); -+ parXLongGuard.Reset( parXLong); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ } -+ else -+ { -+ parXLong = static_cast( parX); -+ } -+ if( (*parXLong)[0] != 0 || (*parXLong)[1] != -1 || (*parXLong)[2] != 1) -+ ThrowFromInternalUDSub( e, "Subscript range is not allowed: [" + -+ i2s((*parXLong)[0])+":"+i2s((*parXLong)[1])+":"+i2s((*parXLong)[2])+"]"); -+ -+ // full range -> clone =================================================== -+ DLong nCount = (*static_cast( self->GetTag( nCountTag, 0)))[0]; -+ SizeT nEntries = nCount; -+ -+ DLong initialTableSize = GetInitialTableSize( nEntries); -+ -+ // new hash -+ DStructGDL* hashStruct= new DStructGDL( structDesc::HASH, dimension()); -+ DObj objID= e->NewObjHeap( 1, hashStruct); // owns hashStruct, sets ref count to 1 -+ BaseGDL* newObj = new DObjGDL( objID); // the return HASH object -+ Guard newObjGuard( newObj); -+ // the return hash table -+ DStructGDL* hashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, hashTable); // owns hashTable, sets ref count to 1 -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = initialTableSize; -+ -+ SizeT sourceIx = 0; -+ for( SizeT eIx=0; eIx( thisHashTable->GetTag( pKeyTag, sourceIx)))[0]; -+ while( kID == 0) -+ kID = (*static_cast( thisHashTable->GetTag( pKeyTag, ++sourceIx)))[0]; -+ -+ DPtr vID = (*static_cast(thisHashTable->GetTag( pValueTag, sourceIx)))[0]; -+ -+ BaseGDL* key = e->Interpreter()->GetHeap( kID); -+ assert( key != NULL); -+ BaseGDL* value = e->Interpreter()->GetHeap( vID); -+ if( value != NULL) -+ value = value->Dup(); -+ -+ InsertIntoHashTable( hashStruct, hashTable, key->Dup(), value); -+ } -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ // non-range -+ index = parX; -+ -+ // one element -> return value -+ if( index->N_Elements() == 1) -+ { -+ DLong hashIndex = HashIndex( thisHashTable, index); -+ if( hashIndex < 0) -+ ThrowFromInternalUDSub( e, "Key does not exist."); -+ DPtr vID = (*static_cast(thisHashTable->GetTag( pValueTag, hashIndex)))[0]; -+ BaseGDL* value = e->Interpreter()->GetHeap( vID); -+ if( value == NULL) -+ return NullGDL::GetSingleInstance(); -+ return value->Dup(); -+ } -+ -+ // multi element -> return new hash -+ SizeT nEntries = index->N_Elements(); -+ -+ DLong initialTableSize = GetInitialTableSize( nEntries); -+ -+ // new hash -+ DStructGDL* hashStruct= new DStructGDL( structDesc::HASH, dimension()); -+ DObj objID= e->NewObjHeap( 1, hashStruct); // owns hashStruct, sets ref count to 1 -+ BaseGDL* newObj = new DObjGDL( objID); // the return HASH object -+ Guard newObjGuard( newObj); -+ // the return hash table -+ DStructGDL* hashTable= new DStructGDL( structDesc::GDL_HASHTABLEENTRY, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, hashTable); // owns hashTable, sets ref count to 1 -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = initialTableSize; -+ -+ for( SizeT eIx=0; eIxNewIx( eIx); -+ Guard actkeyGuard( actKey); -+ -+ // search in this hash table -+ DLong hashIndex = HashIndex( thisHashTable, actKey); -+ if( hashIndex < 0) -+ ThrowFromInternalUDSub( e, "Key does not exist."); -+ -+ DPtr vID = (*static_cast(thisHashTable->GetTag( pValueTag, hashIndex)))[0]; -+ BaseGDL* value = e->Interpreter()->GetHeap( vID); -+ if( value != NULL) -+ value = value->Dup(); -+ -+ actkeyGuard.Release(); -+ InsertIntoHashTable( hashStruct, hashTable, actKey, value); -+ } -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ -+ -+ BaseGDL* hash_fun( EnvT* e) -+ { -+ static int kwNO_COPYIx = e->KeywordIx("NO_COPY"); -+ bool kwNO_COPY = false; -+ if (e->KeywordSet(kwNO_COPYIx)){ kwNO_COPY = true;} -+ -+ SizeT nParam = e->NParam(); -+ if( nParam != 1 && nParam % 2 == 1) -+ e->Throw( "Wrong number of parameters."); -+ -+ ProgNodeP cN = e->CallingNode(); -+ DInterpreter* ip = e->Interpreter(); -+ -+ static DString hashName("HASH"); -+ static DString entryName("GDL_HASHTABLEENTRY"); -+ static unsigned pDataTag = structDesc::HASH->TagIndex( "TABLE_DATA"); -+ static unsigned nSizeTag = structDesc::HASH->TagIndex( "TABLE_SIZE"); -+ static unsigned nCountTag = structDesc::HASH->TagIndex( "TABLE_COUNT"); -+ static unsigned pKeyTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PKEY"); -+ static unsigned pValueTag = structDesc::GDL_HASHTABLEENTRY->TagIndex( "PVALUE"); -+ -+ // because of .RESET_SESSION, we cannot use static here -+ DStructDesc* hashDesc=structDesc::HASH; -+ DStructDesc* entryDesc=structDesc::GDL_HASHTABLEENTRY; -+ assert( hashDesc != NULL && hashDesc->NTags() > 0); -+ assert( entryDesc != NULL && entryDesc->NTags() > 0); -+ -+ DStructGDL* hashStruct= new DStructGDL( hashDesc, dimension()); -+ -+ DObj objID= e->NewObjHeap( 1, hashStruct); // owns hashStruct, sets ref count to 1 -+ -+ BaseGDL* newObj = new DObjGDL( objID); // the hash object -+ Guard newObjGuard( newObj); -+ -+ SizeT nEntries = nParam/2; -+ -+ DLong initialTableSize = GetInitialTableSize( nEntries); -+ -+ DStructGDL* hashTable= new DStructGDL( entryDesc, dimension(initialTableSize)); -+ DPtr hashTableID= e->NewHeap( 1, hashTable); // owns hashTable, sets ref count to 1 -+ -+ (*static_cast( hashStruct->GetTag( pDataTag, 0)))[0] = hashTableID; -+ (*static_cast( hashStruct->GetTag( nSizeTag, 0)))[0] = initialTableSize; -+ -+ for( SizeT eIx=0; eIxGetPar( keyIx); -+ // !NULL keys are not inserted -+ if( key == NULL || key == NullGDL::GetSingleInstance()) -+ continue; -+ -+ SizeT nKey = key->N_Elements(); -+ -+ if( key->Type() == GDL_STRUCT) -+ { -+ if( nParam > 1) -+ e->Throw("Only 1 argument is allowed with input of type STRUCT."); -+ DStructGDL* keyStruct = static_cast(key); -+ DStructDesc* desc = keyStruct->Desc(); -+ for( SizeT t=0; tNTags(); ++t) -+ { -+// DString validName = ValidTagName( desc->TagName(t)); -+ DStringGDL *structKey = new DStringGDL( desc->TagName(t)); -+ BaseGDL* structData = keyStruct->GetTag(t,0); -+ assert(structData != NULL); -+ structData = structData->Dup(); -+ -+ InsertIntoHashTable( hashStruct, hashTable, structKey, structData); -+ } -+ } -+ else -+ { -+ if( nParam == 1) -+ e->Throw( "Single parameter must be a STRUCT."); -+ -+ BaseGDL* value = e->GetPar( valueIx); -+ SizeT nValue = 0; -+ if( value != NULL) -+ nValue = value->N_Elements(); -+ -+ if( nValue != 0 && nKey != 1 && nValue != nKey) -+ e->Throw( "Key and Value must have the same number of elements."); -+ -+ if( nKey == 1) -+ { -+ if( !kwNO_COPY && value != NULL) -+ value = value->Dup(); -+ key = key->Dup(); -+ -+ InsertIntoHashTable( hashStruct, hashTable, key, value); -+ } -+ else // nkey > 1 -+ { -+ if( value == NULL /*|| value == NullGDL::GetSingleInstance()*/) -+ { -+ for( SizeT kIx=0; kIxNewIx(kIx), NULL); -+ } -+ else -+ { -+ for( SizeT kIx=0; kIxNewIx(kIx), value->NewIx(kIx)); -+ } -+ } -+ if( kwNO_COPY) -+ { -+ bool stolen = e->StealLocalPar( valueIx); -+ if( !stolen) e->GetPar(valueIx) = NULL; -+ } -+ } -+ } -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+} // namespace lib -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/hash.hpp gdl/src/hash.hpp ---- gdl-0.9.3/src/hash.hpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/hash.hpp 2013-07-26 17:43:05.000000000 -0600 -@@ -0,0 +1,51 @@ -+/*************************************************************************** -+ hash.hpp - for HASH objects -+ ------------------- -+ begin : July 22 2013 -+ copyright : (C) 2013 by M. Schellens et al. -+ email : m_schellens@users.sf.net -+ -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#ifndef HASH_HPP_ -+#define HASH_HPP_ -+ -+void HASH__ToStream( DStructGDL* oStructGDL, std::ostream& o, SizeT w, SizeT* actPosPtr); -+ -+namespace lib { -+ -+ BaseGDL* HASH___OverloadIsTrue( EnvUDT* e); -+ -+ BaseGDL* HASH___OverloadNEOp( EnvUDT* e); -+ BaseGDL* HASH___OverloadEQOp( EnvUDT* e); -+ -+ BaseGDL* HASH___OverloadPlus( EnvUDT* e); -+ -+ BaseGDL* HASH___OverloadBracketsRightSide( EnvUDT* e); -+ -+ void HASH___OverloadBracketsLeftSide( EnvUDT* e); -+ -+ BaseGDL* hash__haskey( EnvUDT* e); -+ -+ BaseGDL* hash__remove_fun( EnvUDT* e); -+ void hash__remove_pro( EnvUDT* e); -+ -+ BaseGDL* hash__values( EnvUDT* e); -+ BaseGDL* hash__keys( EnvUDT* e); -+ -+ BaseGDL* hash__tostruct( EnvUDT* e); -+ -+ BaseGDL* hash_fun( EnvT* e); -+ -+} -+ -+#endif -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/image.cpp gdl/src/image.cpp ---- gdl-0.9.3/src/image.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/image.cpp 2013-02-25 17:04:24.000000000 -0700 -@@ -51,22 +51,27 @@ - static int get_namesIx = e->KeywordIx( "GET_NAMES"); - bool get_names = e->KeywordPresent( get_namesIx); - if( get_names) -- { -- e->AssureGlobalKW( get_namesIx); -- -- DStringGDL* names = new DStringGDL( nCT, BaseGDL::NOZERO); -- for( SizeT i=0; iName(); -+ { -+ e->AssureGlobalKW( get_namesIx); - -- e->SetKW( get_namesIx, names); -- } -+ DStringGDL* names = new DStringGDL( nCT, BaseGDL::NOZERO); -+ for( SizeT i=0; iName(); -+ -+ e->SetKW( get_namesIx, names); -+ return; //correct behaviour. -+ } - -- if( e->NParam() == 0) return; -+ if( e->NParam() == 0) return; //FIXME should list tables names, promt for number and load it! - - DLong iCT; - - DByte r[256], g[256], b[256]; - PLINT rint[256], gint[256], bint[256]; -+ //load original table -+ GDLCT* actCT = Graphics::GetCT(); -+ actCT->Get(rint,gint,bint,256); -+ - - e->AssureLongScalarPar( 0, iCT); - if( iCT < 0 || iCT >= nCT) -@@ -76,18 +81,44 @@ - GDLGStream* actStream = actDevice->GetStream( false); // no open - - Graphics::LoadCT( iCT); -- GDLCT* actCT = Graphics::GetCT(); -- -- for( SizeT i=0; iKeywordSet ( "BOTTOM" ) ) e->AssureLongScalarKWIfPresent ( "BOTTOM", bottom ); -+ if ( e->KeywordSet ( "NCOLORS" ) ) e->AssureLongScalarKWIfPresent ( "NCOLORS", ncolors ); -+ if (bottom < 0) bottom=0; -+ if (bottom > MAX_COLORS-1) bottom=MAX_COLORS-1; -+ if (ncolors < 1) ncolors=1; -+ if (ncolors > MAX_COLORS) ncolors=MAX_COLORS; -+ if (bottom+ncolors > MAX_COLORS) ncolors=MAX_COLORS-bottom; -+#undef MAX_COLORS -+ for( SizeT i=0, j=bottom ; jGet( i, r[ i], g[ i], b[ i]); -+ //update section of colors -+ rint[j] = (PLINT) r[i]; -+ gint[j] = (PLINT) g[i]; -+ bint[j] = (PLINT) b[i]; -+ } - -- rint[i] = (PLINT) r[i]; -- gint[i] = (PLINT) g[i]; -- bint[i] = (PLINT) b[i]; -+ static int rgbtableIx = e->KeywordIx( "RGB_TABLE"); -+ if( e->KeywordPresent( rgbtableIx) ) -+ { -+ e->AssureGlobalKW( rgbtableIx); -+ DByteGDL* rgbtable = new DByteGDL( dimension(ncolors, 3), BaseGDL::NOZERO); -+ for( SizeT i=0, j=bottom ; jSetKW( rgbtableIx, rgbtable); -+ return; //correct behaviour. - } - - if (actStream != NULL) -- actStream->scmap1( rint, gint, bint, ctSize); -+ actStream->scmap1( rint, gint, bint, 256); - } - - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/image.hpp gdl/src/image.hpp ---- gdl-0.9.3/src/image.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/image.hpp 2013-02-25 17:04:24.000000000 -0700 -@@ -19,7 +19,6 @@ - #define IMAGE_HPP_ - - #include --#include - - #include "envt.hpp" - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/includefirst.hpp gdl/src/includefirst.hpp ---- gdl-0.9.3/src/includefirst.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/includefirst.hpp 2013-03-21 14:04:04.000000000 -0600 -@@ -24,7 +24,6 @@ - //#else - //#error "config.h required. Compile with -DHAVE_CONFIG_H" - //#endif -- - #ifdef _MSC_VER - #define NOMINMAX - #endif -@@ -58,6 +57,10 @@ - //#if defined(USE_PYTHON) || defined(PYTHON_MODULE) - #endif - -+#if defined(USE_EIGEN) -+#include -+#endif -+ - #if defined(__sun__) - // SA: CS is defined in /usr/include/sys/regset.h and used in an enum statement by ANTLR - # include -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/initsysvar.cpp gdl/src/initsysvar.cpp ---- gdl-0.9.3/src/initsysvar.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/initsysvar.cpp 2013-02-25 17:04:24.000000000 -0700 -@@ -180,6 +180,13 @@ - DVar& eSSysVar = *sysVarList[ err_stringIx]; - static_cast(*eSSysVar.Data())[0] = eS; - } -+ void SetErrError( DLong eC) -+ { -+ DVar& errSysVar = *sysVarList[ errIx]; -+ DVar& errorSysVar = *sysVarList[ errorIx]; -+ static_cast(*errSysVar.Data())[0] = eC; -+ static_cast(*errorSysVar.Data())[0] = eC; -+ } - - DStructGDL* P() - { -@@ -339,7 +346,7 @@ - // plotting - // !P - SizeT clipDim = 6; -- DLong p_clipInit[] = { 60, 40, 622, 492, 0, 1000}; -+ DLong p_clipInit[] = { 0, 0, 1024, 1024, 0, 1000}; - DLongGDL* p_clip = new DLongGDL( dimension( &clipDim, one)); - for( UInt i=0; i -+ void MergeSortDescending( IndexT* hhS, IndexT* h1, IndexT* h2, SizeT len) -+ { -+ if( len <= 1) return; -+ -+ SizeT h1N = len / 2; -+ SizeT h2N = len - h1N; -+ -+ // 1st half -+ MergeSortDescending(hhS, h1, h2, h1N); -+ -+ // 2nd half -+ IndexT* hhM = &hhS[h1N]; -+ MergeSortDescending(hhM, h1, h2, h2N); -+ -+ SizeT i; -+ for(i=0; iGetHeap( actP); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ if( e == NULL) -+ throw GDLException( "LIST container node ID <"+i2s(actP)+"> not found."); -+ ThrowFromInternalUDSub( e, "LIST container node ID <"+i2s(actP)+"> not found."); -+ } -+ if( actPHeap == NULL || actPHeap->Type() != GDL_STRUCT) -+ if( e == NULL) -+ throw GDLException( "LIST node must be a STRUCT."); -+ else -+ ThrowFromInternalUDSub( e, "LIST node must be a STRUCT."); -+ DStructGDL* actPStruct = static_cast( actPHeap); -+// static DString cNodeName("GDL_CONTAINER_NODE"); -+// if( actPStruct->Desc()->Name() != cNodeName) // this saves the FindInStructList -+// if( e == NULL) -+// throw GDLException( "LIST node must be a GDL_CONTAINER_NODE STRUCT."); -+// else -+// ThrowFromInternalUDSub( e, "LIST node must be a GDL_CONTAINER_NODE STRUCT."); -+ return actPStruct; -+ } -+ -+ void FreeLISTNode( EnvUDT* e, DPtr pRemoveNode, bool deleteData = true) -+ { -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ DStructGDL* removeNode = GetLISTStruct( e, pRemoveNode); -+ -+ DPtr pData = (*static_cast( removeNode->GetTag( pDataTag, 0)))[0]; -+ DPtr pNext = (*static_cast( removeNode->GetTag( pNextTag, 0)))[0]; -+ -+ if( deleteData) -+ BaseGDL::interpreter->FreeHeap( pData); // delete -+ else -+ BaseGDL::interpreter->HeapErase( pData); // no delete -+ -+ // prevent cleanup due to ref-counting -+ (*static_cast( removeNode->GetTag( pNextTag, 0)))[0] = 0; -+ -+ BaseGDL::interpreter->FreeHeap( pRemoveNode); // delete -+ } -+ -+ DPtr GetLISTNode( EnvUDT* e, DStructGDL* self, DLong targetIx) -+ { -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ DPtr actP; -+ if( targetIx == -1) -+ { -+ actP = (*static_cast(self->GetTag( pHeadTag, 0)))[0]; -+ } -+ else -+ { -+ actP = (*static_cast(self->GetTag( pTailTag, 0)))[0]; -+ for( SizeT elIx = 0; elIx < targetIx; ++elIx) -+ { -+ DStructGDL* actPStruct = GetLISTStruct(e, actP); -+ -+ actP = (*static_cast( actPStruct->GetTag( pNextTag, 0)))[0]; -+ } -+ } -+ return actP; -+ } -+ -+ DStructGDL*GetSELF( BaseGDL* selfP, EnvUDT* e) -+ { -+ // TODO remove this checks (SELF is set always internally) -+ if( selfP == NULL || selfP->Type() != GDL_OBJ) -+ ThrowFromInternalUDSub( e, "SELF is not of type OBJECT. Please report."); -+ if( !selfP->Scalar()) -+ ThrowFromInternalUDSub( e, "SELF must be a scalar OBJECT. Please report."); -+ DObjGDL* selfObj = static_cast( selfP); -+ DObj selfID = (*selfObj)[0]; -+ try { -+ return BaseGDL::interpreter->GetObjHeap( selfID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "SELF object ID <"+i2s(selfID)+"> not found."); -+ } -+ } -+ -+ void LIST__ToStream( DStructGDL* oStructGDL, std::ostream& o, SizeT w, SizeT* actPosPtr) -+ { -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+// static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+// static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ SizeT nList = (*static_cast(oStructGDL->GetTag( nListTag, 0)))[0]; -+ DPtr pActNode = GetLISTNode( NULL, oStructGDL, 0); -+ for( SizeT i=0; i(actNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ if( data == NULL) data = NullGDL::GetSingleInstance(); -+ -+ data->ToStream( o, w, actPosPtr); -+ if( (i+1) < nList) -+ o << std::endl; -+ -+ pActNode = (*static_cast(actNode->GetTag( pNextTag, 0)))[0]; -+ } -+ } -+ -+ -+namespace lib { -+ -+ -+ BaseGDL* LIST___OverloadIsTrue( EnvUDT* e) -+ { -+ SizeT nParam = e->NParam(1); // SELF -+ -+ DStructGDL* self = GetSELF( e->GetKW( 0), e); -+ -+ // here static is fine -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ -+ DLong nList = (*static_cast( self->GetTag( nListTag, 0)))[0]; -+ -+ if( nList == 0) -+ return new DByteGDL(0); -+ else -+ return new DByteGDL(1); -+ } -+ -+ -+ -+BaseGDL* LIST___OverloadEQOp( EnvUDT* e); -+BaseGDL* LIST___OverloadNEOp( EnvUDT* e) -+{ -+ DByteGDL* result = static_cast(LIST___OverloadEQOp( e)); -+ for( SizeT i=0; iN_Elements(); ++i) -+ { -+ if( (*result)[i] == 0) -+ (*result)[i] = 1; -+ else -+ (*result)[i] = 0; -+ } -+ return result; -+} -+BaseGDL* LIST___OverloadEQOp( EnvUDT* e) -+{ -+ SizeT nParam = e->NParam(); // number of parameters actually given -+// int envSize = e->EnvSize(); // number of parameters + keywords 'e' (pro) has defined -+ if( nParam < 3) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Two parameters are needed: LEFT, RIGHT."); -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // default behavior: Exact like scalar indexing -+ DStructGDL* leftStruct = NULL; -+ DStructGDL* rightStruct = NULL; -+ BaseGDL* l = e->GetKW(1); -+ if( l == NULL) -+ l = NullGDL::GetSingleInstance(); -+ if( l->Type() == GDL_OBJ) -+ { -+ DObjGDL* left = static_cast(l); -+ DObj leftID = (*left)[0]; -+ try { -+ leftStruct = BaseGDL::interpreter->GetObjHeap( leftID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Left parameter object ID <"+i2s(leftID)+"> not found."); -+ } -+ } -+ -+ BaseGDL* r = e->GetKW(2); -+ if( r == NULL) -+ { -+ if( leftStruct == NULL) -+ ThrowFromInternalUDSub( e, "At least one parameter must be a LIST."); -+ r = NullGDL::GetSingleInstance(); -+ } -+ if( r->Type() == GDL_OBJ) -+ { -+ DObjGDL* right = static_cast(r); -+ DObj rightID = (*right)[0]; -+ try { -+ rightStruct = BaseGDL::interpreter->GetObjHeap( rightID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Right parameter object ID <"+i2s(rightID)+"> not found."); -+ } -+ } -+ -+ if( rightStruct == NULL && leftStruct == NULL) -+ { -+ ThrowFromInternalUDSub( e, "At least one parameter must be a LIST."); -+ } -+ -+ if( leftStruct == NULL) -+ { -+ leftStruct = rightStruct; -+ rightStruct = NULL; -+ r = l; -+ } -+ -+ DStructDesc* listDesc = leftStruct->Desc(); -+ if( listDesc != structDesc::LIST) -+ ThrowFromInternalUDSub( e, "Parameter must be a LIST."); -+ if( rightStruct != NULL && rightStruct->Desc() != structDesc::LIST) -+ ThrowFromInternalUDSub( e, "Right parameter must be a LIST."); -+ -+ SizeT nListLeft = (*static_cast(leftStruct->GetTag( nListTag, 0)))[0]; -+ SizeT nListRight = 0; -+ if( rightStruct != NULL) -+ { -+ nListRight = (*static_cast(rightStruct->GetTag( nListTag, 0)))[0]; -+ if( nListRight == 0) -+ { -+ if( nListLeft == 0) -+ return new DByteGDL(1); -+ else -+ return new DByteGDL(0); -+ } -+ } -+ assert( rightStruct == NULL || nListRight > 0); -+ -+ if( nListLeft == 0) -+ { -+ return new DByteGDL(0); -+ } -+ -+ if( rightStruct != NULL) -+ { -+ SizeT nEl = (nListLeft > nListRight) ? nListLeft : nListRight; -+ DByteGDL* result = new DByteGDL( dimension( nEl)); -+ Guard resultGuard( result); -+ DPtr pActLNode = GetLISTNode( e, leftStruct, 0); -+ DPtr pActRNode = GetLISTNode( e, rightStruct, 0); -+ for( SizeT i=0; i(actLNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* dataL = BaseGDL::interpreter->GetHeap( pDataL); -+ DPtr pDataR = (*static_cast(actRNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* dataR = BaseGDL::interpreter->GetHeap( pDataR); -+ if( dataL == NULL || dataL == NullGDL::GetSingleInstance()) -+ { -+ if( dataR == NULL || dataR == NullGDL::GetSingleInstance()) -+ (*result)[ i] = 1; -+ } -+ else if( dataR != NULL && dataR != NullGDL::GetSingleInstance()) -+ { -+ if( dataL->EqType(dataR)) -+ { -+ BaseGDL* eqRes = dataL->EqOp( dataR); -+ if( eqRes->Type() != GDL_BYTE) -+ { -+ Guard eqResGuardTmp( eqRes); -+ eqRes = eqRes->Convert2( GDL_BYTE, BaseGDL::CONVERT); -+ eqResGuardTmp.Release(); -+ } -+ Guard eqResGuard( eqRes); -+ DByteGDL* eqResByte = static_cast(eqRes); -+ SizeT c = 0; -+ for( c=0; cN_Elements(); ++c) -+ if( !((*eqResByte)[ c])) -+ break; -+ if( c == eqResByte->N_Elements()) -+ (*result)[ i] = 1; -+ } -+ else -+ { -+ BaseGDL* rConvert = dataR->Convert2(dataL->Type(),BaseGDL::COPY); -+ Guard rCovertGuard( rConvert); -+ BaseGDL* eqRes = dataL->EqOp( rConvert); -+ if( eqRes->Type() != GDL_BYTE) -+ { -+ Guard eqResGuardTmp( eqRes); -+ eqRes = eqRes->Convert2( GDL_BYTE, BaseGDL::CONVERT); -+ eqResGuardTmp.Release(); -+ } -+ Guard eqResGuard( eqRes); -+ DByteGDL* eqResByte = static_cast(eqRes); -+ SizeT c = 0; -+ for( c=0; cN_Elements(); ++c) -+ if( !((*eqResByte)[ c])) -+ break; -+ if( c == eqResByte->N_Elements()) -+ (*result)[ i] = 1; -+ } -+ } -+ // advance to next node -+ pActLNode = (*static_cast(actLNode->GetTag( pNextTag, 0)))[0]; -+ pActRNode = (*static_cast(actRNode->GetTag( pNextTag, 0)))[0]; -+ } -+ resultGuard.Release(); -+ return result; -+ } -+ else -+ { -+ SizeT nEl = nListLeft; -+ DByteGDL* result = new DByteGDL( dimension( nEl)); -+ Guard resultGuard( result); -+ DPtr pActLNode = GetLISTNode( e, leftStruct, 0); -+ BaseGDL* dataR = r; -+ for( SizeT i=0; i(actLNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* dataL = BaseGDL::interpreter->GetHeap( pDataL); -+ if( dataL == NULL || dataL == NullGDL::GetSingleInstance()) -+ { -+ if( dataR == NULL || dataR == NullGDL::GetSingleInstance()) -+ (*result)[ i] = 1; -+ } -+ else if( dataR != NULL && dataR != NullGDL::GetSingleInstance()) -+ { -+ if( dataL->EqType(dataR)) -+ { -+ BaseGDL* eqRes = dataL->EqOp( dataR); -+ if( eqRes->Type() != GDL_BYTE) -+ { -+ Guard eqResGuardTmp( eqRes); -+ eqRes = eqRes->Convert2( GDL_BYTE, BaseGDL::CONVERT); -+ eqResGuardTmp.Release(); -+ } -+ Guard eqResGuard( eqRes); -+ DByteGDL* eqResByte = static_cast(eqRes); -+ SizeT c = 0; -+ for( c=0; cN_Elements(); ++c) -+ if( !((*eqResByte)[ c])) -+ break; -+ if( c == eqResByte->N_Elements()) -+ (*result)[ i] = 1; -+ } -+ else -+ { -+ BaseGDL* rConvert = dataR->Convert2(dataL->Type(),BaseGDL::COPY); -+ Guard rCovertGuard( rConvert); -+ BaseGDL* eqRes = dataL->EqOp( rConvert); -+ if( eqRes->Type() != GDL_BYTE) -+ { -+ Guard eqResGuardTmp( eqRes); -+ eqRes = eqRes->Convert2( GDL_BYTE, BaseGDL::CONVERT); -+ eqResGuardTmp.Release(); -+ } -+ Guard eqResGuard( eqRes); -+ DByteGDL* eqResByte = static_cast(eqRes); -+ SizeT c = 0; -+ for( c=0; cN_Elements(); ++c) -+ if( !((*eqResByte)[ c])) -+ break; -+ if( c == eqResByte->N_Elements()) -+ (*result)[ i] = 1; -+ } -+ } -+ // advance to next node -+ pActLNode = (*static_cast(actLNode->GetTag( pNextTag, 0)))[0]; -+ } -+ resultGuard.Release(); -+ return result; -+ } -+ -+} -+ -+ -+ BaseGDL* LIST___OverloadPlus( EnvUDT* e) -+ { -+ SizeT nParam = e->NParam(); // number of parameters actually given -+ // int envSize = e->EnvSize(); // number of parameters + keywords 'e' (pro) has defined -+ if( nParam < 3) -+ ThrowFromInternalUDSub( e, "Two parameters are needed: LEFT, RIGHT."); -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // default behavior: Exact like scalar indexing -+ BaseGDL* l = e->GetKW(1); -+ if(l == NULL || l->Type() != GDL_OBJ) -+ ThrowFromInternalUDSub( e, "Left parameter must be a LIST."); -+ -+ BaseGDL* r = e->GetKW(2); -+ if(r == NULL || r->Type() != GDL_OBJ) -+ ThrowFromInternalUDSub( e, "Right parameter must be a LIST."); -+ -+ DObjGDL* left = static_cast(l); -+ DObjGDL* right = static_cast(r); -+ -+ DObj leftID = (*left)[0]; -+ DObj rightID = (*right)[0]; -+ DStructGDL* leftStruct; -+ DStructGDL* rightStruct; -+ try { -+ leftStruct = BaseGDL::interpreter->GetObjHeap( leftID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Left parameter object ID <"+i2s(leftID)+"> not found."); -+ } -+ try { -+ rightStruct = BaseGDL::interpreter->GetObjHeap( rightID); -+ } -+ catch( GDLInterpreter::HeapException& hEx) -+ { -+ ThrowFromInternalUDSub( e, "Right parameter object ID <"+i2s(rightID)+"> not found."); -+ } -+ -+ DStructDesc* listDesc = leftStruct->Desc(); -+ if( listDesc != structDesc::LIST) -+ ThrowFromInternalUDSub( e, "Left parameter must be a LIST."); -+ if( rightStruct->Desc() != structDesc::LIST) -+ ThrowFromInternalUDSub( e, "Right parameter must be a LIST."); -+ -+ SizeT nListLeft = (*static_cast(leftStruct->GetTag( nListTag, 0)))[0]; -+ SizeT nListRight = (*static_cast(rightStruct->GetTag( nListTag, 0)))[0]; -+ -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct -+ BaseGDL* newObj = new DObjGDL( objID); // the list object -+ -+ if( nListLeft == 0 && nListRight == 0) -+ return newObj; -+ -+ Guard newObjGuard( newObj); -+ -+ // because of .RESET_SESSION, we cannot use static here -+ DStructDesc* containerDesc=structDesc::GDL_CONTAINER_NODE; -+ -+ DStructGDL* cStructLast = NULL; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ DPtr pActNode = GetLISTNode( e, (nListLeft > 0) ? leftStruct : rightStruct, 0); -+ for( SizeT i=0; i(actNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ if( data != NULL) -+ data = data->Dup(); -+ -+ DPtr dID = e->Interpreter()->NewHeap(1,data); -+ -+ cStruct = new DStructGDL( containerDesc, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ -+ if( (i+1) == nListLeft && nListRight > 0) -+ pActNode = GetLISTNode( e, rightStruct, 0); -+ else -+ pActNode = (*static_cast(actNode->GetTag( pNextTag, 0)))[0]; -+ } -+ -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = nListLeft+nListRight; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ -+ -+ -+BaseGDL* LIST___OverloadBracketsRightSide( EnvUDT* e) -+{ -+ SizeT nParam = e->NParam(1); // number of parameters actually given -+// int envSize = e->EnvSize(); // number of parameters + keywords 'e' (pro) has defined -+ if( nParam < 3) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Two parameters are needed: ISRANGE, SUB1 [, ...]."); -+ if( nParam > 3) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Only one dimensional access allowed."); -+ -+ BaseGDL* selfP = e->GetKW( 0); -+ if( selfP->Type() != GDL_OBJ) -+ ThrowFromInternalUDSub( e, "SELF is not of type OBJECT."); -+ if( !selfP->Scalar()) -+ ThrowFromInternalUDSub( e, "SELF must be a scalar OBJECT."); -+ -+ DObjGDL* selfObj = static_cast( selfP); -+ DObj selfID = (*selfObj)[0]; -+ DStructGDL* self = e->Interpreter()->GetObjHeap( selfID); -+ -+ -+// DStructDesc* listDesc= self->Desc(); -+// -+// // because of .RESET_SESSION, we cannot use static here -+// DStructDesc* containerDesc=structDesc::GDL_CONTAINER_NODE; -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // default behavior: Exact like scalar indexing -+ BaseGDL* isRange = e->GetKW(1); -+ if( isRange == NULL) -+ ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) is undefined."); -+// if( isRange->Rank() == 0) -+// ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) must be an array in this context: " + e->Caller()->GetString(e->GetKW(1))); -+ SizeT nIsRange = isRange->N_Elements(); -+ if( nIsRange > (nParam - 2)) //- SELF and ISRANGE -+ ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) must have "+i2s(nParam-2)+" elements."); -+ Guard isRangeLongGuard; -+ DLongGDL* isRangeLong; -+ if( isRange->Type() == GDL_LONG) -+ isRangeLong = static_cast( isRange); -+ else -+ { -+ try{ -+ isRangeLong = static_cast( isRange->Convert2( GDL_LONG, BaseGDL::COPY)); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ isRangeLongGuard.Reset( isRangeLong); -+ } -+ -+ ArrayIndexVectorT ixList; -+// IxExprListT exprList; -+ try { -+ for( int p=0; pGetKW( p + 2); // implicit SELF, ISRANGE, par1..par8 -+ if( parX == NULL) -+ ThrowFromInternalUDSub( e, "Parameter is undefined: " + e->Caller()->GetString(e->GetKW( p + 2))); -+ -+ DLong isRangeX = (*isRangeLong)[p]; -+ if( isRangeX != 0 && isRangeX != 1) -+ { -+ ThrowFromInternalUDSub( e, "Value of parameter 1 (ISRANGE["+i2s(p)+"]) is out of allowed range."); -+ } -+ if( isRangeX == 1) -+ { -+ if( parX->N_Elements() != 3) -+ { -+ ThrowFromInternalUDSub( e, "Range vector must have 3 elements: " + e->Caller()->GetString(e->GetKW( p + 2))); -+ } -+ DLongGDL* parXLong; -+ Guard parXLongGuard; -+ if( parX->Type() != GDL_LONG) -+ { -+ try{ -+ parXLong = static_cast( parX->Convert2( GDL_LONG, BaseGDL::COPY)); -+ parXLongGuard.Reset( parXLong); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ } -+ else -+ { -+ parXLong = static_cast( parX); -+ } -+ // negative end ix is fine -> CArrayIndexRangeS can handle [b:*:s] ([b,-1,s]) -+ ixList.push_back(new CArrayIndexRangeS( (*parXLong)[0], (*parXLong)[1], (*parXLong)[2])); -+ } -+ else // non-range -+ { -+ // ATTENTION: These two grab c1 (all others don't) -+ // a bit unclean, but for maximum efficiency -+ if( parX->Rank() == 0) -+ ixList.push_back( new CArrayIndexScalar( parX->Dup())); -+ else -+ ixList.push_back( new CArrayIndexIndexed( parX->Dup())); -+ } -+ } // for -+ } -+ catch( ...) -+ { -+ ixList.Destruct(); // ixList is not valid afterwards, but as we throw this is ok -+ throw; -+ } -+ -+ SizeT listSize = (*static_cast(self->GetTag( nListTag, 0)))[0]; -+ -+ ArrayIndexListT* aL; -+ MakeArrayIndex( &ixList, &aL, NULL); // important to get the non-NoAssoc ArrayIndexListT -+ // because only they clean up ixList on destruction -+ Guard< ArrayIndexListT> aLGuard( aL); -+ -+ SpDLong t = SpDLong( dimension(listSize)); -+ aL->SetVariable( &t); -+ -+ AllIxBaseT* allIx = aL->BuildIx(); -+ -+ // because of .RESET_SESSION, we cannot use static here -+ DStructDesc* containerDesc=structDesc::GDL_CONTAINER_NODE; -+ -+ if( allIx->size() == 1) -+ { -+ DPtr actP = (*static_cast(self->GetTag( pTailTag, 0)))[0]; -+ SizeT targetIx = allIx->operator[](0); -+ for( SizeT elIx = 0; elIx < targetIx; ++elIx) -+ { -+ BaseGDL* actPHeap = e->Interpreter()->GetHeap( actP); -+ if( actPHeap->Type() != GDL_STRUCT) -+ ThrowFromInternalUDSub( e, "LIST node must be a STRUCT."); -+ DStructGDL* actPStruct = static_cast( actPHeap); -+ if( actPStruct->Desc() != containerDesc) -+ ThrowFromInternalUDSub( e, "LIST node must be a GDL_CONTAINER_NODE STRUCT."); -+ -+ actP = (*static_cast( actPStruct->GetTag( pNextTag, 0)))[0]; -+ } -+ -+ BaseGDL* actPHeap = e->Interpreter()->GetHeap( actP); -+ if( actPHeap->Type() != GDL_STRUCT) -+ ThrowFromInternalUDSub( e, "LIST node must be a STRUCT."); -+ DStructGDL* actPStruct = static_cast( actPHeap); -+ if( actPStruct->Desc() != containerDesc) -+ ThrowFromInternalUDSub( e, "LIST node must be a GDL_CONTAINER_NODE STRUCT."); -+ -+ actP = (*static_cast(actPStruct->GetTag( pDataTag, 0)))[0]; -+ -+ BaseGDL* res = e->Interpreter()->GetHeap( actP); -+ if( res == NULL) -+ return NullGDL::GetSingleInstance(); -+ return res->Dup(); -+ } -+ -+ DStructDesc* listDesc= structDesc::LIST; -+ -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct -+ BaseGDL* newObj = new DObjGDL( objID); // the list object -+ Guard newObjGuard( newObj); -+ // we need ref counting here as the LIST (newObj) is a regular return value -+// e->Interpreter()->IncRefObj( objID); -+ -+ DStructGDL* cStructLast = NULL; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ for( SizeT i=0; isize(); ++i) -+ { -+ SizeT actIx = allIx->operator[](i); -+ DPtr pActNode = GetLISTNode( e, self, actIx); -+ DStructGDL* actNode = GetLISTStruct( e, pActNode); -+ -+ DPtr pData = (*static_cast(actNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ if( data != NULL) -+ data = data->Dup(); -+ DPtr dID = e->Interpreter()->NewHeap(1,data); -+ -+ cStruct = new DStructGDL( containerDesc, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ } -+ -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = listSize + allIx->size(); -+ -+ newObjGuard.Release(); -+ return newObj; -+} -+ -+ -+ -+ -+void LIST___OverloadBracketsLeftSide( EnvUDT* e) -+{ -+ // SELF -+ //->AddPar("OBJREF")->AddPar("RVALUE")->AddPar("ISRANGE"); -+ //->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); -+ //->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -+ -+ SizeT nParam = e->NParam(1); // number of parameters actually given -+// int envSize = e->EnvSize(); // number of parameters + keywords 'e' (pro) has defined -+ if( nParam < 5) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Four parameters are needed: OBJREF, RVALUE, ISRANGE, SUB1."); -+ if( nParam > 5) // consider implicit SELF -+ ThrowFromInternalUDSub( e, "Only one dimensional access allowed."); -+ -+ // handle DOT access -+ bool dotAccess = false; -+ -+ BaseGDL** objRef = &e->GetKW(1); -+ if( *objRef == NULL || *objRef == NullGDL::GetSingleInstance()) -+ { -+ if( !e->GlobalKW(1)) -+ ThrowFromInternalUDSub( e, "Parameter 1 (OBJREF) is undefined."); -+ dotAccess = true; -+ } -+ -+ BaseGDL* rValue = e->GetKW(2); -+ if( rValue == NULL) -+ { -+ rValue = NullGDL::GetSingleInstance(); -+ } -+ -+ BaseGDL* selfP = e->GetKW( 0); -+ if( selfP->Type() != GDL_OBJ) -+ ThrowFromInternalUDSub( e, "SELF is not of type OBJECT."); -+ if( !selfP->Scalar()) -+ ThrowFromInternalUDSub( e, "SELF must be a scalar OBJECT."); -+ -+ DObjGDL* selfObj = static_cast( selfP); -+ DObj selfID = (*selfObj)[0]; -+ DStructGDL* self = e->Interpreter()->GetObjHeap( selfID); -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // default behavior: Exact like scalar indexing -+ BaseGDL* isRange = e->GetKW(3); -+ if( isRange == NULL) -+ ThrowFromInternalUDSub( e, "Parameter 2 (ISRANGE) is undefined."); -+ SizeT nIsRange = isRange->N_Elements(); -+ if( nIsRange > (nParam - 4)) //- SELF and ISRANGE -+ ThrowFromInternalUDSub( e, "Parameter 2 (ISRANGE) must have "+i2s(nParam-4)+" elements."); -+ Guard isRangeLongGuard; -+ DLongGDL* isRangeLong; -+ if( isRange->Type() == GDL_LONG) -+ isRangeLong = static_cast( isRange); -+ else -+ { -+ try{ -+ isRangeLong = static_cast( isRange->Convert2( GDL_LONG, BaseGDL::COPY)); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ isRangeLongGuard.Reset( isRangeLong); -+ } -+ -+ ArrayIndexVectorT ixList; -+// IxExprListT exprList; -+ try { -+ for( int p=0; pGetKW( p + 4); // implicit SELF, ISRANGE, par1..par8 -+ if( parX == NULL) -+ ThrowFromInternalUDSub( e, "Parameter is undefined: " + e->Caller()->GetString(e->GetKW( p + 2))); -+ -+ DLong isRangeX = (*isRangeLong)[p]; -+ if( isRangeX != 0 && isRangeX != 1) -+ { -+ ThrowFromInternalUDSub( e, "Value of parameter 1 (ISRANGE["+i2s(p)+"]) is out of allowed range."); -+ } -+ if( isRangeX == 1) -+ { -+ if( parX->N_Elements() != 3) -+ { -+ ThrowFromInternalUDSub( e, "Range vector must have 3 elements: " + e->Caller()->GetString(e->GetKW( p + 2))); -+ } -+ DLongGDL* parXLong; -+ Guard parXLongGuard; -+ if( parX->Type() != GDL_LONG) -+ { -+ try{ -+ parXLong = static_cast( parX->Convert2( GDL_LONG, BaseGDL::COPY)); -+ parXLongGuard.Reset( parXLong); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ } -+ else -+ { -+ parXLong = static_cast( parX); -+ } -+ // negative end ix is fine -> CArrayIndexRangeS can handle [b:*:s] ([b,-1,s]) -+ ixList.push_back(new CArrayIndexRangeS( (*parXLong)[0], (*parXLong)[1], (*parXLong)[2])); -+ } -+ else // non-range -+ { -+ // ATTENTION: These two grab c1 (all others don't) -+ // a bit unclean, but for maximum efficiency -+ if( parX->Rank() == 0) -+ ixList.push_back( new CArrayIndexScalar( parX->Dup())); -+ else -+ ixList.push_back( new CArrayIndexIndexed( parX->Dup())); -+ } -+ } // for -+ } -+ catch( GDLException& ex) -+ { -+ ixList.Destruct(); // ixList is not valid afterwards, but as we throw this is ok -+ throw ex; -+ } -+ -+ SizeT listSize = (*static_cast(self->GetTag( nListTag, 0)))[0]; -+ -+ ArrayIndexListT* aL; -+ MakeArrayIndex( &ixList, &aL, NULL); // important to get the non-NoAssoc ArrayIndexListT -+ // because only they clean up ixList on destruction -+ Guard< ArrayIndexListT> aLGuard( aL); -+ -+ SpDLong t = SpDLong( dimension(listSize)); -+ aL->SetVariable( &t); -+ -+ AllIxBaseT* allIx = aL->BuildIx(); -+ -+ SizeT allIxSize = allIx->size(); -+ -+ if( dotAccess) // -> objRef is NULL (or !NULL) -+ { -+ if( rValue != NullGDL::GetSingleInstance()) -+ { -+ ThrowFromInternalUDSub( e, "For struct access (OBJREF is !NULL), RVALUE must be !NULL as well."); -+ } -+ if( allIxSize != 1) -+ ThrowFromInternalUDSub( e, "Only single value struct access is allowed."); -+ -+ SizeT actIx = allIx->operator[](0); -+ DPtr pActNode = GetLISTNode( e, self, actIx); -+ DStructGDL* actNode = GetLISTStruct( e, pActNode); -+ *objRef = actNode->GetTag( pDataTag, 0)->Dup(); -+ return; -+ } -+ -+ SizeT rValueSize= rValue->Size(); -+ if( rValueSize != allIxSize && rValueSize > 1) -+ ThrowFromInternalUDSub( e, "Incorrect number of elements for Values ("+ -+ i2s(allIxSize)+" NE "+i2s(rValueSize)+")."); -+ -+ if( rValueSize <= 1) -+ { -+ for( SizeT i=0; ioperator[](i); -+ DPtr pActNode = GetLISTNode( e, self, actIx); -+ DStructGDL* actNode = GetLISTStruct( e, pActNode); -+ -+ DPtr pData = (*static_cast(actNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL::interpreter->GetHeap( pData) = rValue->Dup(); -+ } -+ } -+ else -+ { -+ for( SizeT i=0; ioperator[](i); -+ DPtr pActNode = GetLISTNode( e, self, actIx); -+ DStructGDL* actNode = GetLISTStruct( e, pActNode); -+ -+ DPtr pData = (*static_cast(actNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL::interpreter->GetHeap( pData) = rValue->NewIx( i); -+ } -+ } -+ -+} -+ -+ -+ -+ -+template< typename DTypeGDL> -+BaseGDL* LIST__ToArray( DLong nList, DPtr actP, BaseGDL* missingKW) -+{ -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ // because of .RESET_SESSION, we cannot use static here -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ DTypeGDL* missingT = NULL; -+ Guard missingTGuard; -+ DTypeGDL* result = new DTypeGDL( dimension( nList), BaseGDL::NOZERO); -+ Guard resultGuard( result); -+ for( SizeT i=0; i( actNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ if( data == NULL) -+ { -+ if( missingT == NULL) -+ { -+ if( missingKW == NULL) -+ throw GDLException( "Unable to convert to type : Element "+i2s(i)); -+ if( missingKW->Type() == DTypeGDL::t) -+ missingT = static_cast(missingKW); -+ else -+ { -+ missingT = static_cast(missingKW->Convert2(DTypeGDL::t,BaseGDL::COPY)); -+ missingTGuard.Init( missingT); -+ } -+ } -+ data = missingT; -+ } -+ assert( data != NULL); -+ -+ if( data->N_Elements() != 1) -+ { -+ throw GDLException( "Unable to convert to type (N_ELEMENTS > 1): Element "+i2s(i)); -+ } -+ -+ // we are not owner of 'data' here -+ if( data->Type() == DTypeGDL::t) -+ (*result)[i] = (*static_cast(data))[0]; -+ else -+ { -+ DTypeGDL* dataT = static_cast(data->Convert2(DTypeGDL::t,BaseGDL::COPY)); -+ (*result)[i] = (*static_cast(dataT))[0]; -+ delete dataT; -+ } -+ -+ actP = (*static_cast( actNode->GetTag( pNextTag, 0)))[0]; -+ } -+ resultGuard.Release(); -+ return result; -+} -+ -+BaseGDL* list__toarray( EnvUDT* e) -+ { -+ static int kwMISSINGIx = 0; -+ static int kwTYPEIx = 1; -+ static int kwSELFIx = 2; -+ -+ SizeT nParam = e->NParam(1); // SELF -+ -+ DStructGDL* self = GetSELF( e->GetKW( kwSELFIx), e); -+ DStructDesc* listDesc= self->Desc(); -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ -+ // because of .RESET_SESSION, we cannot use static here -+ DStructDesc* containerDesc=structDesc::GDL_CONTAINER_NODE; -+ -+ assert( listDesc != NULL && listDesc->NTags() > 0); -+ assert( containerDesc != NULL && containerDesc->NTags() > 0); -+ -+ // here static is fine -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ DLong nList = (*static_cast( self->GetTag( nListTag, 0)))[0]; -+ -+ if( nList == 0) -+ return NullGDL::GetSingleInstance(); -+ -+ BaseGDL* missingKW = e->GetKW( kwMISSINGIx); -+ BaseGDL* typeKW = e->GetKW( kwTYPEIx); -+ -+ DType resultType = GDL_UNDEF; -+ -+ DPtr pTail = (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ DStructGDL* tailNode = GetLISTStruct(e, pTail); -+ -+ DPtr pData = (*static_cast( tailNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ if( typeKW == NULL) -+ { -+ if( data != NULL) -+ resultType = data->Type(); -+ else if( missingKW != NULL) -+ resultType = missingKW->Type(); -+ else -+ ThrowFromInternalUDSub( e, "Unable to convert to type : Element zero"); -+ } -+ else -+ { -+ if( typeKW->Type() == GDL_STRING) -+ { -+ DString typeStr = StrUpCase( (*static_cast(typeKW))[0]); -+ if( SpDByte().TypeStr() == typeStr) resultType = GDL_BYTE; -+ else if( SpDInt().TypeStr() == typeStr) resultType = GDL_INT; -+ else if( SpDLong().TypeStr() == typeStr) resultType = GDL_LONG; -+ else if( SpDFloat().TypeStr() == typeStr) resultType = GDL_FLOAT; -+ else if( SpDDouble().TypeStr() == typeStr) resultType = GDL_DOUBLE; -+ else if( SpDComplex().TypeStr() == typeStr) resultType = GDL_COMPLEX; -+ else if( SpDString().TypeStr() == typeStr) resultType = GDL_STRING; -+ else if( SpDComplexDbl().TypeStr() == typeStr) resultType = GDL_COMPLEXDBL; -+ else if( SpDUInt().TypeStr() == typeStr) resultType = GDL_UINT; -+ else if( SpDULong().TypeStr() == typeStr) resultType = GDL_ULONG; -+ else if( SpDLong64().TypeStr() == typeStr) resultType = GDL_LONG64; -+ else if( SpDULong64().TypeStr() == typeStr) resultType = GDL_ULONG64; -+ else -+ ThrowFromInternalUDSub( e, "Unknown or unable to convert to type " + typeStr); -+ } -+ else -+ { -+ DLongGDL* typeCodeKW; -+ Guard typeCodeGuard; -+ if( typeKW->Type() == GDL_LONG) -+ { -+ typeCodeKW = static_cast(typeKW); -+ } -+ else -+ { -+ try{ -+ typeCodeKW = static_cast(typeKW->Convert2(GDL_LONG,BaseGDL::COPY)); -+ typeCodeGuard.Init(typeCodeKW); -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ } -+ DLong typeCode = (*typeCodeKW)[0]; -+ if( typeCode < GDL_BYTE || typeCode > GDL_ULONG64) -+ ThrowFromInternalUDSub( e, "Illegal value for TYPE: " + i2s(typeCode)); -+ resultType = static_cast(typeCode); -+ } -+ } -+ if( resultType == GDL_UNDEF) -+ ThrowFromInternalUDSub( e, "Result type is UNDEF. Please report."); -+ -+ try{ -+ if( resultType == GDL_BYTE) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_INT) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_LONG) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_FLOAT) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_DOUBLE) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_COMPLEX) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_STRING) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_COMPLEXDBL) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_UINT) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_ULONG) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_LONG64) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else if( resultType == GDL_ULONG64) -+ return LIST__ToArray( nList, pTail, missingKW); -+ -+ else -+ throw GDLException( "Unknown or unable to convert to type code: " + i2s(resultType)); -+ -+ } -+ catch( GDLException& ex) -+ { -+ ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); -+ } -+ } -+ -+ -+ -+ BaseGDL* list__remove( EnvUDT* e, bool asFunction); -+ -+ BaseGDL* list__remove_fun( EnvUDT* e) -+ { -+ return list__remove( e, true); -+ } -+ void list__remove_pro( EnvUDT* e) -+ { -+ list__remove( e, false); -+ } -+ -+ BaseGDL* list__remove( EnvUDT* e, bool asFunction) -+ { -+ // see overload.cpp -+ static int kwALLIx = 0; -+ static int kwSELFIx = 1; -+ static int kwINDEXIx = 2; -+ -+ bool kwALL = false; -+ if (e->KeywordSet(kwALLIx)){ kwALL = true;} -+ -+ SizeT nParam = e->NParam(1); // minimum SELF -+ -+ DStructGDL* self = GetSELF( e->GetKW( kwSELFIx), e); -+ DStructDesc* listDesc= self->Desc(); -+ -+// DStructDesc* containerDesc= structDesc::GDL_CONTAINER_NODE; -+ -+ // here static is fine -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ if( kwALL) -+ { -+ if( asFunction) -+ { -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct, inits ref count -+ BaseGDL* newObj = new DObjGDL( objID); // the list object -+ Guard newObjGuard( newObj); -+ -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0]; -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = 0; -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = -+ (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = 0; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = -+ (*static_cast( self->GetTag( nListTag, 0)))[0]; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 0; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ else -+ { -+ DPtr pTail = (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ // trigger ref-count delete of all elements -+ BaseGDL::interpreter->FreeHeap( pTail); -+ -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = 0; -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = 0; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 0; -+ return NULL; -+ } -+ } -+ -+ DLong nList = (*static_cast( self->GetTag( nListTag, 0)))[0]; -+ -+ if( nList == 0) -+ ThrowFromInternalUDSub( e, "LIST is empty."); -+ -+ BaseGDL* index = NULL; -+ DLongGDL* indexLong = NULL; -+ Guard indexLongGuard; -+ if( nParam >= 2) -+ index = e->GetKW(kwINDEXIx); -+ if( index != NULL) -+ { -+ if( index->Type() != GDL_LONG) -+ { -+ indexLong = static_cast(index->Convert2(GDL_LONG,BaseGDL::COPY)); -+ indexLongGuard.Init( indexLong); -+ } -+ else -+ indexLong = static_cast(index); -+ } -+ -+ DLong removePos = -1; -+ if( indexLong != NULL) -+ { -+ if( indexLong->N_Elements() == 1) -+ { -+ removePos = (*indexLong)[0]; -+ if( removePos < 0) -+ removePos += nList; -+ if( removePos < 0) -+ ThrowFromInternalUDSub( e, "Index too small."); -+ if( removePos >= nList) -+ ThrowFromInternalUDSub( e, "Index out of range."); -+ } -+ } -+ -+ if( indexLong == NULL || removePos == nList-1) // remove head -+ { -+ -+ DPtr pHead = (*static_cast( self->GetTag( pHeadTag, 0)))[0]; -+ -+ DStructGDL* headNode = GetLISTStruct(e, pHead); -+ -+ DPtr pData = (*static_cast( headNode->GetTag( pDataTag, 0)))[0]; -+ -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ if( nList == 1) -+ { -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = 0; -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = 0; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 0; -+ } -+ else if( nList == 2) -+ { -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = -+ (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 1; -+ } -+ else // nList > 2 -+ { -+ DPtr pPredHead = GetLISTNode( e, self, nList-2); -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = pPredHead; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = nList - 1; -+ } -+// e->Interpreter()->HeapErase( pData); // no delete -+// e->Interpreter()->FreeHeap( pHead); // delete -+ FreeLISTNode( e, pHead, !asFunction); -+ -+ if( data == NULL) -+ return NullGDL::GetSingleInstance(); -+ return data; -+ } -+ if( removePos == 0) // remove tail -+ { -+ // implicit: nList > 1 -+ DPtr pTail = (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ -+ DStructGDL* tailNode = GetLISTStruct(e, pTail); -+ -+ DPtr pData = (*static_cast( tailNode->GetTag( pDataTag, 0)))[0]; -+ -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ if( nList == 2) -+ { -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0]; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 1; -+ } -+ else // nList > 2 -+ { -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = -+ (*static_cast( tailNode->GetTag( pNextTag, 0)))[0]; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = nList - 1; -+ } -+// e->Interpreter()->HeapErase( pData); // no delete -+// e->Interpreter()->FreeHeap( pTail); // delete -+ FreeLISTNode( e, pTail, !asFunction); -+ -+ if( data == NULL) -+ return NullGDL::GetSingleInstance(); -+ return data; -+ } -+ if( removePos != -1) // single element -+ { -+ // implicit: nList > 2 -+ DPtr pPredNode = GetLISTNode( e, self, removePos-1); -+ DStructGDL* predNode = GetLISTStruct( e, pPredNode); -+ -+ DPtr pRemoveNode = (*static_cast( predNode->GetTag( pNextTag, 0)))[0]; -+ DStructGDL* removeNode = GetLISTStruct( e, pRemoveNode); -+ -+ DPtr pData = (*static_cast( removeNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ (*static_cast( predNode->GetTag( pNextTag, 0)))[0] = -+ (*static_cast( removeNode->GetTag( pNextTag, 0)))[0]; -+ -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = nList - 1; -+ -+// e->Interpreter()->HeapErase( pData); // no delete -+// e->Interpreter()->FreeHeap( pRemoveNode); // no delete -+ FreeLISTNode( e, pRemoveNode, !asFunction); -+ -+ if( data == NULL) -+ return NullGDL::GetSingleInstance(); -+ return data; -+ } -+ -+ // remove all indexed elements -+ // 1st build return LIST -+ BaseGDL* newObj = NULL; // the list object -+ Guard newObjGuard; -+ SizeT indexN_Elements = indexLong->N_Elements(); -+ if( asFunction) -+ { -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct -+ newObj = new DObjGDL( objID); // the list object -+ newObjGuard.Init( newObj); -+ // we need ref counting here as the LIST (newObj) is a regular return value -+ // e->Interpreter()->IncRefObj( objID); -+ DStructGDL* cStructLast = NULL; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ for( SizeT i=0; i= nList) -+ ThrowFromInternalUDSub( e, "Index out of range."); -+ -+ -+ DPtr pActNode = GetLISTNode( e, self, actIx); -+ DStructGDL* actNode = GetLISTStruct( e, pActNode); -+ -+ DPtr pData = (*static_cast(actNode->GetTag( pDataTag, 0)))[0]; -+ BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ if( data != NULL) -+ data = data->Dup(); -+ DPtr dID = e->Interpreter()->NewHeap(1,data); -+ -+ cStruct = new DStructGDL( structDesc::GDL_CONTAINER_NODE, dimension()); -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = dID; -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ } -+ -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = indexN_Elements; -+ } // if( asFunction) -+ -+ // 2nd: remove the indexed elements -+ if( indexLongGuard.Get() == NULL) -+ { -+ // we need to sort the index -+ indexLong = indexLong->Dup(); -+ indexLongGuard.Init(indexLong); -+ } -+ DLong *hh = static_cast(indexLong->DataAddr()); -+ DLong* h1 = new DLong[ indexN_Elements/2]; -+ DLong* h2 = new DLong[ (indexN_Elements+1)/2]; -+ // call the sort routine -+ MergeSortDescending( hh, h1, h2, indexN_Elements); -+ delete[] h1; -+ delete[] h2; -+ -+ SizeT nListStart = nList; -+ for( DLong i=0; i < indexN_Elements; ++i) -+ { -+ DLong removeIndex = hh[ i]; -+// std::cout << " Removing index: " << i2s(removeIndex) << std::endl; -+ -+ if( removeIndex < 0) -+ removeIndex += nListStart; -+ if( removeIndex < 0) -+ ThrowFromInternalUDSub( e, "Index too small."); -+ if( removeIndex >= nList) -+ ThrowFromInternalUDSub( e, "Index out of range."); -+ -+ if( removeIndex == nList-1) // remove head -+ { -+// std::cout << " Removing index: nList-1" << std::endl; -+ -+ DPtr pHead = (*static_cast( self->GetTag( pHeadTag, 0)))[0]; -+ -+ DStructGDL* headNode = GetLISTStruct(e, pHead); -+ -+ DPtr pData = (*static_cast( headNode->GetTag( pDataTag, 0)))[0]; -+ -+// BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ if( nList == 1) -+ { -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = 0; -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = 0; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 0; -+ } -+ else if( nList == 2) -+ { -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = -+ (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 1; -+ } -+ else // nList > 2 -+ { -+ DPtr pPredHead = GetLISTNode( e, self, nList-2); -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = pPredHead; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = nList - 1; -+ } -+ -+ // prevent (ref-count) cleanup of next node -+ (*static_cast( headNode->GetTag( pNextTag, 0)))[0] = 0; -+// e->Interpreter()->FreeHeap( pData); -+// e->Interpreter()->FreeHeap( pHead); -+ FreeLISTNode( e, pHead, true); -+ } -+ else if( removeIndex == 0) // remove tail -+ { -+// std::cout << " Removing index: zero" << std::endl; -+ // implicit: nList > 1 -+ DPtr pTail = (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ -+ DStructGDL* tailNode = GetLISTStruct(e, pTail); -+ -+ DPtr pData = (*static_cast( tailNode->GetTag( pDataTag, 0)))[0]; -+ -+// BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ if( nList == 2) -+ { -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0]; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = 1; -+ } -+ else // nList > 2 -+ { -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = -+ (*static_cast( tailNode->GetTag( pNextTag, 0)))[0]; -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = nList - 1; -+ } -+ -+ // prevent (ref-count) cleanup of next node -+ (*static_cast( tailNode->GetTag( pNextTag, 0)))[0] = 0; -+// e->Interpreter()->FreeHeap( pData); -+// e->Interpreter()->FreeHeap( pTail); -+ FreeLISTNode( e, pTail, true); -+ } -+ else -+ { -+// std::cout << " Removing index: " << i2s(removeIndex) << std::endl; -+ // implicit: nList > 2 -+ DPtr pPredNode = GetLISTNode( e, self, removeIndex-1); -+ DStructGDL* predNode = GetLISTStruct( e, pPredNode); -+ -+ DPtr pRemoveNode = (*static_cast( predNode->GetTag( pNextTag, 0)))[0]; -+ DStructGDL* removeNode = GetLISTStruct( e, pRemoveNode); -+ -+ DPtr pData = (*static_cast( removeNode->GetTag( pDataTag, 0)))[0]; -+// BaseGDL* data = BaseGDL::interpreter->GetHeap( pData); -+ -+ (*static_cast( predNode->GetTag( pNextTag, 0)))[0] = -+ (*static_cast( removeNode->GetTag( pNextTag, 0)))[0]; -+ -+// std::cout << " Next index: " << i2s((*static_cast( removeNode->GetTag( pNextTag, 0)))[0]) << std::endl; -+ -+// std::cout << " Freeing index: " << i2s(pRemoveNode) << std::endl; -+ -+ // prevent (ref-count) cleanup of next node -+ (*static_cast( removeNode->GetTag( pNextTag, 0)))[0] = 0; -+// e->Interpreter()->FreeHeap( pData); -+// e->Interpreter()->FreeHeap( pRemoveNode); -+ FreeLISTNode( e, pRemoveNode, true); -+ } -+ assert( nList >= 1); -+ // keep LIST consistent -+ (*static_cast( self->GetTag( nListTag, 0)))[0] = --nList; -+ } -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ -+ -+ void list__reverse( EnvUDT* e) -+ { -+ // no args no kwords (but SELF parameter) -+ SizeT nParam = e->NParam(1); // SELF -+ -+ DStructGDL* self = GetSELF( e->GetKW( 0), e); -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ DLong nList = (*static_cast( self->GetTag( nListTag, 0)))[0]; -+ -+ if( nList <= 1) // no change for empty or one-element -+ return; -+ -+ DPtr actPrevP = 0; -+ DPtr actP = (*static_cast(self->GetTag( pTailTag, 0)))[0]; -+ for( SizeT elIx = 0; elIx < nList; ++elIx) -+ { -+ DStructGDL* actPStruct = GetLISTStruct(e, actP); -+ -+ DPtr actPNext = (*static_cast( actPStruct->GetTag( pNextTag, 0)))[0]; -+ -+ (*static_cast( actPStruct->GetTag( pNextTag, 0)))[0] = actPrevP; -+ -+ actPrevP = actP; -+ -+ actP = actPNext; -+ } -+ -+ // swap head and tail pointer -+ DPtr pTail = (*static_cast( self->GetTag( pTailTag, 0)))[0]; -+ (*static_cast( self->GetTag( pTailTag, 0)))[0] = -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0]; -+ (*static_cast( self->GetTag( pHeadTag, 0)))[0] = pTail; -+ } -+ -+ -+ void list__add( EnvUDT* e) -+ { -+ // see overload.cpp -+ // DFunLIST__ADD->AddKey("EXTRACT","EXTRACT")->AddKey("NO_COPY","NO_COPY"); -+ // DFunLIST__ADD->AddPar("VALUE")->AddPar("INDEX"); -+ -+ static int kwNO_COPYIx = 0; // pushed front 2nd -+ static int kwEXTRACTIx = 1; // pushed front 1st -+ static int kwSELFIx = 2; -+ static int kwVALUEIx = 3; -+ static int kwINDEXIx = 4; -+ -+ bool kwEXTRACT = false; -+ bool kwNO_COPY = false; -+ if (e->KeywordSet(kwEXTRACTIx)){ kwEXTRACT = true;} -+ if (e->KeywordSet(kwNO_COPYIx)){ kwNO_COPY = true;} -+ -+ SizeT nParam = e->NParam(1); // minimum SELF -+ -+ DStructGDL* self = GetSELF( e->GetKW( kwSELFIx), e); -+ -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // because of .RESET_SESSION, we cannot use static here -+ DStructDesc* containerDesc=structDesc::GDL_CONTAINER_NODE; -+ -+ DStructGDL* listStruct= self; -+ -+ BaseGDL* value = NULL; -+ if( nParam >= 2) -+ value = e->GetKW(kwVALUEIx); -+ -+ DLong nList = (*static_cast( listStruct->GetTag( nListTag, 0)))[0]; -+ -+ BaseGDL* index = NULL; -+ DLongGDL* indexLong = NULL; -+ Guard indexLongGuard; -+ DLong insertPos = -1; -+ if( nParam >= 3) -+ index = e->GetKW(kwINDEXIx); -+ if( index != NULL) -+ { -+ if( index->Type() != GDL_LONG) -+ { -+ indexLong = static_cast(index->Convert2(GDL_LONG,BaseGDL::COPY)); -+ indexLongGuard.Init( indexLong); -+ } -+ else -+ indexLong = static_cast(index); -+ insertPos = (*indexLong)[0]; -+ if( insertPos < 0) -+ ThrowFromInternalUDSub( e, "INDEX out of range ("+i2s(insertPos)+" (<0))"); -+ if( insertPos > nList) -+ ThrowFromInternalUDSub( e, "INDEX out of range ("+i2s(insertPos)+" (>"+i2s(nList)+"))"); -+ } -+ -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ DStructGDL* cStructLast = NULL; -+ if( kwEXTRACT && value != NULL && value->N_Elements() > 1) -+ { -+ DPtr firstID = 0; -+ DStructGDL* cStructLast = NULL; -+ SizeT valueN_Elements = value->N_Elements(); -+ for( SizeT eIx=0; eIxInterpreter()->NewHeap(1,value->NewIx(eIx)); -+ -+ cStruct= new DStructGDL( containerDesc, dimension()); -+ -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = pID; -+ -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ firstID = cID; -+ } -+ -+ cStructLast = cStruct; -+ } -+ if( kwNO_COPY) -+ { -+ bool stolen = e->StealLocalKW( kwVALUEIx); -+ if( !stolen) e->GetKW(kwVALUEIx) = NULL; -+ GDLDelete(value); -+ } -+ -+ if( nList == 0) // empty LIST -+ { -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = firstID; -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ } -+ else if( insertPos == -1 || insertPos == nList) // head -+ { -+ DPtr pHead = (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0]; -+ DStructGDL* headNode = GetLISTStruct( e, pHead); -+ -+ (*static_cast( headNode->GetTag( pNextTag, 0)))[0] = firstID; -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ } -+ else if( insertPos == 0) // tail -+ { -+ DPtr pTail = (*static_cast( listStruct->GetTag( pTailTag, 0)))[0]; -+ -+ (*static_cast( cStruct->GetTag( pNextTag, 0)))[0] = pTail; -+ (*static_cast( listStruct->GetTag( pTail, 0)))[0] = firstID; -+ } -+ else -+ { -+ DPtr pPredNode = GetLISTNode( e, self, insertPos-1); -+ DStructGDL* predNode = GetLISTStruct( e, pPredNode); -+ -+ (*static_cast( cStruct->GetTag( pNextTag, 0)))[0] = -+ (*static_cast( predNode->GetTag( pNextTag, 0)))[0]; -+ (*static_cast( predNode->GetTag( pNextTag, 0)))[0] = firstID; -+ } -+ -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = nList+valueN_Elements; -+ } -+ else -+ { -+ SizeT pID; -+ if( value == NULL || kwNO_COPY) -+ { -+ pID = e->Interpreter()->NewHeap(1,value); -+ bool stolen = e->StealLocalKW( kwVALUEIx); -+ if( !stolen) e->GetKW(kwVALUEIx) = NULL; -+ } -+ else -+ { -+ pID = e->Interpreter()->NewHeap(1,value->Dup()); -+ } -+ // pID properly set (ptr to data) -+ cStruct= new DStructGDL( containerDesc, dimension()); -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = pID; -+ cID = e->Interpreter()->NewHeap(1,cStruct); -+ -+ if( nList == 0) // empty LIST -+ { -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ } -+ else if( insertPos == -1 || insertPos == nList) // head -+ { -+ DPtr pHead = (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0]; -+ DStructGDL* headNode = GetLISTStruct( e, pHead); -+ -+ (*static_cast( headNode->GetTag( pNextTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ } -+ else if( insertPos == 0) // tail -+ { -+ DPtr pTail = (*static_cast( listStruct->GetTag( pTailTag, 0)))[0]; -+ -+ (*static_cast( cStruct->GetTag( pNextTag, 0)))[0] = pTail; -+ (*static_cast( listStruct->GetTag( pTail, 0)))[0] = cID; -+ } -+ else -+ { -+ DPtr pPredNode = GetLISTNode( e, self, insertPos-1); -+ DStructGDL* predNode = GetLISTStruct( e, pPredNode); -+ -+ (*static_cast( cStruct->GetTag( pNextTag, 0)))[0] = -+ (*static_cast( predNode->GetTag( pNextTag, 0)))[0]; -+ (*static_cast( predNode->GetTag( pNextTag, 0)))[0] = cID; -+ } -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = nList+1; -+ } -+ } -+ -+ -+ -+ BaseGDL* list_fun( EnvT* e) -+ { -+ static int kwEXTRACTIx = e->KeywordIx("EXTRACT"); -+ static int kwLENGTHIx = e->KeywordIx("LENGTH"); -+ static int kwNO_COPYIx = e->KeywordIx("NO_COPY"); -+ -+ bool kwEXTRACT = false; -+ bool kwNO_COPY = false; -+ if (e->KeywordSet(kwEXTRACTIx)){ kwEXTRACT = true;} -+ if (e->KeywordSet(kwNO_COPYIx)){ kwNO_COPY = true;} -+ -+ SizeT nParam = e->NParam(); -+ -+ SizeT listLength = 0; -+ DLongGDL* lengthKW = e->IfDefGetKWAs(kwLENGTHIx); -+ if( lengthKW != NULL) -+ { -+ listLength = (*lengthKW)[0]; -+ if( listLength < 0) -+ listLength = 0; -+ } -+ -+ ProgNodeP cN = e->CallingNode(); -+ DInterpreter* ip = e->Interpreter(); -+ -+// static DString listName("LIST"); -+// static DString cNodeName("GDL_CONTAINER_NODE"); -+// -+// -+// // here static is fine -+// static unsigned pHeadTag = listDesc->TagIndex( "PHEAD"); -+// static unsigned pTailTag = listDesc->TagIndex( "PTAIL"); -+// static unsigned nListTag = listDesc->TagIndex( "NLIST"); -+// -+// static unsigned pNextTag = containerDesc->TagIndex( "PNEXT"); -+// static unsigned pDataTag = containerDesc->TagIndex( "PDATA"); -+ static DString listName("LIST"); -+ static DString cNodeName("GDL_CONTAINER_NODE"); -+ static unsigned pHeadTag = structDesc::LIST->TagIndex( "PHEAD"); -+ static unsigned pTailTag = structDesc::LIST->TagIndex( "PTAIL"); -+ static unsigned nListTag = structDesc::LIST->TagIndex( "NLIST"); -+ static unsigned pNextTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PNEXT"); -+ static unsigned pDataTag = structDesc::GDL_CONTAINER_NODE->TagIndex( "PDATA"); -+ -+ // because of .RESET_SESSION, we cannot use static here -+ DStructDesc* listDesc=structDesc::LIST; -+ DStructDesc* containerDesc=structDesc::GDL_CONTAINER_NODE; -+ assert( listDesc != NULL && listDesc->NTags() > 0); -+ assert( containerDesc != NULL && containerDesc->NTags() > 0); -+ -+ DStructGDL* listStruct= new DStructGDL( listDesc, dimension()); -+ -+ DObj objID= e->NewObjHeap( 1, listStruct); // owns objStruct, sets ref count to 1 -+ -+ BaseGDL* newObj = new DObjGDL( objID); // the list object -+ Guard newObjGuard( newObj); -+ -+ SizeT added = 0; -+ DStructGDL* cStruct = NULL; -+ DPtr cID = 0; -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ if( nParam > 0 || listLength > 0) -+ { -+ DStructGDL* cStructLast = NULL; -+ for( SizeT pIx=0; pIxGetPar(pIx); -+ -+ if( kwEXTRACT && p != NULL && p->N_Elements() > 1) -+ { -+ for( SizeT eIx=0; eIxN_Elements(); ++eIx) -+ { -+ DPtr pID; -+ -+ pID = ip->NewHeap(1,p->NewIx(eIx)); // sets ref count to 1 -+ -+ cStruct= new DStructGDL( containerDesc, dimension()); -+ -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = pID; -+ -+ cID = ip->NewHeap(1,cStruct); // sets ref count to 1 -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ -+ if( ++added == listLength) -+ break; -+ } -+ if( kwNO_COPY) -+ { -+ bool stolen = e->StealLocalPar( pIx); -+ if( !stolen) e->GetPar(pIx) = NULL; -+ GDLDelete(p); -+ } -+ assert( added > 0); -+ if( added == listLength) -+ break; -+ } -+ else -+ { -+ SizeT pID; -+ -+ if( p == NULL || kwNO_COPY) -+ { -+ pID = ip->NewHeap(1,p); // sets ref count -+ bool stolen = e->StealLocalPar( pIx); -+ if( !stolen) e->GetPar(pIx) = NULL; -+ } -+ else -+ { -+ pID = ip->NewHeap(1,p->Dup()); -+ } -+ -+ cStruct= new DStructGDL( containerDesc, dimension()); -+ -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = pID; -+ -+ cID = ip->NewHeap(1,cStruct); // sets ref count -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ -+ if( ++added == listLength) -+ break; -+ } -+ } -+ if( listLength != 0 && added < listLength) -+ { -+ for( ; addedNewHeap(1,NULL); -+ -+ cStruct= new DStructGDL( containerDesc, dimension()); -+ -+ (*static_cast( cStruct->GetTag( pDataTag, 0)))[0] = pID; -+ -+ cID = ip->NewHeap(1,cStruct); -+ -+ if( cStructLast != NULL) -+ (*static_cast( cStructLast->GetTag( pNextTag, 0)))[0] = cID; -+ else -+ { // 1st element -+ (*static_cast( listStruct->GetTag( pTailTag, 0)))[0] = cID; -+ } -+ -+ cStructLast = cStruct; -+ } -+ } -+ } -+ -+// if( cStruct != NULL) -+// (*static_cast( cStruct->GetTag( pNextTag, 0)))[0] = 0; -+ -+ (*static_cast( listStruct->GetTag( pHeadTag, 0)))[0] = cID; -+ (*static_cast( listStruct->GetTag( nListTag, 0)))[0] = added; -+ -+ newObjGuard.Release(); -+ return newObj; -+ } -+ -+ -+} // namespace lib -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/list.hpp gdl/src/list.hpp ---- gdl-0.9.3/src/list.hpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/list.hpp 2013-07-26 17:43:05.000000000 -0600 -@@ -0,0 +1,51 @@ -+/*************************************************************************** -+ list.hpp - for LIST objects -+ ------------------- -+ begin : July 22 2013 -+ copyright : (C) 2013 by M. Schellens et al. -+ email : m_schellens@users.sf.net -+ -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#ifndef LIST_HPP_ -+#define LIST_HPP_ -+ -+// #include -+void LIST__ToStream( DStructGDL* oStructGDL, std::ostream& o, SizeT w, SizeT* actPosPtr); -+ -+DStructGDL*GetSELF( BaseGDL* selfP, EnvUDT* e); -+ -+namespace lib { -+ -+ BaseGDL* list_fun( EnvT* e); -+ -+ BaseGDL* LIST___OverloadIsTrue( EnvUDT* e); -+ -+ BaseGDL* LIST___OverloadBracketsRightSide( EnvUDT* e); -+ void LIST___OverloadBracketsLeftSide( EnvUDT* e); -+ BaseGDL* LIST___OverloadPlus( EnvUDT* e); -+ BaseGDL* LIST___OverloadEQOp( EnvUDT* e); -+ BaseGDL* LIST___OverloadNEOp( EnvUDT* e); -+ -+ void list__add( EnvUDT* e); -+ -+ void list__remove_pro( EnvUDT* e); -+ -+ void list__reverse( EnvUDT* e); -+ -+ BaseGDL* list__remove_fun( EnvUDT* e); -+ -+ BaseGDL* list__toarray( EnvUDT* e); -+ -+} -+ -+#endif -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/magick_cl.cpp gdl/src/magick_cl.cpp ---- gdl-0.9.3/src/magick_cl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/magick_cl.cpp 2013-06-03 14:22:52.000000000 -0600 -@@ -55,30 +55,7 @@ - unsigned int gValid[40]; - unsigned int gCount=0; - -- string GDLutos(unsigned int i) -- { -- int mema=3; -- char *n=new char(mema); -- while (snprintf(n, sizeof n, "%u", i) >= sizeof n) -- { delete n;mema++; n=new char(mema); } -- string s=n; -- delete n; -- return s; -- } -- - -- string GDLitos(int i) -- { -- int mema=3; -- char *n=new char(mema); -- while (snprintf(n, sizeof n, "%d", i) >= sizeof n) -- { delete n;mema++; n=new char(mema); } -- string s=n; -- delete n; -- return s; -- } -- -- - void magick_setup() - { - int i; -@@ -564,7 +541,7 @@ - else - { - string s="MAGICK_READ: RGB order type not supported ("; -- s+=GDLutos(rgb); -+ s+=i2s(rgb); - s+="), using BGR ordering."; - Message(s); - map="BGR"; -@@ -659,7 +636,7 @@ - else - { - string s="MAGICK_WRITE: RGB order type not supported ("; -- s+=GDLutos(rgb); -+ s+=i2s(rgb); - s+="), using BGR ordering."; - Message(s); - map="BGR"; -@@ -669,8 +646,10 @@ - /* if(image.depth() == 8) - {*/ - -- DByteGDL * bImage= -- static_cast(GDLimage->Convert2(GDL_BYTE,BaseGDL::COPY)); -+ DByteGDL * bImage = -+ static_cast( GDLimage->Convert2(GDL_BYTE,BaseGDL::COPY)); -+ Guard bImageGuard(bImage); -+ - image.read(columns,rows,map, CharPixel,&(*bImage)[0]); - /* } - else if(image.depth() == 16) -@@ -1069,15 +1048,15 @@ - BaseGDL* GDLCol=e->GetParDefined(1); - DByteGDL * Red=static_cast(GDLCol->Convert2(GDL_BYTE,BaseGDL::COPY)); - //e->Guard( Red); -- auto_ptr r_guard( Red); -+ Guard r_guard( Red); - GDLCol=e->GetParDefined(2); - DByteGDL * Green=static_cast(GDLCol->Convert2(GDL_BYTE,BaseGDL::COPY)); - //e->Guard( Green); -- auto_ptr g_guard( Green); -+ Guard g_guard( Green); - GDLCol=e->GetParDefined(3); - DByteGDL *Blue= static_cast(GDLCol->Convert2(GDL_BYTE,BaseGDL::COPY)); - //e->Guard( Blue); -- auto_ptr b_guard( Blue); -+ Guard b_guard( Blue); - - if(Red->N_Elements() == Green->N_Elements() && - Red->N_Elements() == Blue->N_Elements()) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/Makefile.am gdl/src/Makefile.am ---- gdl-0.9.3/src/Makefile.am 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/Makefile.am 2013-07-31 09:41:43.657246681 -0600 -@@ -2,7 +2,7 @@ - INCLUDES = $(EXT_INCLUDES) $(all_includes) - SUBDIRS = antlr pro - --cpp_hpp_files = overload.hpp overload.cpp nullgdl.hpp nullgdl.cpp allix.hpp allix.cpp prognode.hpp \ -+cpp_hpp_files = hash.cpp hash.hpp overload.hpp overload.cpp nullgdl.hpp nullgdl.cpp allix.hpp allix.cpp prognode.hpp \ - prognodeexpr.hpp accessdesc.hpp arrayindex.hpp assocdata.cpp assocdata.hpp \ - basegdl.hpp basic_fun_cl.cpp basic_fun_cl.hpp basic_fun.cpp basic_fun.hpp \ - basic_fun_jmg.cpp basic_fun_jmg.hpp basic_op.cpp basic_op_new.cpp basic_pro.cpp basic_pro.hpp \ -@@ -29,13 +29,14 @@ - gstream.hpp ifmt.cpp \ - initct.cpp initsysvar.cpp initsysvar.hpp io.cpp io.hpp libinit_cl.cpp libinit.cpp \ - libinit_jmg.cpp \ -+ matrix_cholesky.hpp matrix_cholesky.cpp \ - math_fun.cpp math_fun.hpp math_fun_jmg.cpp \ - math_fun_jmg.hpp math_utl.cpp math_utl.hpp ncdf_att_cl.cpp ncdf_cl.cpp ncdf_cl.hpp \ - ncdf_dim_cl.cpp ncdf_var_cl.cpp new.cpp new.hpp objects.cpp objects.hpp ofmt.cpp \ - math_fun_ac.hpp math_fun_ac.cpp libinit_ac.cpp \ - math_fun_gm.hpp math_fun_gm.cpp libinit_gm.cpp \ - math_fun_ng.hpp math_fun_ng.cpp libinit_ng.cpp \ -- ofmt.hpp \ -+ list.hpp list.cpp ofmt.hpp overload.hpp overload.cpp\ - preferences.hpp preferences.cpp \ - plotting.cpp plotting.hpp print.cpp print_tree.cpp print_tree.hpp \ - read.cpp real2int.hpp str.cpp str.hpp terminfo.cpp terminfo.hpp topython.cpp \ -@@ -52,7 +53,7 @@ - plotting_device.cpp plotting_cursor.cpp plotting_contour.cpp plotting_surface.cpp \ - plotting_axis.cpp plotting_plots.cpp plotting_xyouts.cpp plotting_polyfill.cpp \ - plotting_windows.cpp plotting_convert_coord.cpp plotting_map_proj.cpp plotting_misc.cpp \ -- plotting_erase.cpp semshm.cpp -+ plotting_erase.cpp plotting_shade_surf.cpp semshm.cpp - # Makefile.am Makefile.in - - -Only in gdl-0.9.3/src: .#Makefile.am.1.64 -Only in gdl-0.9.3/src: Makefile.in -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/math_fun_ac.cpp gdl/src/math_fun_ac.cpp ---- gdl-0.9.3/src/math_fun_ac.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/math_fun_ac.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -6,11 +6,6 @@ - email : alaingdl@users.sourceforge.net - - ****************************************************************************/ -- -- -- -- -- - /*************************************************************************** - * * - * This program is free software; you can redistribute it and/or modify * -@@ -52,6 +47,7 @@ - - */ - -+ - #define GM_EPS 1.0e-6 - #define GM_ITER 50 - #define GM_TINY 1.0e-18 -@@ -67,7 +63,7 @@ - throw GDLException(e->CallingNode(), "Variable is undefined: "+e->GetParString(0)); \ - \ - DType t0 = e->GetParDefined(0)->Type(); \ -- //if (t0 == GDL_COMPLEX || t0 == GDL_COMPLEXDBL) \ -+ //if (t0 == GDL_COMPLEX || t0 == GDL_COMPLEXDBL) \ - // e->Throw("Complex not implemented (GSL limitation). "); - - #define AC_2P1() \ -@@ -81,7 +77,7 @@ - p1 = new DIntGDL(1, BaseGDL::NOZERO); \ - (*p1)[0]=0; \ - nElp1=1; \ -- t1 = GDL_INT; \ -+ t1 = GDL_INT; \ - p1_float = new DFloatGDL(1, BaseGDL::NOZERO); \ - (*p1_float)[0]=0.000; \ - } \ -@@ -97,25 +93,25 @@ - \ - // throw GDLException(e->CallingNode(), "Variable is undefined: "+e->GetParString(1)); \ - \ --// DType t1 = e->GetParDefined(1)->Type(); \ -- // if (t1 == GDL_COMPLEX || t1 == GDL_COMPLEXDBL) \ -+ // DType t1 = e->GetParDefined(1)->Type(); \ -+ // if (t1 == GDL_COMPLEX || t1 == GDL_COMPLEXDBL) \ - // e->Throw("Complex not implemented (GSL limitation). "); - --#define GM_DF2() \ -- \ -- DDoubleGDL* res; \ -- if (nElp0 == 1 && nElp1 == 1) \ -- res = new DDoubleGDL(1, BaseGDL::NOZERO); \ -- else if (nElp0 > 1 && nElp1 == 1) \ -- res = new DDoubleGDL(p0->Dim(), BaseGDL::NOZERO); \ -- else if (nElp0 == 1 && nElp1 > 1) \ -- res = new DDoubleGDL(p1->Dim(), BaseGDL::NOZERO); \ -- else if (nElp0 <= nElp1) \ -- res = new DDoubleGDL(p0->Dim(), BaseGDL::NOZERO); \ -- else \ -- res = new DDoubleGDL(p1->Dim(), BaseGDL::NOZERO); \ -- \ -- SizeT nElp = res->N_Elements(); \ -+#define GM_DF2() \ -+ \ -+ DDoubleGDL* res; \ -+ if (nElp0 == 1 && nElp1 == 1) \ -+ res = new DDoubleGDL(1, BaseGDL::NOZERO); \ -+ else if (nElp0 > 1 && nElp1 == 1) \ -+ res = new DDoubleGDL(p0->Dim(), BaseGDL::NOZERO); \ -+ else if (nElp0 == 1 && nElp1 > 1) \ -+ res = new DDoubleGDL(p1->Dim(), BaseGDL::NOZERO); \ -+ else if (nElp0 <= nElp1) \ -+ res = new DDoubleGDL(p0->Dim(), BaseGDL::NOZERO); \ -+ else \ -+ res = new DDoubleGDL(p1->Dim(), BaseGDL::NOZERO); \ -+ \ -+ SizeT nElp = res->N_Elements(); \ - - #define GM_CV0() \ - static DInt doubleKWIx = e->KeywordIx("DOUBLE"); \ -@@ -133,20 +129,20 @@ - else \ - return res; - --#define GM_CC1() \ -- static DInt coefKWIx = e->KeywordIx("ITER"); \ -- if(e->KeywordPresent(coefKWIx)) \ -- { \ -+#define GM_CC1() \ -+ static DInt coefKWIx = e->KeywordIx("ITER"); \ -+ if(e->KeywordPresent(coefKWIx)) \ -+ { \ - cout << "ITER keyword not used, always return -1)" << endl; \ -- e->SetKW( coefKWIx, new DLongGDL( -1)); \ -+ e->SetKW( coefKWIx, new DLongGDL( -1)); \ - } - --#define AC_HELP() \ -- if (e->KeywordSet("HELP")) { \ -+#define AC_HELP() \ -+ if (e->KeywordSet("HELP")) { \ - string inline_help[]={ \ - "Usage: res="+e->GetProName()+"(x, [n,] double=double)", \ - " -- x is a number or an array", \ -- " -- n is a number or an array (if missing, set to 0)", \ -+ " -- n is a number or an array (if missing, set to 0)", \ - " If x and n dimensions differ, reasonnable rules applied"}; \ - int size_of_s = sizeof(inline_help) / sizeof(inline_help[0]); \ - e->Help(inline_help, size_of_s); \ -@@ -158,13 +154,18 @@ - #include - - #ifdef _MSC_VER --#define isfinite _finite -+#define isfinite _finite - #define isinf !_finite - #endif - -+namespace lib { -+ - using namespace std; -+using std::isinf; - --namespace lib { -+#if defined(USE_EIGEN) -+using namespace Eigen; -+#endif - - BaseGDL* beseli_fun(EnvT* e) - { -@@ -177,8 +178,8 @@ - - // GSL Limitation for X : must be lower than ~708 - for (count = 0;count 708.) -- e->Throw("Value of X is out of allowed range."); -+ if ((*p0)[count] > 708.) -+ e->Throw("Value of X is out of allowed range."); - - // we need to check if N values (array) are Integer or not - int test=0; -@@ -520,10 +521,10 @@ - - // we only issue a message - if (nElpXpos != nElpYpos) { -- cout << "SPL_INIT (warning): X and Y arrays do not have same lengths !" << endl; -- // all next computations to be done on MIN(nElpXpos,nElpYpos) (except NaN/Inf checks) -- if (nElpXpos > nElpYpos) -- nElpXpos=nElpYpos; -+ cout << "SPL_INIT (warning): X and Y arrays do not have same lengths !" << endl; -+ // all next computations to be done on MIN(nElpXpos,nElpYpos) (except NaN/Inf checks) -+ if (nElpXpos > nElpYpos) -+ nElpXpos=nElpYpos; - } - - // creating result array -@@ -569,10 +570,10 @@ - } - } - -- auto_ptr U_guard; -+ Guard U_guard; - DDoubleGDL* U; - U = new DDoubleGDL(nElpXpos, BaseGDL::NOZERO); -- U_guard.reset(U); // delete upon exit -+ U_guard.Reset(U); // delete upon exit - - // may be we will have to check the size of these arrays ? - -@@ -580,10 +581,10 @@ - DDoubleGDL* YP0; - - if(Yderiv0 !=NULL && !isinf((*(YP0=e->GetKWAs(e->KeywordIx("YP0"))))[0] )){ -- // first derivative at the point X0 is defined and different to Inf -+ // first derivative at the point X0 is defined and different to Inf - (*res)[0]=-0.5; - (*U)[0] = ( 3. / ((*Xpos)[1]-(*Xpos)[0])) * (((*Ypos)[1]-(*Ypos)[0]) / -- ((*Xpos)[1]-(*Xpos)[0]) - (*YP0)[0] ); -+ ((*Xpos)[1]-(*Xpos)[0]) - (*YP0)[0] ); - - }else{ - // YP0 is omitted or equal to Inf -@@ -613,7 +614,7 @@ - DDoubleGDL* YPN; - - if(YderivN !=NULL && !isinf((*(YPN=e->GetKWAs(e->KeywordIx("YPN_1"))))[0] )){ -- // first derivative at the point XN-1 is defined and different to Inf -+ // first derivative at the point XN-1 is defined and different to Inf - (*res)[nElpXpos-1] =0.; - qn=0.5; - -@@ -621,7 +622,7 @@ - (*U)[nElpXpos-1]= (3./dx)*((*YPN)[0]-((*Ypos)[nElpXpos-1]-(*Ypos)[nElpXpos-2])/dx); - - }else{ -- // YPN_1 is omitted or equal to Inf -+ // YPN_1 is omitted or equal to Inf - qn=0.; - (*U)[nElpXpos-1]=0.; - } -@@ -629,7 +630,7 @@ - (*res)[nElpXpos-1] =((*U)[nElpXpos-1]-qn*(*U)[nElpXpos-2])/(qn*(*res)[nElpXpos-2]+ 1.); - - for (count = nElpXpos-2; count != -1; --count){ -- (*res)[count] =(*res)[count]*(*res)[count+1]+(*U)[count]; -+ (*res)[count] =(*res)[count]*(*res)[count+1]+(*U)[count]; - } - - GM_CV0(); -@@ -735,5 +736,64 @@ - return NULL; - } - -+ BaseGDL* matrix_multiply( EnvT* e) -+ { -+ BaseGDL* a = e->GetParDefined(0); -+ BaseGDL* b = e->GetParDefined(1); -+ -+ DType aTy = a->Type(); -+ if (!NumericType(aTy)) -+ e->Throw("Array type cannot be " + a->TypeStr() + " here: " + e->GetParString(0)); -+ DType bTy = b->Type(); -+ if (!NumericType(bTy)) -+ e->Throw("Array type cannot be " + b->TypeStr() + " here: " + e->GetParString(1)); -+ -+ static int atIx = e->KeywordIx("ATRANSPOSE"); -+ static int btIx = e->KeywordIx("BTRANSPOSE"); -+ bool at = e->KeywordSet(atIx); -+ bool bt = e->KeywordSet(btIx); -+ -+ if (a->Rank() > 2) -+ { -+ e->Throw("Array must have 1 or 2 dimensions: " + e->GetParString(0)); -+ } -+ if (b->Rank() > 2) -+ { -+ e->Throw("Array must have 1 or 2 dimensions: " + e->GetParString(1)); -+ } -+ -+ // code from ProgNode::AdjustTypes() -+ Guard aGuard; -+ Guard bGuard; -+ -+ // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) -+ { -+ a = a->Convert2( cxTy, BaseGDL::COPY); -+ aGuard.Init( a); -+ b = b->Convert2( cxTy, BaseGDL::COPY); -+ bGuard.Init( b); -+ } -+ else -+ { -+ DType cTy = PromoteMatrixOperands( aTy, bTy); -+ -+ if( aTy != cTy) -+ { -+ a = a->Convert2( cTy, BaseGDL::COPY); -+ aGuard.Init( a); -+ } -+ if( bTy != cTy) -+ { -+ b = b->Convert2( cTy, BaseGDL::COPY); -+ bGuard.Init( b); -+ } -+ } -+ -+ // might use eigen3 -+ return a->MatrixOp( b, at, bt); -+ } -+ - } // namespace - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/math_fun_ac.hpp gdl/src/math_fun_ac.hpp ---- gdl-0.9.3/src/math_fun_ac.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/math_fun_ac.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -18,6 +18,11 @@ - #include "datatypes.hpp" - #include "envt.hpp" - -+#if defined(USE_EIGEN) -+#include -+//using namespace Eigen; // never in header files! -+#endif -+ - namespace lib { - - BaseGDL* beseli_fun( EnvT* e); -@@ -31,6 +36,7 @@ - BaseGDL* sobel_fun( EnvT* e); - BaseGDL* roberts_fun( EnvT* e); - BaseGDL* prewitt_fun( EnvT* e); -+ BaseGDL* matrix_multiply( EnvT* e); - - } // namespace - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/math_fun.cpp gdl/src/math_fun.cpp ---- gdl-0.9.3/src/math_fun.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/math_fun.cpp 2013-07-31 09:41:44.120245067 -0600 -@@ -60,9 +60,9 @@ - template< typename srcT, typename destT> - void FromToGSL( srcT* src, destT* dest, SizeT nEl) - { --// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ // #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { --// #pragma omp for -+ // #pragma omp for - for( SizeT d = 0; dKeywordSet( doubleKWIx); - - BaseGDL* A = e->GetParDefined( 0); -- doubleKW = doubleKW || (dynamic_cast< DDoubleGDL*>( A) != NULL) || (dynamic_cast< DComplexDblGDL*>( A) != NULL); -+ doubleKW = doubleKW || (A->Type() == GDL_DOUBLE) || (A->Type() == GDL_COMPLEXDBL); - - if( doubleKW) - { -@@ -125,7 +125,7 @@ - gsl_matrix *aGSL = gsl_matrix_alloc( m, n); - GDLGuard g1( aGSL, gsl_matrix_free); - if( !columnKW) -- memcpy(aGSL->data, &(*AA)[0], nEl*sizeof( double)); -+ memcpy(aGSL->data, &(*AA)[0], nEl*sizeof( DDouble)); - else - TransposeFromToGSL< DDouble, double>( &(*AA)[0], aGSL->data, AA->Dim( 0), nEl); - -@@ -137,7 +137,7 @@ - gsl_vector *work = gsl_vector_alloc( n); - GDLGuard g4( work, gsl_vector_free); - gsl_linalg_SV_decomp( aGSL, vGSL, wGSL, work); --// gsl_vector_free( work); -+ // gsl_vector_free( work); - - // aGSL -> uGSL - gsl_matrix *uGSL = aGSL; // why? -@@ -145,25 +145,25 @@ - // U - DDoubleGDL* U = new DDoubleGDL( AA->Dim(), BaseGDL::NOZERO); - if( !columnKW) -- memcpy( &(*U)[0], uGSL->data, nEl*sizeof( double)); -+ memcpy( &(*U)[0], uGSL->data, nEl*sizeof( DDouble)); - else - TransposeFromToGSL< double, DDouble>( uGSL->data, &(*U)[0], U->Dim( 1), nEl); --// gsl_matrix_free( uGSL); -+ // gsl_matrix_free( uGSL); - e->SetPar( 2, U); - - // V - DDoubleGDL* V = new DDoubleGDL( dimension( n, n), BaseGDL::NOZERO); - if( !columnKW) -- memcpy( &(*V)[0], vGSL->data, n*n*sizeof( double)); -+ memcpy( &(*V)[0], vGSL->data, n*n*sizeof( DDouble)); - else - TransposeFromToGSL< double, DDouble>( vGSL->data, &(*V)[0], n, n*n); --// gsl_matrix_free( vGSL); -+ // gsl_matrix_free( vGSL); - e->SetPar( 3, V); - - // W - DDoubleGDL* W = new DDoubleGDL( dimension( n), BaseGDL::NOZERO); -- memcpy( &(*W)[0], wGSL->data, n*sizeof( double)); --// gsl_vector_free( wGSL); -+ memcpy( &(*W)[0], wGSL->data, n*sizeof( DDouble)); -+ // gsl_vector_free( wGSL); - e->SetPar( 1, W); - } - else // float -@@ -185,7 +185,7 @@ - gsl_vector *work = gsl_vector_alloc( n); - GDLGuard g4( work, gsl_vector_free); - gsl_linalg_SV_decomp( aGSL, vGSL, wGSL, work); --// gsl_vector_free( work); -+ // gsl_vector_free( work); - - // aGSL -> uGSL - gsl_matrix *uGSL = aGSL; // why? -@@ -196,7 +196,7 @@ - FromToGSL< double, DFloat>( uGSL->data, &(*U)[0], nEl); - else - TransposeFromToGSL< double, DFloat>( uGSL->data, &(*U)[0], U->Dim( 1), nEl); --// gsl_matrix_free( uGSL); -+ // gsl_matrix_free( uGSL); - e->SetPar( 2, U); - - // V -@@ -205,13 +205,13 @@ - FromToGSL< double, DFloat>( vGSL->data, &(*V)[0], n*n); - else - TransposeFromToGSL< double, DFloat>( vGSL->data, &(*V)[0], n, n*n); --// gsl_matrix_free( vGSL); -+ // gsl_matrix_free( vGSL); - e->SetPar( 3, V); - - // W - DFloatGDL* W = new DFloatGDL( dimension( n), BaseGDL::NOZERO); - FromToGSL< double, DFloat>( wGSL->data, &(*W)[0], n); --// gsl_vector_free( wGSL); -+ // gsl_vector_free( wGSL); - e->SetPar( 1, W); - } - } -@@ -223,16 +223,30 @@ - T* p0C = static_cast( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ // eigen is not faster here -+ // #ifdef USE_EIGEN -+ // -+ // Eigen::Map ,Eigen::Aligned> m1(&(*p0C)[0], nEl); -+ // Eigen::Map ,Eigen::Aligned> m2(&(*res)[0], nEl); -+ // m2 = m1.sin(); -+ // return res; -+ // #else -+ if( nEl == 1) -+ { -+ (*res)[0] = sin( (*p0C)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); - --// e->NParam( 1);//, "SIN"); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "SIN"); --// -- SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // e->NParam( 1);//, "SIN"); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "SIN"); -+ // -+ SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - -- if( p0->Type() == GDL_COMPLEX) -+ DType p0Type = p0->Type(); -+ if( p0Type == GDL_COMPLEX) - return sin_fun_template< DComplexGDL>( p0); -- else if( p0->Type() == GDL_COMPLEXDBL) -+ else if( p0Type == GDL_COMPLEXDBL) - return sin_fun_template< DComplexDblGDL>( p0); -- else if( p0->Type() == GDL_DOUBLE) -+ else if( p0Type == GDL_DOUBLE) - return sin_fun_template< DDoubleGDL>( p0); -- else if( p0->Type() == GDL_FLOAT) -+ else if( p0Type == GDL_FLOAT) - return sin_fun_template< DFloatGDL>( p0); - else - { - DFloatGDL* res = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = cos( (*p0C)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); - --// SizeT nParam=e->NParam(); --// --// if( nParam == 0) --// e->Throw( --// "Incorrect number of arguments."); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "COS"); --// -- SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // SizeT nParam=e->NParam(); -+ // -+ // if( nParam == 0) -+ // e->Throw( -+ // "Incorrect number of arguments."); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "COS"); -+ // -+ SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX) - return cos_fun_template< DComplexGDL>( p0); -@@ -322,53 +342,63 @@ - { - DFloatGDL* res = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i -+ template< typename T> - BaseGDL* tan_fun_template( BaseGDL* p0) - { - T* p0C = static_cast( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = tan( (*p0C)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i -+ template<> - BaseGDL* tan_fun_template< DComplexGDL>( BaseGDL* p0) - { -- typedef DComplexGDL T; -+ typedef DComplexGDL T; - T* p0C = static_cast( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = tan( static_cast((*p0C)[0])); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i((*p0C)[ i])); -- } -- } -+ for( OMPInt i=0; i((*p0C)[ i])); -+ } -+ } - return res; - } - -@@ -377,18 +407,18 @@ - assert( p0 != NULL); - assert( p0->N_Elements() > 0); - --// SizeT nParam=e->NParam(); --// --// if( nParam == 0) --// e->Throw( --// "Incorrect number of arguments."); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "TAN"); --// -- SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // SizeT nParam=e->NParam(); -+ // -+ // if( nParam == 0) -+ // e->Throw( -+ // "Incorrect number of arguments."); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "TAN"); -+ // -+ SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX) - return tan_fun_template< DComplexGDL>( p0); -@@ -402,15 +432,15 @@ - { - DFloatGDL* res = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = sinh( (*p0C)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); - --// SizeT nParam=e->NParam(); --// --// if( nParam == 0) --// e->Throw( --// "Incorrect number of arguments."); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "SINH"); --// -- SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // SizeT nParam=e->NParam(); -+ // -+ // if( nParam == 0) -+ // e->Throw( -+ // "Incorrect number of arguments."); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "SINH"); -+ // -+ SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX) - return sinh_fun_template< DComplexGDL>( p0); -@@ -463,15 +498,15 @@ - { - DFloatGDL* res = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = cosh( (*p0C)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); - --// SizeT nParam=e->NParam(); --// --// if( nParam == 0) --// e->Throw( --// "Incorrect number of arguments."); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "COSH"); --// -- SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // SizeT nParam=e->NParam(); -+ // -+ // if( nParam == 0) -+ // e->Throw( -+ // "Incorrect number of arguments."); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "COSH"); -+ // -+ SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX) - return cosh_fun_template< DComplexGDL>( p0); -@@ -524,15 +564,15 @@ - { - DFloatGDL* res = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = tanh( (*p0C)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); - --// SizeT nParam=e->NParam(); --// --// if( nParam == 0) --// e->Throw( --// "Incorrect number of arguments."); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "TANH"); --// --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // SizeT nParam=e->NParam(); -+ // -+ // if( nParam == 0) -+ // e->Throw( -+ // "Incorrect number of arguments."); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "TANH"); -+ // -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX) - return tanh_fun_template< DComplexGDL>( p0); -@@ -585,15 +630,15 @@ - DFloatGDL* res = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); --// e->NParam( 1);//, "ASIN"); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "ASIN"); --// -- SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // e->NParam( 1);//, "ASIN"); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "ASIN"); -+ // -+ SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX || p0->Type() == GDL_COMPLEXDBL) - { -@@ -619,45 +664,60 @@ - { - DDoubleGDL* p0D = static_cast( p0); - DDoubleGDL* res = new DDoubleGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = asin( (*p0D)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_FLOAT) - { - DFloatGDL* p0F = static_cast( p0); - DFloatGDL* res = new DFloatGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = asin( (*p0F)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = asin( (*res)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); --// e->NParam( 1);//, "ACOS"); --// --// BaseGDL* p0 = e->GetParDefined( 0);//, "ACOS"); --// -- SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( --// "Variable is undefined: "+e->GetParString(0)); -+ // e->NParam( 1);//, "ACOS"); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0);//, "ACOS"); -+ // -+ SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( -+ // "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX || p0->Type() == GDL_COMPLEXDBL) - { -@@ -683,44 +743,59 @@ - { - DDoubleGDL* p0D = static_cast( p0); - DDoubleGDL* res = new DDoubleGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = acos( (*p0D)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_FLOAT) - { - DFloatGDL* p0F = static_cast( p0); - DFloatGDL* res = new DFloatGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = acos( (*p0F)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[0] = acos( (*res)[0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i - inline C atanC(const C& c) - { --// double x = c.real(); --// double x2 = x * x; --// double y = c.imag(); --// return C(0.5 * atan2(2.0*x, 1.0 - x2 - y*y), 0.25 * log( (x2 + (y+1)*(y+1)) / (x2 + (y-1)*(y-1)) )); -+ // double x = c.real(); -+ // double x2 = x * x; -+ // double y = c.imag(); -+ // return C(0.5 * atan2(2.0*x, 1.0 - x2 - y*y), 0.25 * log( (x2 + (y+1)*(y+1)) / (x2 + (y-1)*(y-1)) )); - const C i(0.0,1.0); - const C one(1.0,0.0); - return log( (one + i * c) / (one - i * c)) / (C(2.0,0.0)*i); -@@ -741,8 +816,9 @@ - inline C atanC(const C& c1, const C& c2) - { - const C i(0.0,1.0); -- const C one(1.0,0.0); -- return -i * log((c2 + i * c1) / sqrt(pow(c2, 2) + pow(c1, 2))); -+ //const C one(1.0,0.0); -+ // return -i * log((c2 + i * c1) / (sqrt(pow(c2, 2) + pow(c1, 2)))); -+ return -i * log((c2 + i * c1) / sqrt((c2 * c2) + (c1 * c1))); - } - - BaseGDL* atan_fun( EnvT* e) -@@ -784,13 +860,13 @@ - - if( t == GDL_COMPLEX) - { -- auto_ptr< DComplexGDL> guard0; -- auto_ptr< DComplexGDL> guard1; -+ Guard< DComplexGDL> guard0; -+ Guard< DComplexGDL> guard1; - - DComplexGDL* p0F = static_cast(p0->Convert2( GDL_COMPLEX, BaseGDL::COPY)); -- guard0.reset( p0F); -+ guard0.Init( p0F); - DComplexGDL* p1F = static_cast(p1->Convert2( GDL_COMPLEX, BaseGDL::COPY)); -- guard1.reset( p1F); -+ guard1.Init( p1F); - - DComplexGDL* res = new DComplexGDL( dim, BaseGDL::NOZERO); - for (i = 0; i < nElMin; ++i) (*res)[i] = atanC((*p0F)[*i0], (*p1F)[*i1]); -@@ -798,13 +874,13 @@ - } - else if( t == GDL_COMPLEXDBL) - { -- auto_ptr< DComplexDblGDL> guard0; -- auto_ptr< DComplexDblGDL> guard1; -+ Guard< DComplexDblGDL> guard0; -+ Guard< DComplexDblGDL> guard1; - - DComplexDblGDL* p0F = static_cast(p0->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY)); -- guard0.reset( p0F); -+ guard0.Init( p0F); - DComplexDblGDL* p1F = static_cast(p1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY)); -- guard1.reset( p1F); -+ guard1.Init( p1F); - - DComplexDblGDL* res = new DComplexDblGDL( dim, BaseGDL::NOZERO); - for (i = 0; i < nElMin; ++i) (*res)[i] = atanC((*p0F)[*i0], (*p1F)[*i1]); -@@ -812,13 +888,13 @@ - } - else if( t == GDL_DOUBLE) - { -- auto_ptr< DDoubleGDL> guard; -+ Guard< DDoubleGDL> guard; - - DDoubleGDL* p0D; - if( p0->Type() != GDL_DOUBLE) - { - p0D = static_cast( p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard.reset( p0D); -+ guard.Reset( p0D); - } - else - { -@@ -829,7 +905,7 @@ - if( p1->Type() != GDL_DOUBLE) - { - p1D = static_cast( p1->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard.reset( p1D); -+ guard.Reset( p1D); - } - else - { -@@ -842,13 +918,13 @@ - } - else if( t == GDL_FLOAT) - { -- auto_ptr< DFloatGDL> guard; -+ Guard< DFloatGDL> guard; - - DFloatGDL* p0F; - if( p0->Type() != GDL_FLOAT) - { - p0F = static_cast( p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( p0F); -+ guard.Reset( p0F); - } - else - { -@@ -859,7 +935,7 @@ - if( p1->Type() != GDL_FLOAT) - { - p1F = static_cast( p1->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( p1F); -+ guard.Reset( p1F); - } - else - { -@@ -873,13 +949,13 @@ - } - else - { -- auto_ptr< DFloatGDL> guard0; -- auto_ptr< DFloatGDL> guard1; -+ Guard< DFloatGDL> guard0; -+ Guard< DFloatGDL> guard1; - - DFloatGDL* p0F = static_cast(p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard0.reset( p0F); -+ guard0.Init( p0F); - DFloatGDL* p1F = static_cast(p1->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard1.reset( p1F); -+ guard1.Init( p1F); - - DFloatGDL* res = new DFloatGDL( dim, BaseGDL::NOZERO); - for (i = 0; i < nElMin; ++i) -@@ -897,103 +973,140 @@ - { - DComplexGDL* p0C = static_cast( p0); - DFloatGDL* res = new DFloatGDL( p0C->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplex& C = (*p0C)[ 0]; -+ (*res)[ 0] = (float)atan2((double)C.imag(), (double)C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_COMPLEX) - { - DComplexGDL* p0C = static_cast( p0); - DComplexGDL* res = new DComplexGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = atanC((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_COMPLEXDBL && e->KeywordSet(phaseIx)) - { - DComplexDblGDL* p0C = static_cast( p0); - DDoubleGDL* res = new DDoubleGDL( p0C->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplexDbl& C = (*p0C)[ 0]; -+ (*res)[ 0] = atan2( C.imag(), C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_COMPLEXDBL) - { - DComplexDblGDL* p0C = static_cast( p0); - DComplexDblGDL* res = new DComplexDblGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = atanC((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_DOUBLE) - { - DDoubleGDL* p0D = static_cast( p0); - DDoubleGDL* res = new DDoubleGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = atan((*p0D)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_FLOAT) - { - DFloatGDL* p0F = static_cast( p0); - DFloatGDL* res = new DFloatGDL( p0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = atan((*p0F)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = atan((*res)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iLog(); - --// if( FloatType( p0->Type()) || ComplexType( p0->Type())) --// if( !isReference) //e->StealLocalPar( 0)) --// { --// p0->LogThis(); --// return p0; --// } --// else --// return p0->Log(); --// else --// { --// DFloatGDL* res = static_cast --// (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --// res->LogThis(); --// return res; --// } -+ // if( FloatType( p0->Type()) || ComplexType( p0->Type())) -+ // if( !isReference) //e->StealLocalPar( 0)) -+ // { -+ // p0->LogThis(); -+ // return p0; -+ // } -+ // else -+ // return p0->Log(); -+ // else -+ // { -+ // DFloatGDL* res = static_cast -+ // (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ // res->LogThis(); -+ // return res; -+ // } - } - - --// BaseGDL* alog10_fun( EnvT* e) --BaseGDL* alog10_fun( BaseGDL* p0, bool isReference) -+ // BaseGDL* alog10_fun( EnvT* e) -+ BaseGDL* alog10_fun( BaseGDL* p0, bool isReference) - { - assert( p0 != NULL); - assert( p0->N_Elements() > 0); -@@ -1054,21 +1167,21 @@ - } - return p0->Log10(); - --// if( FloatType( p0->Type()) || ComplexType( p0->Type())) --// if( !isReference) //e->StealLocalPar( 0)) --// { --// p0->Log10This(); --// return p0; --// } --// else --// return p0->Log10(); --// else --// { --// DFloatGDL* res = static_cast --// (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); --// res->Log10This(); --// return res; --// } -+ // if( FloatType( p0->Type()) || ComplexType( p0->Type())) -+ // if( !isReference) //e->StealLocalPar( 0)) -+ // { -+ // p0->Log10This(); -+ // return p0; -+ // } -+ // else -+ // return p0->Log10(); -+ // else -+ // { -+ // DFloatGDL* res = static_cast -+ // (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ // res->Log10This(); -+ // return res; -+ // } - } - - // original by joel gales -@@ -1078,16 +1191,32 @@ - T* p0C = static_cast( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = sqrt((*p0C)[ 0]); -+ return res; -+ } -+ -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mP0C(&(*p0C)[0], nEl); -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mP0C.sqrt(); -+ return res; -+#else -+ -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma intel omp forthis -- for( int i=0; i -@@ -1095,16 +1224,28 @@ - { - T* p0C = static_cast( p0); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*p0C)[ 0] = sqrt((*p0C)[ 0]); -+ return p0C; -+ } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mP0C(&(*p0C)[0], nEl); -+ mP0C = mP0C.sqrt(); -+ return p0C; -+#else -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); - -+ DType p0Type = p0->Type(); - if( isReference) -- { -- if( p0->Type() == GDL_COMPLEX) -- return sqrt_fun_template< DComplexGDL>( p0); -- else if( p0->Type() == GDL_COMPLEXDBL) -- return sqrt_fun_template< DComplexDblGDL>( p0); -- else if( p0->Type() == GDL_DOUBLE) -- return sqrt_fun_template< DDoubleGDL>( p0); -- else if( p0->Type() == GDL_FLOAT) -- return sqrt_fun_template< DFloatGDL>( p0); -- } -+ { -+ if( p0Type == GDL_COMPLEX) -+ return sqrt_fun_template< DComplexGDL>( p0); -+ else if( p0Type == GDL_COMPLEXDBL) -+ return sqrt_fun_template< DComplexDblGDL>( p0); -+ else if( p0Type == GDL_DOUBLE) -+ return sqrt_fun_template< DDoubleGDL>( p0); -+ else if( p0Type == GDL_FLOAT) -+ return sqrt_fun_template< DFloatGDL>( p0); -+ } - else -- { -- if( p0->Type() == GDL_COMPLEX) -- return sqrt_fun_template_grab< DComplexGDL>( p0); -- else if( p0->Type() == GDL_COMPLEXDBL) -- return sqrt_fun_template_grab< DComplexDblGDL>( p0); -- else if( p0->Type() == GDL_DOUBLE) -- return sqrt_fun_template_grab< DDoubleGDL>( p0); -- else if( p0->Type() == GDL_FLOAT) -- return sqrt_fun_template_grab< DFloatGDL>( p0); -- } - { -- DFloatGDL* res = static_cast -- (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( p0Type == GDL_COMPLEX) -+ return sqrt_fun_template_grab< DComplexGDL>( p0); -+ else if( p0Type == GDL_COMPLEXDBL) -+ return sqrt_fun_template_grab< DComplexDblGDL>( p0); -+ else if( p0Type == GDL_DOUBLE) -+ return sqrt_fun_template_grab< DDoubleGDL>( p0); -+ else if( p0Type == GDL_FLOAT) -+ return sqrt_fun_template_grab< DFloatGDL>( p0); -+ } -+ { -+ DFloatGDL* res = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ SizeT nEl = p0->N_Elements(); -+ if( nEl == 1) -+ { -+ (*res)[ 0] = sqrt( (*res)[ 0]); -+ return res; -+ } -+#ifdef USE_EIGEN -+ -+ Eigen::Map ,Eigen::Aligned> mRes(&(*res)[0], nEl); -+ mRes = mRes.sqrt(); -+ return res; -+#else -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i - BaseGDL* abs_fun_template( BaseGDL* p0) - { - T* p0C = static_cast( p0); - T* res = new T( p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = abs((*p0C)[ 0]); -+ return res; -+ } -+ -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); --// e->NParam( 1); --// --// BaseGDL* p0 = e->GetParDefined( 0); --// --// SizeT nEl = p0->N_Elements(); --// if( nEl == 0) --// e->Throw( "Variable is undefined: "+e->GetParString(0)); -+ // e->NParam( 1); -+ // -+ // BaseGDL* p0 = e->GetParDefined( 0); -+ // -+ // SizeT nEl = p0->N_Elements(); -+ // if( nEl == 0) -+ // e->Throw( "Variable is undefined: "+e->GetParString(0)); - - if( p0->Type() == GDL_COMPLEX) - { - DComplexGDL* p0C = static_cast( p0); - DFloatGDL* res = new DFloatGDL(p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = abs((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_COMPLEXDBL) -@@ -1206,18 +1370,23 @@ - DComplexDblGDL* p0C = static_cast( p0); - DDoubleGDL* res = new DDoubleGDL(p0C->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = abs((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_DOUBLE) -@@ -1231,39 +1400,44 @@ - else if( p0->Type() == GDL_INT) - return abs_fun_template< DIntGDL>( p0); - else if( isReference) -- { -- if( p0->Type() == GDL_ULONG64) -- return p0->Dup(); -- else if( p0->Type() == GDL_ULONG) -- return p0->Dup(); -- else if( p0->Type() == GDL_UINT) -- return p0->Dup(); -- else if( p0->Type() == GDL_BYTE) -- return p0->Dup(); -- } -+ { -+ if( p0->Type() == GDL_ULONG64) -+ return p0->Dup(); -+ else if( p0->Type() == GDL_ULONG) -+ return p0->Dup(); -+ else if( p0->Type() == GDL_UINT) -+ return p0->Dup(); -+ else if( p0->Type() == GDL_BYTE) -+ return p0->Dup(); -+ } - else -- { -- if( p0->Type() == GDL_ULONG64) -- return p0; -- else if( p0->Type() == GDL_ULONG) -- return p0; -- else if( p0->Type() == GDL_UINT) -- return p0; -- else if( p0->Type() == GDL_BYTE) -- return p0; -- } -+ { -+ if( p0->Type() == GDL_ULONG64) -+ return p0; -+ else if( p0->Type() == GDL_ULONG) -+ return p0; -+ else if( p0->Type() == GDL_UINT) -+ return p0; -+ else if( p0->Type() == GDL_BYTE) -+ return p0; -+ } - DFloatGDL* res = static_cast - (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = abs((*res)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = static_cast( round((*p0C)[ 0])); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( round((*p0C)[ i])); -- } -- } -+ for( OMPInt i=0; i( round((*p0C)[ i])); -+ } -+ } - return res; - } else { - DLongGDL* res = new DLongGDL(p0C->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = static_cast( round((*p0C)[ 0])); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( round((*p0C)[ i])); -- } -- } -+ for( OMPInt i=0; i( round((*p0C)[ i])); -+ } -+ } - return res; - } - } -@@ -1324,29 +1508,41 @@ - // L64 keyword support - if (isKWSetL64) { - DLong64GDL* res = new DLong64GDL(p0C->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplex& C = (*p0C)[ 0]; -+ (*res)[ 0] = (DLong64) round(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplex& C = (*p0C)[ 0]; -+ (*res)[ 0] = (int) round(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplexDbl& C = (*p0C)[ 0]; -+ (*res)[ 0] = (DLong64) round(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplexDbl& C = (*p0C)[ 0]; -+ (*res)[ 0] = (int) round(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iGetParAs( 0); - DLongGDL* res = new DLongGDL(p0->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = (int) round((double) (*p0F)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i - BaseGDL* ceil_fun_template( BaseGDL* p0, bool isKWSetL64) - { -@@ -1429,27 +1644,37 @@ - // L64 keyword support - if (isKWSetL64) { - DLong64GDL* res = new DLong64GDL(p0C->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = (DLong64) ceil((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = (int) ceil((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplex& C = (*p0C)[ 0]; -+ (*res)[ 0] = (DLong64) ceil(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplex& C = (*p0C)[ 0]; -+ (*res)[ 0] = (int) ceil(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplexDbl& C = (*p0C)[ 0]; -+ (*res)[ 0] = (DLong64) ceil(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplexDbl& C = (*p0C)[ 0]; -+ (*res)[ 0] = (int) ceil(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iGetParAs( 0); - DLongGDL* res = new DLongGDL(p0->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = (int) ceil((double) (*p0F)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i - BaseGDL* floor_fun_template( BaseGDL* p0, bool isKWSetL64) - { -@@ -1580,27 +1836,37 @@ - // L64 keyword support - if (isKWSetL64) { - DLong64GDL* res = new DLong64GDL(p0C->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = (DLong64) floor((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = (int) floor((*p0C)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplex& C = (*p0C)[ 0]; -+ (*res)[ 0] = (DLong64) floor(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplex& C = (*p0C)[ 0]; -+ (*res)[ 0] = (int) floor(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplexDbl& C = (*p0C)[ 0]; -+ (*res)[ 0] = (DLong64) floor(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iDim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ DComplexDbl& C = (*p0C)[ 0]; -+ (*res)[ 0] = (int) floor(C.real()); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iGetParAs( 0); - DLongGDL* res = new DLongGDL(p0->Dim(), BaseGDL::NOZERO); - SizeT nEl = p0->N_Elements(); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = (int) floor((double) (*p0F)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iN_Elements() > 0); - --// e->NParam( 1); --// BaseGDL* p0 = e->GetParDefined( 0); -+ // e->NParam( 1); -+ // BaseGDL* p0 = e->GetParDefined( 0); - SizeT nEl = p0->N_Elements(); - // if( nEl == 0) - // e->Throw( "Variable is undefined: "+e->GetParString(0)); -@@ -1737,30 +2034,30 @@ - { - DComplexGDL* res = static_cast(p0)->NewResult();// static_cast(p0->Dup()); - DComplexGDL* p0C = static_cast(p0); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_COMPLEXDBL) - { - DComplexDblGDL* res = static_cast(p0)->NewResult();//static_cast(p0->Dup()); - DComplexDblGDL* p0C = static_cast(p0); --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iType() == GDL_DOUBLE || -@@ -1783,8 +2080,8 @@ - assert( p0 != NULL); - assert( p0->N_Elements() > 0); - --// e->NParam( 1); --// BaseGDL* p0 = e->GetParDefined( 0); -+ // e->NParam( 1); -+ // BaseGDL* p0 = e->GetParDefined( 0); - SizeT nEl = p0->N_Elements(); - - // if( nEl == 0) -@@ -1795,9 +2092,9 @@ - { - DComplexGDL* c0 = static_cast(p0); - DFloatGDL* res = new DFloatGDL( c0->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ // #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { --// #pragma omp for -+ // #pragma omp for - for( SizeT i=0; i(p0); - DDoubleGDL* res = new DDoubleGDL( c0->Dim(), BaseGDL::NOZERO); --// #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -+ // #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { --// #pragma omp for -+ // #pragma omp for - for( SizeT i=0; iN_Elements() > 0); - --// e->NParam( 1); --// BaseGDL* p0 = e->GetParDefined( 0); -+ // e->NParam( 1); -+ // BaseGDL* p0 = e->GetParDefined( 0); - -- SizeT nEl = p0->N_Elements(); -+ SizeT nEl = p0->N_Elements(); - - DType t = p0->Type(); -- if( t == GDL_COMPLEXDBL) -+ if( t == GDL_COMPLEXDBL) - { - DComplexDblGDL *c0 = static_cast< DComplexDblGDL*>( p0); - DComplexDblGDL *res = c0->New( c0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = exp( (*c0)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0); - DComplexGDL *res = c0->New( c0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = exp( (*c0)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0); - DDoubleGDL *res = c0->New( c0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = exp( (*c0)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0); - DFloatGDL *res = c0->New( c0->Dim(), BaseGDL::NOZERO); --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = exp( (*c0)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; i( p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); - --TRACEOMP( __FILE__, __LINE__) -+ if( nEl == 1) -+ { -+ (*res)[ 0] = exp( (*res)[ 0]); -+ return res; -+ } -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) -- { -+ { - #pragma omp for -- for( int i=0; iThrow("Argument N must be greater than or equal to zero."); - - DDoubleGDL* kval; -- auto_ptr kval_guard; -+ Guard kval_guard; - if (nParam>2) { - kval = e->GetParAs(2); - if(kval->N_Elements() != 1) -@@ -2026,22 +2348,22 @@ - e->Throw("Argument K must be greater than or equal to zero."); - } else { - kval = new DDoubleGDL(0); -- kval_guard.reset(kval); -+ kval_guard.Reset(kval); - } - - DDoubleGDL* res = new DDoubleGDL(xvals->Dim(),BaseGDL::NOZERO); - DDouble k = (*kval)[0]; - DInt n = (*nval)[0]; - SizeT nEx = xvals->N_Elements(); -- int count; -+ OMPInt count; - --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (nEx >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEx)) -- { -+ { - #pragma omp for -- for (count = 0;countKeywordIx("DOUBLE"); - static DInt coefKWIx = e->KeywordIx("COEFFICIENTS"); -@@ -2050,17 +2372,17 @@ - double gamma_kn1 = gsl_sf_gamma(k+n+1.); - DDoubleGDL* coefKW = new DDoubleGDL(dimension(n+1) , BaseGDL::NOZERO); - --TRACEOMP( __FILE__, __LINE__) -+ TRACEOMP( __FILE__, __LINE__) - #pragma omp parallel if (n >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= n)) - { - #pragma omp for -- for(count = 0;count<=n;++count) { -- double dcount = static_cast(count); -- (*coefKW)[count] = ((count & 0x0001)?-1.0:1.0)*gamma_kn1/ -- (gsl_sf_gamma(n-dcount+1.)*gsl_sf_gamma(k+dcount+1.)* -- gsl_sf_gamma(dcount+1.)); -- } -- } -+ for(count = 0;count<=n;++count) { -+ double dcount = static_cast(count); -+ (*coefKW)[count] = ((count & 0x0001)?-1.0:1.0)*gamma_kn1/ -+ (gsl_sf_gamma(n-dcount+1.)*gsl_sf_gamma(k+dcount+1.)* -+ gsl_sf_gamma(dcount+1.)); -+ } -+ } - if(e->GetParDefined(0)->Type() != GDL_DOUBLE && !e->KeywordSet(doubleKWIx)) - coefKW = static_cast(coefKW-> - Convert2(GDL_FLOAT,BaseGDL::CONVERT)); -@@ -2204,25 +2526,25 @@ - template - T inverf (T p) /* Inverse Error Function */ - { -- /* -- * Source: This routine was derived (using f2c) from the Fortran -- * subroutine MERFI found in ACM Algorithm 602, obtained from netlib. -- * -- * MDNRIS code is copyright 1978 by IMSL, Inc. Since MERFI has been -- * submitted to netlib, it may be used with the restrictions that it may -- * only be used for noncommercial purposes, and that IMSL be acknowledged -- * as the copyright-holder of the code. -- */ -- -- /* Initialized data */ -- static T a1 = -.5751703, a2 = -1.896513, a3 = -.05496261, -- b0 = -.113773, b1 = -3.293474, b2 = -2.374996, b3 = -1.187515, -- c0 = -.1146666, c1 = -.1314774, c2 = -.2368201, c3 = .05073975, -- d0 = -44.27977, d1 = 21.98546, d2 = -7.586103, -- e0 = -.05668422, e1 = .3937021, e2 = -.3166501, e3 = .06208963, -- f0 = -6.266786, f1 = 4.666263, f2 = -2.962883, -- g0 = 1.851159e-4, g1 = -.002028152, g2 = -.1498384, g3 = .01078639, -- h0 = .09952975, h1 = .5211733, h2 = -.06888301; -+ /* -+ * Source: This routine was derived (using f2c) from the Fortran -+ * subroutine MERFI found in ACM Algorithm 602, obtained from netlib. -+ * -+ * MDNRIS code is copyright 1978 by IMSL, Inc. Since MERFI has been -+ * submitted to netlib, it may be used with the restrictions that it may -+ * only be used for noncommercial purposes, and that IMSL be acknowledged -+ * as the copyright-holder of the code. -+ */ -+ -+ /* Initialized data */ -+ static T a1 = -.5751703, a2 = -1.896513, a3 = -.05496261, -+ b0 = -.113773, b1 = -3.293474, b2 = -2.374996, b3 = -1.187515, -+ c0 = -.1146666, c1 = -.1314774, c2 = -.2368201, c3 = .05073975, -+ d0 = -44.27977, d1 = 21.98546, d2 = -7.586103, -+ e0 = -.05668422, e1 = .3937021, e2 = -.3166501, e3 = .06208963, -+ f0 = -6.266786, f1 = 4.666263, f2 = -2.962883, -+ g0 = 1.851159e-4, g1 = -.002028152, g2 = -.1498384, g3 = .01078639, -+ h0 = .09952975, h1 = .5211733, h2 = -.06888301; - - /* Local variables */ - static T a, b, f, w, x, y, z, sigma, z2, sd, wi, sn; -@@ -2240,44 +2562,44 @@ - rational function in z */ - - if (z <= 0.85) -- { -- z2 = z * z; -- f = z + z * (b0 + a1 * z2 / (b1 + z2 + a2 / (b2 + z2 + a3 / (b3 + z2)))); -- } -+ { -+ z2 = z * z; -+ f = z + z * (b0 + a1 * z2 / (b1 + z2 + a2 / (b2 + z2 + a3 / (b3 + z2)))); -+ } - else /* z greater than 0.85 */ -- { -- a = 1.0 - z; -- b = z; -+ { -+ a = 1.0 - z; -+ b = z; - -- /* reduced argument is in (0.85,1.0), obtain the transformed variable */ -+ /* reduced argument is in (0.85,1.0), obtain the transformed variable */ - -- w = sqrt(-(T)log(a + a * b)); -+ w = sqrt(-(T)log(a + a * b)); - -- if (w >= 4.0) -- /* w greater than 4.0, approx. f by a rational function in 1.0 / w */ -- { -- wi = 1.0 / w; -- sn = ((g3 * wi + g2) * wi + g1) * wi; -- sd = ((wi + h2) * wi + h1) * wi + h0; -- f = w + w * (g0 + sn / sd); -- } -- else if (w < 4.0 && w > 2.5) -- /* w between 2.5 and 4.0, approx. f by a rational function in w */ -- { -- sn = ((e3 * w + e2) * w + e1) * w; -- sd = ((w + f2) * w + f1) * w + f0; -- f = w + w * (e0 + sn / sd); -+ if (w >= 4.0) -+ /* w greater than 4.0, approx. f by a rational function in 1.0 / w */ -+ { -+ wi = 1.0 / w; -+ sn = ((g3 * wi + g2) * wi + g1) * wi; -+ sd = ((wi + h2) * wi + h1) * wi + h0; -+ f = w + w * (g0 + sn / sd); -+ } -+ else if (w < 4.0 && w > 2.5) -+ /* w between 2.5 and 4.0, approx. f by a rational function in w */ -+ { -+ sn = ((e3 * w + e2) * w + e1) * w; -+ sd = ((w + f2) * w + f1) * w + f0; -+ f = w + w * (e0 + sn / sd); - -- /* w between 1.13222 and 2.5, approx. f by -- a rational function in w */ -- } -- else if (w <= 2.5 && w > 1.13222) -- { -- sn = ((c3 * w + c2) * w + c1) * w; -- sd = ((w + d2) * w + d1) * w + d0; -- f = w + w * (c0 + sn / sd); -+ /* w between 1.13222 and 2.5, approx. f by -+ a rational function in w */ -+ } -+ else if (w <= 2.5 && w > 1.13222) -+ { -+ sn = ((c3 * w + c2) * w + c1) * w; -+ sd = ((w + d2) * w + d1) * w + d0; -+ f = w + w * (c0 + sn / sd); -+ } - } -- } - y = sigma * f; - - return y; -@@ -2290,17 +2612,17 @@ - SizeT n = p0->N_Elements(); - static int doubleIx = e->KeywordIx("DOUBLE"); - if (e->KeywordSet(doubleIx) || p0->Type() == GDL_DOUBLE) -- { -- DDoubleGDL *ret = new DDoubleGDL(dimension(n)), *p0d = e->GetParAs(0); -- while (n != 0) --n, (*ret)[n] = inverf((*p0d)[n]); -- return ret; -- } -+ { -+ DDoubleGDL *ret = new DDoubleGDL(dimension(n)), *p0d = e->GetParAs(0); -+ while (n != 0) --n, (*ret)[n] = inverf((*p0d)[n]); -+ return ret; -+ } - else -- { -- DFloatGDL *ret = new DFloatGDL(dimension(n)), *p0f = e->GetParAs(0); -- while (n != 0) --n, (*ret)[n] = inverf((*p0f)[n]); -- return ret; -- } -+ { -+ DFloatGDL *ret = new DFloatGDL(dimension(n)), *p0f = e->GetParAs(0); -+ while (n != 0) --n, (*ret)[n] = inverf((*p0f)[n]); -+ return ret; -+ } - } - - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/math_fun_gm.cpp gdl/src/math_fun_gm.cpp ---- gdl-0.9.3/src/math_fun_gm.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/math_fun_gm.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -194,10 +194,11 @@ - #define isfinite _finite - #endif - --using namespace std; -- - namespace lib - { -+using namespace std; -+using std::isnan; -+ - double gm_expint(int n, double x); - double gm_lentz(double a[], double b[], double tiny, int n, double eps); - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/math_fun_jmg.cpp gdl/src/math_fun_jmg.cpp ---- gdl-0.9.3/src/math_fun_jmg.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/math_fun_jmg.cpp 2013-07-31 09:41:44.122245060 -0600 -@@ -48,10 +48,12 @@ - #define signbit(d) (d < 0.0)? 1:0 - #endif - --using namespace std; -- - namespace lib { - -+ using namespace std; -+ using std::isinf; -+ using std::isnan; -+ - BaseGDL* machar_fun( EnvT* e) - { - long int ibeta, it, irnd, ngrd, machep, negep, iexp, minexp, maxexp; -@@ -309,7 +311,7 @@ - e->NParam( 1); - - BaseGDL* p0 = e->GetParDefined( 0); -- auto_ptr guard; -+ Guard guard; - - static int nanIx = e->KeywordIx( "NAN"); - bool kwNaN = e->KeywordSet( nanIx); -@@ -348,7 +350,7 @@ - { - DFloatGDL* p0F = - static_cast(p0->Convert2(GDL_FLOAT,BaseGDL::COPY)); -- guard.reset( p0F); -+ guard.Reset( p0F); - return finite_template(p0F, kwNaN, kwInfinity); - } - case GDL_STRUCT: -@@ -396,7 +398,7 @@ - { - DFloatGDL* p0F = - static_cast(p0->Convert2(GDL_FLOAT,BaseGDL::COPY)); -- guard.reset( p0F); -+ guard.Reset( p0F); - return finite_template(p0F, kwNaN, kwInfinity, kwSign); - } - case GDL_STRUCT: -@@ -733,7 +735,45 @@ - } - } - -+// see http://www.geom.umn.edu/software/qhull/. Used also with plplot. -+#ifdef PL_HAVE_QHULL -+ void triangulate ( EnvT* e) -+ { -+ DDoubleGDL *yVal, *xVal; -+ int npts; -+ SizeT nParam=e->NParam(); -+ if( nParam < 3) -+ { -+ e->Throw("Incorrect number of arguments."); -+ } -+ yVal = e->GetParAs< DDoubleGDL > (0); -+ if (yVal->Rank() == 0) e->Throw("Expression must be an array in this context: " + e->GetParString(0)); -+ npts=yVal->N_Elements(); -+ xVal = e->GetParAs< DDoubleGDL > (1); -+ if (xVal->Rank() == 0) e->Throw("Expression must be an array in this context: " + e->GetParString(1)); -+ if (xVal->N_Elements()!=npts) e->Throw("X & Y arrays must have same number of points."); -+ e->Throw("Writing in progress."); -+ } -+ void qhull ( EnvT* e) -+ { -+ e->Throw("Writing in progress."); -+ } - -+ void grid_input (EnvT* e) -+ { -+ e->Throw("Writing in progress."); -+ } -+ -+ BaseGDL* qgrid3_fun ( EnvT* e) -+ { -+ e->Throw("Writing in progress."); -+ } -+ BaseGDL* sph_scat_fun ( EnvT* e) -+ { -+ e->Throw("Writing in progress."); -+ } -+ -+#endif - BaseGDL* trigrid_fun( EnvT* e) - { - // Compute plane parameters A,B,C given 3 points on plane. -@@ -893,10 +933,10 @@ - if(Map->N_Elements() != 4) - e->Throw("Keyword array parameter MAP" - "must have 4 elements."); -- auto_ptr guard; -+ Guard guard; - DDoubleGDL* mapD = static_cast - ( Map->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- guard.reset( mapD); -+ guard.Reset( mapD); - xvsx[0] = (*mapD)[0]; - xvsx[1] = (*mapD)[1]; - yvsy[0] = (*mapD)[2]; -@@ -1192,7 +1232,8 @@ - } - - DDouble missing=0.0; -- if( e->KeywordSet( "MISSING")) { -+ bool doMissing=( e->KeywordSet( "MISSING")); -+ if(doMissing) { - e->AssureDoubleScalarKWIfPresent( "MISSING", missing); - } - -@@ -1291,7 +1332,7 @@ - warped = image_warp(p0->Dim(1), p0->Dim(0), nRow, nCol, p0->Type(), - p0->DataAddr(), kernel_name, - lineartrans, poly_v, poly_u, -- interp, cubic, LINEAR, missing); -+ interp, cubic, LINEAR, missing, doMissing); - } - } else { - // Polynomial -@@ -1322,7 +1363,7 @@ - warped = image_warp(p0->Dim(1), p0->Dim(0), nRow, nCol, p0->Type(), - p0->DataAddr(), kernel_name, - lineartrans, poly_v, poly_u, -- interp, cubic, GENERIC, missing); -+ interp, cubic, GENERIC, missing, doMissing); - - if (poly_u->px != NULL) free(poly_u->px); - if (poly_u->py != NULL) free(poly_u->py); -@@ -1577,266 +1618,320 @@ - */ - /*--------------------------------------------------------------------------*/ - --image_t * image_warp ( -- SizeT lx, -- SizeT ly, -- SizeT lx_out, -- SizeT ly_out, -- DType type, -- void* data, -- char * kernel_type, -- DDouble *param, -- poly2d * poly_u, -- poly2d * poly_v, -- DLong interp, -- DDouble cubic, -- DLong warpType, -- DDouble initvalue) --{ -- image_t * image_out ; -- int i, j, k ; -- double cur ; -- double neighbors[16] ; -- double rsc[8], -- sumrs ; -- double x, y ; -- int px, py ; -- int pos ; -- int tabx, taby ; -- double * kernel=NULL ; -- int leaps[16] ; -+ image_t * image_warp( -+ SizeT lx, -+ SizeT ly, -+ SizeT lx_out, -+ SizeT ly_out, -+ DType type, -+ void* data, -+ char * kernel_type, -+ DDouble *param, -+ poly2d * poly_u, -+ poly2d * poly_v, -+ DLong interp, -+ DDouble cubic, -+ DLong warpType, -+ DDouble initvalue, -+ bool doMissing) { -+ image_t * image_out; -+ int i, j, k; -+ double cur; -+ double neighbors[16]; -+ double rsc[8], -+ sumrs; -+ double x, y; -+ int px, py; -+ int pos; -+ int tabx, taby; -+ double * kernel = NULL; -+ int leaps[16]; - - DByte data_b; - DInt data_i; -- DUInt data_ui; -+ DUInt data_ui; - DLong data_l; -- DULong data_ul; -+ DULong data_ul; - DLong64 data_l64; -- DULong64 data_ul64; -+ DULong64 data_ul64; - float data_f; - double data_d; - char *ptr = (char *) data; - - /* Generate linear interpolation kernel if necessary */ - if (interp == 1) { -- kernel = generate_interpolation_kernel(kernel_type, (double) 0.0) ; -+ kernel = generate_interpolation_kernel(kernel_type, (double) 0.0); - if (kernel == NULL) { -- // e_error("cannot generate kernel: aborting resampling") ; -- return NULL ; -+ // e_error("cannot generate kernel: aborting resampling") ; -+ return NULL; - } - } - - /* Generate cubic interpolation kernel if necessary */ - if (interp == 2) { -- kernel = generate_interpolation_kernel(kernel_type, cubic) ; -+ kernel = generate_interpolation_kernel(kernel_type, cubic); - if (kernel == NULL) { -- // e_error("cannot generate kernel: aborting resampling") ; -- return NULL ; -+ // e_error("cannot generate kernel: aborting resampling") ; -+ return NULL; - } - } - -- image_out = image_new(lx_out, ly_out, initvalue) ; -+ image_out = image_new(lx_out, ly_out, initvalue); - - /* Pre compute leaps for 16 closest neighbors positions */ - -- leaps[0] = -1 - lx ; -- leaps[1] = - lx ; -- leaps[2] = 1 - lx ; -- leaps[3] = 2 - lx ; -- -- leaps[4] = -1 ; -- leaps[5] = 0 ; -- leaps[6] = 1 ; -- leaps[7] = 2 ; -- -- leaps[8] = -1 + lx ; -- leaps[9] = lx ; -- leaps[10]= 1 + lx ; -- leaps[11]= 2 + lx ; -- -- leaps[12]= -1 + 2*lx ; -- leaps[13]= 2*lx ; -- leaps[14]= 1 + 2*lx ; -- leaps[15]= 2 + 2*lx ; -+ leaps[0] = -1 - lx; -+ leaps[1] = -lx; -+ leaps[2] = 1 - lx; -+ leaps[3] = 2 - lx; -+ -+ leaps[4] = -1; -+ leaps[5] = 0; -+ leaps[6] = 1; -+ leaps[7] = 2; -+ -+ leaps[8] = -1 + lx; -+ leaps[9] = lx; -+ leaps[10] = 1 + lx; -+ leaps[11] = 2 + lx; -+ -+ leaps[12] = -1 + 2 * lx; -+ leaps[13] = 2 * lx; -+ leaps[14] = 1 + 2 * lx; -+ leaps[15] = 2 + 2 * lx; - -- for (k=0 ; k<16 ; k++) neighbors[k] = 0; -+ for (k = 0; k < 16; k++) neighbors[k] = 0; - - /* Double loop on the output image */ -- for (j=0 ; j < ly_out ; j++) { -- for (i=0 ; i< lx_out ; i++) { -- /* Compute the original source for this pixel */ -- -- if (warpType == LINEAR) { -- x = param[0] * (double)i + param[1] * (double)j + param[2]; -- y = param[3] * (double)i + param[4] * (double)j + param[5]; -- } else { -- x = poly2d_compute(poly_u, (double)i, (double)j); -- y = poly2d_compute(poly_v, (double)i, (double)j); -- } -+ for (j = 0; j < ly_out; j++) { -+ for (i = 0; i < lx_out; i++) { -+ /* Compute the original source for this pixel */ -+ -+ if (warpType == LINEAR) { -+ x = param[0] * (double) i + param[1] * (double) j + param[2]; -+ y = param[3] * (double) i + param[4] * (double) j + param[5]; -+ } else { -+ x = poly2d_compute(poly_u, (double) i, (double) j); -+ y = poly2d_compute(poly_v, (double) i, (double) j); -+ } - -- /* Which is the closest integer positioned neighbor? */ -- px = (int)x ; -- py = (int)y ; -- -- if ((px < 1) || -- (px > (lx-1)) || -- (py < 1) || -- (py > (ly-1))) -- { -- //already initialised to 'missing' value. No need to put zero here. -- // image_out->data[i+j*lx_out] = (pixelvalue)0.0 ; -+ /* Which is the closest integer positioned neighbor? */ -+ px = (int) x; -+ py = (int) y; -+ -+ if (doMissing) { -+ if ((px < 1) || -+ (px > (lx - 1)) || -+ (py < 1) || -+ (py > (ly - 1))) { -+ continue; // already initialised to 'missing' value. No need to put zero here. -+ } -+ } -+ if ((px < 1) || (px > (lx - 1)) || (py < 1) || (py > (ly - 1))) { -+ if (px < 1) px = 0; -+ if (px > (lx - 1)) px = (lx - 1); -+ if (py < 1) py = 0; -+ if (py > (ly - 1)) py = (ly - 1); -+ pos = px + py * lx; -+ int row = (pos) / lx; -+ int col = (pos) - row*lx; -+ if (type == GDL_BYTE) { -+ memcpy(&data_b, &ptr[sizeof (char)*(col * ly + row)], -+ sizeof (char)); -+ neighbors[5] = (double) data_b; -+ } -+ if (type == GDL_INT) { -+ memcpy(&data_i, &ptr[sizeof (DInt)*(col * ly + row)], -+ sizeof (DInt)); -+ neighbors[5] = (double) data_i; -+ } -+ if (type == GDL_UINT) { -+ memcpy(&data_ui, &ptr[sizeof (DUInt)*(col * ly + row)], -+ sizeof (DUInt)); -+ neighbors[5] = (double) data_ui; -+ } -+ if (type == GDL_LONG) { -+ memcpy(&data_l, &ptr[sizeof (DLong)*(col * ly + row)], -+ sizeof (DLong)); -+ neighbors[5] = (double) data_l; -+ } -+ if (type == GDL_ULONG) { -+ memcpy(&data_ul, &ptr[sizeof (DULong)*(col * ly + row)], -+ sizeof (DULong)); -+ neighbors[5] = (double) data_ul; -+ } -+ if (type == GDL_LONG64) { -+ memcpy(&data_l64, &ptr[sizeof (DLong64)*(col * ly + row)], -+ sizeof (DLong64)); -+ neighbors[5] = (double) data_l64; -+ } -+ if (type == GDL_ULONG64) { -+ memcpy(&data_ul64, &ptr[sizeof (DULong64)*(col * ly + row)], -+ sizeof (DULong64)); -+ neighbors[5] = (double) data_ul64; -+ } -+ if (type == GDL_FLOAT) { -+ memcpy(&data_f, &ptr[sizeof (float)*(col * ly + row)], -+ sizeof (float)); -+ neighbors[5] = (double) data_f; -+ } -+ if (type == GDL_DOUBLE) { -+ memcpy(&data_d, &ptr[sizeof (double)*(col * ly + row)], -+ sizeof (double)); -+ neighbors[5] = data_d; -+ } -+ image_out->data[i + j * lx_out] = (pixelvalue) neighbors[5]; -+ } else { -+ /* Now feed the positions for the closest 16 neighbors */ -+ pos = px + py * lx; -+ for (k = 0; k < 16; k++) { -+ -+ if (interp == 0 && k != 5) continue; -+ -+ int row = (pos + leaps[k]) / lx; -+ int col = (pos + leaps[k]) - row*lx; -+ if (type == GDL_BYTE) { -+ memcpy(&data_b, &ptr[sizeof (char)*(col * ly + row)], -+ sizeof (char)); -+ neighbors[k] = (double) data_b; -+ } -+ if (type == GDL_INT) { -+ memcpy(&data_i, &ptr[sizeof (DInt)*(col * ly + row)], -+ sizeof (DInt)); -+ neighbors[k] = (double) data_i; -+ } -+ if (type == GDL_UINT) { -+ memcpy(&data_ui, &ptr[sizeof (DUInt)*(col * ly + row)], -+ sizeof (DUInt)); -+ neighbors[k] = (double) data_ui; -+ } -+ if (type == GDL_LONG) { -+ memcpy(&data_l, &ptr[sizeof (DLong)*(col * ly + row)], -+ sizeof (DLong)); -+ neighbors[k] = (double) data_l; -+ } -+ if (type == GDL_ULONG) { -+ memcpy(&data_ul, &ptr[sizeof (DULong)*(col * ly + row)], -+ sizeof (DULong)); -+ neighbors[k] = (double) data_ul; -+ } -+ if (type == GDL_LONG64) { -+ memcpy(&data_l64, &ptr[sizeof (DLong64)*(col * ly + row)], -+ sizeof (DLong64)); -+ neighbors[k] = (double) data_l64; -+ } -+ if (type == GDL_ULONG64) { -+ memcpy(&data_ul64, &ptr[sizeof (DULong64)*(col * ly + row)], -+ sizeof (DULong64)); -+ neighbors[k] = (double) data_ul64; -+ } -+ if (type == GDL_FLOAT) { -+ memcpy(&data_f, &ptr[sizeof (float)*(col * ly + row)], -+ sizeof (float)); -+ neighbors[k] = (double) data_f; -+ } -+ if (type == GDL_DOUBLE) { -+ memcpy(&data_d, &ptr[sizeof (double)*(col * ly + row)], -+ sizeof (double)); -+ neighbors[k] = data_d; -+ } - } -- else { -- /* Now feed the positions for the closest 16 neighbors */ -- pos = px + py * lx ; -- for (k=0 ; k<16 ; k++) { -- -- if (interp == 0 && k != 5) continue; -- -- int row = (pos+leaps[k]) / lx; -- int col = (pos+leaps[k]) - row*lx; -- if (type == GDL_BYTE) { -- memcpy(&data_b, &ptr[sizeof(char)*(col*ly+row)], -- sizeof(char)); -- neighbors[k] = (double) data_b; -- } -- if (type == GDL_INT) { -- memcpy(&data_i, &ptr[sizeof(DInt)*(col*ly+row)], -- sizeof(DInt)); -- neighbors[k] = (double) data_i; -- } -- if (type == GDL_UINT) { -- memcpy(&data_ui, &ptr[sizeof(DUInt)*(col*ly+row)], -- sizeof(DUInt)); -- neighbors[k] = (double) data_ui; -- } -- if (type == GDL_LONG) { -- memcpy(&data_l, &ptr[sizeof(DLong)*(col*ly+row)], -- sizeof(DLong)); -- neighbors[k] = (double) data_l; -- } -- if (type == GDL_ULONG) { -- memcpy(&data_ul, &ptr[sizeof(DULong)*(col*ly+row)], -- sizeof(DULong)); -- neighbors[k] = (double) data_ul; -- } -- if (type == GDL_LONG64) { -- memcpy(&data_l64, &ptr[sizeof(DLong64)*(col*ly+row)], -- sizeof(DLong64)); -- neighbors[k] = (double) data_l64; -- } -- if (type == GDL_ULONG64) { -- memcpy(&data_ul64, &ptr[sizeof(DULong64)*(col*ly+row)], -- sizeof(DULong64)); -- neighbors[k] = (double) data_ul64; -- } -- if (type == GDL_FLOAT) { -- memcpy(&data_f, &ptr[sizeof(float)*(col*ly+row)], -- sizeof(float)); -- neighbors[k] = (double) data_f; -- } -- if (type == GDL_DOUBLE) { -- memcpy(&data_d, &ptr[sizeof(double)*(col*ly+row)], -- sizeof(double)); -- neighbors[k] = data_d; -- } -- } - -- if (interp == 0) { -- image_out->data[i+j*lx_out] = (pixelvalue) neighbors[5]; -- } else if (interp == 1) { -- /* Which tabulated value index shall we use? */ -- tabx = (int)((x - (double)px) * (double)(TABSPERPIX)) ; -- taby = (int)((y - (double)py) * (double)(TABSPERPIX)) ; -- -- /* Compute resampling coefficients */ -- /* rsc[0..3] in x, rsc[4..7] in y */ -- -- rsc[0] = kernel[TABSPERPIX + tabx] ; -- rsc[1] = kernel[tabx] ; -- rsc[2] = kernel[TABSPERPIX - tabx] ; -- rsc[4] = kernel[TABSPERPIX + taby] ; -- rsc[5] = kernel[taby] ; -- rsc[6] = kernel[TABSPERPIX - taby] ; -- -- sumrs = (rsc[0]+rsc[1]+rsc[2]) * -- (rsc[4]+rsc[5]+rsc[6]) ; -- -- /* Compute interpolated pixel now */ -- if ((x - (double)px) < 0 && (y - (double)py) < 0) { -- cur = rsc[4] * ( rsc[0]*neighbors[0] + -- rsc[1]*neighbors[1] ) + -- rsc[5] * ( rsc[0]*neighbors[4] + -- rsc[1]*neighbors[5]); -- } else if ((x - (double)px) >= 0 && (y - (double)py) < 0) { -- cur = rsc[4] * ( rsc[1]*neighbors[1] + -- rsc[2]*neighbors[2] ) + -- rsc[5] * ( rsc[1]*neighbors[5] + -- rsc[2]*neighbors[6]); -- } else if ((x - (double)px) < 0 && (y - (double)py) >= 0) { -- cur = rsc[5] * ( rsc[0]*neighbors[4] + -- rsc[1]*neighbors[5] ) + -- rsc[6] * ( rsc[0]*neighbors[8] + -- rsc[1]*neighbors[9]); -- } else if ((x - (double)px) >= 0 && (y - (double)py) >= 0) { -- cur = rsc[5] * ( rsc[1]*neighbors[5] + -- rsc[2]*neighbors[6] ) + -- rsc[6] * ( rsc[1]*neighbors[9] + -- rsc[2]*neighbors[10]); -- } -- -- /* Affect the value to the output image */ -- image_out->data[i+j*lx_out] = (pixelvalue)(cur/sumrs) ; -- /* done ! */ -- } else { -- /* Which tabulated value index shall we use? */ -- tabx = (int)((x - (double)px) * (double)(TABSPERPIX)) ; -- taby = (int)((y - (double)py) * (double)(TABSPERPIX)) ; -- -- /* Compute resampling coefficients */ -- /* rsc[0..3] in x, rsc[4..7] in y */ -- -- rsc[0] = kernel[TABSPERPIX + tabx] ; -- rsc[1] = kernel[tabx] ; -- rsc[2] = kernel[TABSPERPIX - tabx] ; -- rsc[3] = kernel[2 * TABSPERPIX - tabx] ; -- rsc[4] = kernel[TABSPERPIX + taby] ; -- rsc[5] = kernel[taby] ; -- rsc[6] = kernel[TABSPERPIX - taby] ; -- rsc[7] = kernel[2 * TABSPERPIX - taby] ; -- -- sumrs = (rsc[0]+rsc[1]+rsc[2]+rsc[3]) * -- (rsc[4]+rsc[5]+rsc[6]+rsc[7]) ; -- -- /* Compute interpolated pixel now */ -- cur = rsc[4] * ( rsc[0]*neighbors[0] + -- rsc[1]*neighbors[1] + -- rsc[2]*neighbors[2] + -- rsc[3]*neighbors[3] ) + -- rsc[5] * ( rsc[0]*neighbors[4] + -- rsc[1]*neighbors[5] + -- rsc[2]*neighbors[6] + -- rsc[3]*neighbors[7] ) + -- rsc[6] * ( rsc[0]*neighbors[8] + -- rsc[1]*neighbors[9] + -- rsc[2]*neighbors[10] + -- rsc[3]*neighbors[11] ) + -- rsc[7] * ( rsc[0]*neighbors[12] + -- rsc[1]*neighbors[13] + -- rsc[2]*neighbors[14] + -- rsc[3]*neighbors[15] ) ; -- -- /* Affect the value to the output image */ -- image_out->data[i+j*lx_out] = (pixelvalue)(cur/sumrs) ; -- /* done ! */ -- } -- } -+ if (interp == 0) { -+ image_out->data[i + j * lx_out] = (pixelvalue) neighbors[5]; -+ } else if (interp == 1) { -+ /* Which tabulated value index shall we use? */ -+ tabx = (int) ((x - (double) px) * (double) (TABSPERPIX)); -+ taby = (int) ((y - (double) py) * (double) (TABSPERPIX)); -+ -+ /* Compute resampling coefficients */ -+ /* rsc[0..3] in x, rsc[4..7] in y */ -+ -+ rsc[0] = kernel[TABSPERPIX + tabx]; -+ rsc[1] = kernel[tabx]; -+ rsc[2] = kernel[TABSPERPIX - tabx]; -+ rsc[4] = kernel[TABSPERPIX + taby]; -+ rsc[5] = kernel[taby]; -+ rsc[6] = kernel[TABSPERPIX - taby]; -+ -+ sumrs = (rsc[0] + rsc[1] + rsc[2]) * -+ (rsc[4] + rsc[5] + rsc[6]); -+ -+ /* Compute interpolated pixel now */ -+ if ((x - (double) px) < 0 && (y - (double) py) < 0) { -+ cur = rsc[4] * (rsc[0] * neighbors[0] + -+ rsc[1] * neighbors[1]) + -+ rsc[5] * (rsc[0] * neighbors[4] + -+ rsc[1] * neighbors[5]); -+ } else if ((x - (double) px) >= 0 && (y - (double) py) < 0) { -+ cur = rsc[4] * (rsc[1] * neighbors[1] + -+ rsc[2] * neighbors[2]) + -+ rsc[5] * (rsc[1] * neighbors[5] + -+ rsc[2] * neighbors[6]); -+ } else if ((x - (double) px) < 0 && (y - (double) py) >= 0) { -+ cur = rsc[5] * (rsc[0] * neighbors[4] + -+ rsc[1] * neighbors[5]) + -+ rsc[6] * (rsc[0] * neighbors[8] + -+ rsc[1] * neighbors[9]); -+ } else if ((x - (double) px) >= 0 && (y - (double) py) >= 0) { -+ cur = rsc[5] * (rsc[1] * neighbors[5] + -+ rsc[2] * neighbors[6]) + -+ rsc[6] * (rsc[1] * neighbors[9] + -+ rsc[2] * neighbors[10]); -+ } -+ -+ /* Affect the value to the output image */ -+ image_out->data[i + j * lx_out] = (pixelvalue) (cur / sumrs); -+ /* done ! */ -+ } else { -+ /* Which tabulated value index shall we use? */ -+ tabx = (int) ((x - (double) px) * (double) (TABSPERPIX)); -+ taby = (int) ((y - (double) py) * (double) (TABSPERPIX)); -+ -+ /* Compute resampling coefficients */ -+ /* rsc[0..3] in x, rsc[4..7] in y */ -+ -+ rsc[0] = kernel[TABSPERPIX + tabx]; -+ rsc[1] = kernel[tabx]; -+ rsc[2] = kernel[TABSPERPIX - tabx]; -+ rsc[3] = kernel[2 * TABSPERPIX - tabx]; -+ rsc[4] = kernel[TABSPERPIX + taby]; -+ rsc[5] = kernel[taby]; -+ rsc[6] = kernel[TABSPERPIX - taby]; -+ rsc[7] = kernel[2 * TABSPERPIX - taby]; -+ -+ sumrs = (rsc[0] + rsc[1] + rsc[2] + rsc[3]) * -+ (rsc[4] + rsc[5] + rsc[6] + rsc[7]); -+ -+ /* Compute interpolated pixel now */ -+ cur = rsc[4] * (rsc[0] * neighbors[0] + -+ rsc[1] * neighbors[1] + -+ rsc[2] * neighbors[2] + -+ rsc[3] * neighbors[3]) + -+ rsc[5] * (rsc[0] * neighbors[4] + -+ rsc[1] * neighbors[5] + -+ rsc[2] * neighbors[6] + -+ rsc[3] * neighbors[7]) + -+ rsc[6] * (rsc[0] * neighbors[8] + -+ rsc[1] * neighbors[9] + -+ rsc[2] * neighbors[10] + -+ rsc[3] * neighbors[11]) + -+ rsc[7] * (rsc[0] * neighbors[12] + -+ rsc[1] * neighbors[13] + -+ rsc[2] * neighbors[14] + -+ rsc[3] * neighbors[15]); -+ -+ /* Affect the value to the output image */ -+ image_out->data[i + j * lx_out] = (pixelvalue) (cur / sumrs); -+ /* done ! */ -+ } - } -+ } - } - -- if (kernel != NULL) free(kernel) ; -- return image_out ; --} -+ if (kernel != NULL) free(kernel); -+ return image_out; -+ } - - - /*-------------------------------------------------------------------------*/ -@@ -1911,7 +2006,7 @@ - treeParser.interactive(theAST); - trAST = treeParser.getAST(); - ProgNodeP progAST = ProgNode::NewProgNode( trAST); -- auto_ptr< ProgNode> progAST_guard( progAST); -+ Guard< ProgNode> progAST_guard( progAST); - - // Marc: necessary for correct FOR loop handling - assert( dynamic_cast(caller) != NULL); -@@ -1963,7 +2058,7 @@ - - - // Check if GDL-code derivative function exist -- deque fList; -+ vector fList; - bool found = false; - for( FunListT::iterator i=funList.begin(); i != funList.end(); i++) { - fList.push_back((*i)->ObjectName()); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/math_fun_jmg.hpp gdl/src/math_fun_jmg.hpp ---- gdl-0.9.3/src/math_fun_jmg.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/math_fun_jmg.hpp 2013-06-03 14:22:52.000000000 -0600 -@@ -56,6 +56,13 @@ - BaseGDL* finite_fun( EnvT* e); - BaseGDL* check_math_fun( EnvT* e); - BaseGDL* radon_fun( EnvT* e); -+#ifdef PL_HAVE_QHULL -+ void triangulate( EnvT* e); -+ void qhull ( EnvT* e); -+ void grid_input (EnvT* e); -+ BaseGDL* qgrid3_fun ( EnvT* e); -+ BaseGDL* sph_scat_fun ( EnvT* e); -+#endif - BaseGDL* trigrid_fun( EnvT* e); - BaseGDL* poly_2d_fun( EnvT* e); - BaseGDL* rk4jmg_fun( EnvT* e); -@@ -68,7 +75,8 @@ - image_t * image_warp(SizeT, SizeT, SizeT, SizeT, DType, void*, - char *kernel_type, - DDouble *param, poly2d *poly_u, poly2d *poly_v, -- DLong interp, DDouble cubic, DLong warpType, DDouble initvalue); -+ DLong interp, DDouble cubic, DLong warpType, DDouble initvalue, -+ bool doMissing); - - image_t * image_new(int size_x, int size_y, DDouble initvalue); - void image_del(image_t *d); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/math_utl.hpp gdl/src/math_utl.hpp ---- gdl-0.9.3/src/math_utl.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/math_utl.hpp 2013-03-21 14:04:04.000000000 -0600 -@@ -73,6 +73,12 @@ - #define COMPLEX2 GDL_COMPLEX - #endif - -+#ifdef _MSC_VER -+# define isinf !_finite -+# define isfinite _finite -+# define isnan _isnan -+#endif -+ - } // namespace - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/matrix_cholesky.cpp gdl/src/matrix_cholesky.cpp ---- gdl-0.9.3/src/matrix_cholesky.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/matrix_cholesky.cpp 2013-07-31 09:17:01.000000000 -0600 -@@ -0,0 +1,791 @@ -+/*************************************************************************** -+ gsl_fun.cpp - GDL GSL library function -+ ------------------- -+ begin : Jan 20 2004 -+ copyright : (C) 2004 by Joel Gales -+ email : jomoga@users.sourceforge.net -+***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#include "includefirst.hpp" -+ -+#include -+#include -+#include -+#include -+//#include -+#include -+#include -+ -+#include "datatypes.hpp" -+#include "envt.hpp" -+#include "basic_fun.hpp" -+#include "dinterpreter.hpp" -+ -+#include "gsl_fun.hpp" -+ -+#if defined(USE_EIGEN) -+#include -+#include -+#include -+#endif -+ -+namespace lib { -+ -+ using namespace std; -+ using std::isnan; -+ -+ //const int szdbl=sizeof(double); -+ //const int szflt=sizeof(float); -+ -+#if defined(USE_EIGEN) -+ using namespace Eigen; -+ -+ -+/*********************************************************** -+********************LA_Cholesky_Solution*********************** -+************************************************************/ -+ BaseGDL* la_cholsol_fun ( EnvT* e) -+ { -+ // set_num_threads(); -+ -+ SizeT nParam=e->NParam(2); -+ BaseGDL* p0 = e->GetParDefined( 0); -+ BaseGDL* p1 = e->GetParDefined( 1); -+ -+/*********************************Checking_if_arguments_are_OK*********************/ -+ -+ if (p0->N_Elements()==0) -+ e->Throw( "Variable A is undefined: " + e->GetParString(0)); -+ if (p1->N_Elements()==0) -+ e->Throw( "Variable B is undefined: " + e->GetParString(1)); -+ if (p0->Rank() == 2){ -+ if (p0->Dim(0) != p0->Dim(1)) -+ e->Throw( "Argument A must be a square matrix:" + e->GetParString(0)); -+ } -+ else -+ e->Throw( "Argument A must be a square matrix:" + e->GetParString(0)); -+ if(p1->Rank()==1){ -+ if(p1->N_Elements()!=p0->Dim(0)) -+ e->Throw("Arguments sizes mismatch"); -+ } -+ else if(p1->Rank()==2){ -+ if(p1->Dim(1)!=p0->Dim(0)) -+ e->Throw("Arguments sizes mismatch"); -+ } -+ else -+ e->Throw( "Argument B must be a vector or a matrix:" + e->GetParString(0)); -+ -+ long NbCol,NbRow; -+ -+/*************************Double**************************************/ -+ if(( p0->Type() == GDL_DOUBLE) || e->KeywordSet("DOUBLE")) -+ { -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ DDoubleGDL* p2D = static_cast -+ (p1->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map > m0(&(*p0D)[0], NbCol,NbRow); -+ Map m2(&(*p2D)[0], NbCol); -+ -+ LLTsolver; -+ VectorXd tmp_res = solver.compute(m0).solve(m2); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return 0; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return 0; -+ } -+ -+ DDoubleGDL* res =new DDoubleGDL(NbCol, BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.cast(); -+ -+ return res; -+ -+ } -+ -+ -+ return p0; -+ } -+ -+ -+ -+ -+ -+/*********************************************************** -+********************Cholesky_Solution*********************** -+************************************************************/ -+ -+ BaseGDL* cholsol_fun ( EnvT* e) -+ { -+ -+ // set_num_threads(); -+ -+ SizeT nParam=e->NParam(3); -+ BaseGDL* p0 = e->GetParDefined( 0); -+ BaseGDL* p1 = e->GetParDefined( 1); -+ BaseGDL* p2 = e->GetParDefined( 2); -+ -+/*********************************Checking_if_arguments_are_OK*********************/ -+ -+ if (p0->N_Elements()==0) -+ e->Throw( "Variable A is undefined: " + e->GetParString(0)); -+ if (p1->N_Elements()==0) -+ e->Throw( "Variable P is undefined: " + e->GetParString(1)); -+ if (p2->N_Elements()==0) -+ e->Throw( "Variable B is undefined: " + e->GetParString(2)); -+ -+ if (p0->Rank() == 2) { -+ if (p0->Dim(0) != p0->Dim(1)) -+ e->Throw( "Argument A must be a square matrix:" + e->GetParString(0)); -+ } -+ else -+ e->Throw( "Argument A must be a square matrix:" + e->GetParString(0)); -+ if (p1->Rank() != 1 ) -+ e->Throw( "Argument P must be a column vector: " + e->GetParString(1)); -+ if (p2->Rank() != 1 ) -+ e->Throw( "Argument B must be a column vector: " + e->GetParString(1)); -+// else -+// if (p2->N_Elements()<2) -+ -+ if( p2->N_Elements()!=p1->N_Elements() || p1->N_Elements()!=p0->Dim(0) || p2->N_Elements()!=p0->Dim(0) ) -+ e->Throw("Arguments sizes mismatch"); -+ -+ long NbCol,NbRow; -+ -+ -+/*************************Double**************************************/ -+ if(( p0->Type() == GDL_DOUBLE) || e->KeywordSet("DOUBLE")) -+ { -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ DDoubleGDL* p2D = static_cast -+ (p2->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map > m0(&(*p0D)[0], NbCol,NbRow); -+ Map m2(&(*p2D)[0], NbCol); -+ -+ LLTsolver; -+ VectorXd tmp_res = solver.compute(m0).solve(m2); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return 0; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return 0; -+ } -+ -+ DDoubleGDL* res =new DDoubleGDL(NbCol, BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.cast(); -+ -+ return res; -+ -+ } -+ -+/*************************Complex**************************************/ -+ if( p0->Type() == GDL_COMPLEX && !e->KeywordSet("DOUBLE")) -+ { -+ -+ DComplexGDL* p0C = static_cast -+ (p0->Convert2(GDL_COMPLEX , BaseGDL::COPY)); -+ DComplexGDL* p2C = static_cast -+ (p2->Convert2(GDL_COMPLEX , BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map,Dynamic,Dynamic,RowMajor> > m0(&(*p0C)[0], NbCol,NbRow); -+ Map m2(&(*p2C)[0], NbCol); -+ LLTsolver; -+ MatrixXf tmp_res = solver.compute(m0.real()).solve(m2.real()); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return 0; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return 0; -+ } -+ -+ DFloatGDL* res = new DFloatGDL(NbCol, BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.cast(); -+ -+ return res; -+ } -+ -+/*************************Complex_Double**************************************/ -+ else if( p0->Type() == GDL_COMPLEXDBL) { -+ -+ DComplexDblGDL* p0C = static_cast -+ (p0->Convert2(GDL_COMPLEXDBL , BaseGDL::COPY)); -+ DComplexDblGDL* p2C = static_cast -+ (p2->Convert2(GDL_COMPLEXDBL , BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map,Dynamic,Dynamic,RowMajor> > m0(&(*p0C)[0], NbCol,NbRow); -+ Map m2(&(*p2C)[0], NbCol); -+ LLTsolver; -+ MatrixXd tmp_res = solver.compute(m0.real()).solve(m2.real()); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return 0; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return 0; -+ } -+ -+ DDoubleGDL* res = new DDoubleGDL(NbCol, BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.cast(); -+ -+ return res; -+ } -+ -+/*************************All_Other**************************************/ -+ if( p0->Type() == GDL_FLOAT || -+ p0->Type() == GDL_LONG || -+ p0->Type() == GDL_ULONG || -+ p0->Type() == GDL_LONG64 || -+ p0->Type() == GDL_ULONG64 || -+ p0->Type() == GDL_INT || -+ p0->Type() == GDL_STRING || -+ p0->Type() == GDL_UINT || -+ p0->Type() == GDL_BYTE) -+ { -+ DFloatGDL* p0SS = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ DFloatGDL* p2SS = static_cast -+ (p2->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map > m0(&(*p0SS)[0], NbCol,NbRow); -+ Map m2(&(*p2SS)[0], NbCol); -+ -+ LLTsolver; -+ VectorXf tmp_res = solver.compute(m0).solve(m2); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return 0; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return 0; -+ } -+ -+ DFloatGDL* res =new DFloatGDL(NbCol, BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.cast(); -+ -+ return res; -+ } -+//****************************Bug************************** -+ else -+ { -+ cout << "Should never reach this point ! Please report it !" << endl; -+ DFloatGDL* res = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ return res; -+ } -+ -+ } -+ -+ -+ -+/*********************************************************** -+********************error_checker_LA_CHOLDC***************** -+************************************************************/ -+ -+ bool error_check(EnvT* e,int status) -+ { -+ static int statusIx = e->KeywordIx("STATUS"); -+ bool statusKeyword = e->KeywordPresent( statusIx ); -+ if ( statusKeyword ) e->AssureGlobalKW( statusIx ); -+ -+ if(status==NumericalIssue) -+ { -+ if(statusKeyword) -+ { -+ e->SetKW(statusIx,new DLongGDL(1)); -+ return 0; -+ } -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return 0; -+ } -+ if(status!=Success) -+ { -+ e->SetKW(statusIx,new DLongGDL(2)); -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return 0; -+ } -+ if(statusKeyword) -+ e->SetKW(statusIx,new DLongGDL(0)); -+ -+ return 1; -+ } -+ -+ -+/*********************************************************** -+********************LA_CHOLDC-procedure********************* -+************************************************************/ -+void la_choldc_pro( EnvT* e) -+ { -+ SizeT nParam = e->NParam(1); -+ BaseGDL* p0 = e->GetParDefined( 0); -+ SizeT nEl = p0->N_Elements(); -+ -+ if( nEl == 0) -+ e->Throw( "Variable is undefined: " + e->GetParString(0)); -+ -+ if (p0->Rank() > 2) -+ e->Throw( "Input must be a square matrix:" + e->GetParString(0)); -+ -+ if (p0->Rank() > 1) { -+ if (p0->Dim(0) != p0->Dim(1)) -+ e->Throw( "Input must be a square matrix:" + e->GetParString(0)); -+ } -+ -+ if (p0->Rank() < 2) -+ e->Throw( "Input must be a square matrix:" + e->GetParString(0)); -+ -+ -+ long NbCol,NbRow; -+ -+/*************************Complex_Double**************************************/ -+ if( p0->Type() == GDL_COMPLEXDBL || (p0->Type() == GDL_COMPLEX && e->KeywordSet("DOUBLE"))) { -+ -+ DComplexDblGDL* p0C = static_cast -+ (p0->Convert2(GDL_COMPLEXDBL , BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map,Dynamic,Dynamic> > m0(&(*p0C)[0], NbCol,NbRow); -+ MatrixXcd tmp_res; -+ -+ if(e->KeywordSet("UPPER")) -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if ( !error_check(e,solver.info()) ) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ } -+ else -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if ( !error_check(e,solver.info()) ) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ } -+ -+ // DComplexDblGDL* res2 = new DComplexDblGDL(p0->Dim(), BaseGDL::NOZERO); -+ Map(&(*p0C)[0], NbCol, NbRow) = tmp_res.transpose().cast >(); -+ -+ e->SetPar(0,p0C); -+ return ; -+ } -+ -+ -+/*************************Complex**************************************/ -+ else if( p0->Type() == GDL_COMPLEX) { -+ -+ DComplexGDL* p0C = static_cast -+ (p0->Convert2(GDL_COMPLEX , BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map,Dynamic,Dynamic> > m0(&(*p0C)[0], NbCol,NbRow); -+ MatrixXcf tmp_res; -+ -+ if(e->KeywordSet("UPPER")) -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if( !error_check(e,solver.info())) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ } -+ else -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if( !error_check(e,solver.info())) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ } -+ -+ // DComplexGDL* res2 = new DComplexGDL(p0->Dim(), BaseGDL::NOZERO); -+ Map(&(*p0C)[0], NbCol, NbRow) = tmp_res.transpose().cast >(); -+ -+ e->SetPar(0,p0C); -+ return ; -+ } -+ -+/*************************Double**************************************/ -+ else if(( p0->Type() == GDL_DOUBLE) || e->KeywordSet("DOUBLE")) { -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map > m0(&(*p0D)[0], NbCol,NbRow); -+ MatrixXd tmp_res; -+ -+ if(e->KeywordSet("UPPER")) -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if( !error_check(e,solver.info())) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ } -+ else -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if( !error_check(e,solver.info())) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ } -+ -+ Map >(&(*p0D)[0], NbCol, NbRow) = tmp_res.cast(); -+ -+ e->SetPar(0,p0D); -+ return ; -+ } -+ -+/*************************All_Other**************************************/ -+ else if( p0->Type() == GDL_FLOAT || -+ p0->Type() == GDL_LONG || -+ p0->Type() == GDL_ULONG || -+ p0->Type() == GDL_LONG64 || -+ p0->Type() == GDL_ULONG64 || -+ p0->Type() == GDL_INT || -+ p0->Type() == GDL_STRING || -+ p0->Type() == GDL_UINT || -+ p0->Type() == GDL_BYTE) -+ { -+ DFloatGDL* p0SS = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map > m0(&(*p0SS)[0], NbCol,NbRow); -+ MatrixXf tmp_res; -+ -+ if(e->KeywordSet("UPPER")) -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if( !error_check(e,solver.info())) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ } -+ else -+ { -+ LLTsolver; -+ solver.compute(m0); -+ -+ if( !error_check(e,solver.info())) -+ return ; -+ -+ tmp_res=solver.matrixLLT(); -+ -+ } -+ -+ Map(&(*p0SS)[0], NbCol, NbRow) = tmp_res.transpose().cast(); -+ e->SetPar(0,p0SS); -+ return ; -+ } -+//****************************Bug************************** -+ else -+ { -+ cout << "Should never reach this point ! Please report it !" << endl; -+ return ; -+ } -+ } -+/*********************************************************** -+********************Cholesky_Decomposition****************** -+************************************************************/ -+ -+ void choldc_pro( EnvT* e) -+ { -+ -+ //#if defined _OPENMP -+ // set_num_threads(); -+ //#endif -+ // BaseGDL* p0 = e->GetNumericArrayParDefined( 0); -+ BaseGDL* p0 = e->GetParDefined( 0); -+ // BaseGDL* p0 = e->GetPar( 0); -+ SizeT nParam=e->NParam(2); -+ long singular=0; -+ SizeT nEl = p0->N_Elements(); -+ //cout<<"rank is"<Rank()<Throw( "Variable is undefined: " + e->GetParString(0)); -+ -+ if (p0->Rank() > 2) -+ e->Throw( "Input must be a square matrix:" + e->GetParString(0)); -+ -+ if (p0->Rank() > 1) { -+ if (p0->Dim(0) != p0->Dim(1)) -+ e->Throw( "Input must be a square matrix:" + e->GetParString(0)); -+ } -+ -+ if (p0->Rank() < 2) -+ e->Throw( "Input must be a square matrix:" + e->GetParString(0)); -+ -+ -+ long NbCol,NbRow; -+ -+ // cout << p0->Type() << endl; -+ -+ -+/*************************Complex**************************************/ -+ if( p0->Type() == GDL_COMPLEX && !e->KeywordSet("DOUBLE")) { -+ DComplexGDL* p0C = static_cast -+ (p0->Convert2(GDL_COMPLEX , BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map,Dynamic,Dynamic,RowMajor> > m0(&(*p0C)[0], NbCol,NbRow); -+ LLTsolver; -+ MatrixXf tmp_res = solver.compute(m0.real()).matrixL(); -+ -+ DFloatGDL* res = new DFloatGDL(p0->Dim(0), BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.diagonal().cast(); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return ; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return; -+ } -+ -+ e->SetPar(1,res); -+ m0=m0.triangularView(); -+ tmp_res=tmp_res.triangularView(); -+ tmp_res=tmp_res+m0.real(); -+ -+ DFloatGDL* res2 = new DFloatGDL(p0->Dim(), BaseGDL::NOZERO); -+ Map >(&(*res2)[0], NbCol, NbRow) = tmp_res.cast(); -+ -+ e->SetPar(0,res2); -+ return ; -+ } -+ -+/*************************Complex_Double**************************************/ -+ else if( p0->Type() == GDL_COMPLEXDBL) { -+ -+ DComplexDblGDL* p0C = static_cast -+ (p0->Convert2(GDL_COMPLEXDBL , BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map,Dynamic,Dynamic,RowMajor> > m0(&(*p0C)[0], NbCol,NbRow); -+ LLTsolver; -+ MatrixXd tmp_res = solver.compute(m0.real()).matrixL(); -+ -+ DDoubleGDL* res = new DDoubleGDL(p0->Dim(0), BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.diagonal().cast(); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return ; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return; -+ } -+ -+ e->SetPar(1,res); -+ m0=m0.triangularView(); -+ tmp_res=tmp_res.triangularView(); -+ tmp_res=tmp_res+m0.real(); -+ DDoubleGDL* res2 = new DDoubleGDL(p0->Dim(), BaseGDL::NOZERO); -+ Map >(&(*res2)[0], NbCol, NbRow) = tmp_res.cast(); -+ -+ e->SetPar(0,res2); -+ return ; -+ } -+ -+/*************************Double**************************************/ -+ else if(( p0->Type() == GDL_DOUBLE) || e->KeywordSet("DOUBLE")) { -+ -+ DDoubleGDL* p0D = static_cast -+ (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map > m0(&(*p0D)[0], NbCol,NbRow); -+ LLTsolver; -+ MatrixXd tmp_res = solver.compute(m0).matrixL(); -+ -+ DDoubleGDL* res = new DDoubleGDL(p0->Dim(0), BaseGDL::NOZERO); -+ Map(&(*res)[0], NbCol) = tmp_res.diagonal().cast(); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return ; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return; -+ } -+ -+ e->SetPar(1,res); -+ m0=m0.triangularView(); -+ tmp_res=tmp_res.triangularView(); -+ tmp_res=tmp_res+m0; -+ Map >(&(*p0D)[0], NbCol, NbRow) = tmp_res.cast(); -+ -+ e->SetPar(0,p0D); -+ return ; -+ } -+ -+/*************************All_Other**************************************/ -+ else if( p0->Type() == GDL_FLOAT || -+ p0->Type() == GDL_LONG || -+ p0->Type() == GDL_ULONG || -+ p0->Type() == GDL_LONG64 || -+ p0->Type() == GDL_ULONG64 || -+ p0->Type() == GDL_INT || -+ p0->Type() == GDL_STRING || -+ p0->Type() == GDL_UINT || -+ p0->Type() == GDL_BYTE) -+ { -+ DFloatGDL* p0SS = static_cast -+ (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -+ NbCol=p0->Dim(0); -+ NbRow=p0->Dim(1); -+ Map > m0(&(*p0SS)[0], NbCol,NbRow); -+ LLTsolver; -+ MatrixXf tmp_res = solver.compute(m0).matrixL(); -+ -+// cout<<"matrix"<(&(*res)[0], NbCol) = tmp_res.diagonal().cast(); -+ -+ if(solver.info()==NumericalIssue) -+ { -+ e->Throw( "Array is not positive definite: " + e->GetParString(0)); -+ return ; -+ } -+ if(solver.info()!=Success) -+ { -+ e->Throw( "Decomposition has failed: " + e->GetParString(0)); -+ return; -+ } -+ -+ e->SetPar(1,res); -+ m0 = m0.triangularView(); -+ tmp_res = tmp_res.triangularView(); -+ tmp_res = tmp_res + m0; -+ Map >(&(*p0SS)[0], NbCol, NbRow) = tmp_res.cast(); -+ -+ e->SetPar(0,p0SS); -+ return ; -+ } -+//****************************Bug************************** -+ else -+ { -+ cout << "Should never reach this point ! Please report it !" << endl; -+ return ; -+ } -+ -+ -+ return ; -+ } -+ -+ -+ -+ -+ template< typename T> -+ int cp2data_template( BaseGDL* p0, T* data, SizeT nEl, -+ SizeT offset, SizeT stride_in, SizeT stride_out) -+ { -+ switch ( p0->Type()) { -+ case GDL_DOUBLE: -+ cp2data2_template< DDoubleGDL, T>( p0, data, nEl, offset, -+ stride_in, stride_out); -+ break; -+ case GDL_FLOAT: -+ cp2data2_template< DFloatGDL, T>( p0, data, nEl, offset, -+ stride_in, stride_out); -+ break; -+ case GDL_LONG: -+ cp2data2_template< DLongGDL, T>( p0, data, nEl, offset, -+ stride_in, stride_out); -+ break; -+ case GDL_ULONG: -+ cp2data2_template< DULongGDL, T>( p0, data, nEl, offset, -+ stride_in, stride_out); -+ break; -+ case GDL_INT: -+ cp2data2_template< DIntGDL, T>( p0, data, nEl, offset, -+ stride_in, stride_out); -+ break; -+ case GDL_UINT: -+ cp2data2_template< DUIntGDL, T>( p0, data, nEl, offset, -+ stride_in, stride_out); -+ break; -+ case GDL_BYTE: -+ cp2data2_template< DByteGDL, T>( p0, data, nEl, offset, -+ stride_in, stride_out); -+ break; -+ } -+ return 0; -+ } -+ -+#endif -+} //namespace lib -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/matrix_cholesky.hpp gdl/src/matrix_cholesky.hpp ---- gdl-0.9.3/src/matrix_cholesky.hpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/matrix_cholesky.hpp 2013-07-18 11:23:41.000000000 -0600 -@@ -0,0 +1,43 @@ -+/*************************************************************************** -+ gsl_fun.hpp - GSL GDL library function -+ ------------------- -+ begin : Jan 20 2004 -+ copyright : (C) 2004 by Joel Gales -+ email : jomoga@users.sourceforge.net -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#ifdef HAVE_CONFIG_H -+#include -+#endif -+ -+// current versions are based on Eigen3 -+// #if defined(HAVE_LIBGSL) && defined(HAVE_LIBGSLCBLAS) -+ -+//#ifndef GSL_FUN_HPP_ -+//#define GSL_FUN_HPP_ -+ -+#include "datatypes.hpp" -+#include "envt.hpp" -+ -+namespace lib { -+ -+ BaseGDL* cholsol_fun( EnvT* e); -+ BaseGDL* la_cholsol_fun( EnvT* e); -+ -+ void choldc_pro( EnvT* e); -+ void la_choldc_pro( EnvT* e); -+ -+} // namespace -+ -+//#endif -+ -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/ncdf_att_cl.cpp gdl/src/ncdf_att_cl.cpp ---- gdl-0.9.3/src/ncdf_att_cl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/ncdf_att_cl.cpp 2013-07-08 12:39:21.940392591 -0600 -@@ -32,7 +32,7 @@ - # include - # include - # include --# include -+# include - - # include "datatypes.hpp" - # include "math_utl.hpp" -@@ -253,7 +253,7 @@ - status = nc_get_att_short(cdfid, varid, attname.c_str(), sp); - ncdf_att_handle_error(e, status, "NCDF_ATTGET", sp); - temp = length == 1 ? new DIntGDL(BaseGDL::NOZERO) : new DIntGDL(dim, BaseGDL::NOZERO); -- memcpy(&(*static_cast(temp))[0], &(*sp), length * sizeof(short)); -+ memcpy(&(*static_cast(temp))[0], &(*sp), length * sizeof(DInt)); - delete sp; - break; - } -@@ -263,7 +263,7 @@ - status=nc_get_att_float(cdfid, varid, attname.c_str(), fp); - ncdf_att_handle_error(e,status,"NCDF_ATTGET",fp); - temp = length == 1 ? new DFloatGDL(BaseGDL::NOZERO) : new DFloatGDL(dim, BaseGDL::NOZERO); -- memcpy(&(*static_cast(temp))[0], &(*fp), length * sizeof(float)); -+ memcpy(&(*static_cast(temp))[0], &(*fp), length * sizeof(DFloat)); - delete fp; - break; - } -@@ -273,7 +273,7 @@ - status = nc_get_att_double(cdfid, varid, attname.c_str(), dp); - ncdf_att_handle_error(e, status, "NCDF_ATTGET", dp); - temp = length == 1 ? new DDoubleGDL(BaseGDL::NOZERO) : new DDoubleGDL(dim, BaseGDL::NOZERO); -- memcpy(&(*static_cast(temp))[0], &(*dp), length * sizeof(double)); -+ memcpy(&(*static_cast(temp))[0], &(*dp), length * sizeof(DDouble)); - delete dp; - break; - } -@@ -283,7 +283,7 @@ - status = nc_get_att_uchar(cdfid, varid, attname.c_str(), bp); - ncdf_att_handle_error(e, status, "NCDF_ATTGET", bp); - temp = length == 1 ? new DByteGDL(BaseGDL::NOZERO) : new DByteGDL(dim, BaseGDL::NOZERO); -- memcpy(&(*static_cast(temp))[0], &(*bp), length * sizeof(unsigned char)); -+ memcpy(&(*static_cast(temp))[0], &(*bp), length * sizeof(DByte)); - delete bp; - break; - } -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/ncdf_cl.cpp gdl/src/ncdf_cl.cpp ---- gdl-0.9.3/src/ncdf_cl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/ncdf_cl.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -151,7 +151,7 @@ - { - BaseGDL* v=e->GetParDefined(2); - DIntGDL* dim_in=static_cast(v->Convert2(GDL_INT, BaseGDL::COPY)); -- auto_ptr dim_in_guard( dim_in); -+ Guard dim_in_guard( dim_in); - int var_ndims=dim_in->N_Elements(); - if(var_ndims > NC_MAX_VAR_DIMS) - e->Throw("NCDF internal error in error handler (too many dimension IDs)."); -@@ -260,17 +260,8 @@ - else - { - /*unknown error*/ -- int mema=3; -- char *n=new char(mema); -- while (snprintf(n, sizeof n, "%d", status) >= sizeof n) -- { delete n;mema++; n=new char(mema); } -- - error+=nc_strerror(status); -- error+=" (NC_ERROR="; -- error+=n; -- delete n; -- error+=")"; -- -+ error+=" (NC_ERROR="+i2s(status)+")"; - } - - e->Throw(error); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/ncdf_cl.hpp gdl/src/ncdf_cl.hpp ---- gdl-0.9.3/src/ncdf_cl.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/ncdf_cl.hpp 2013-05-16 12:36:33.000000000 -0600 -@@ -18,7 +18,7 @@ - #ifndef NCDF_HPP_CL_ - #define NCDF_HPP_CL_ - --#include -+#include - #include - - namespace lib { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/ncdf_dim_cl.cpp gdl/src/ncdf_dim_cl.cpp ---- gdl-0.9.3/src/ncdf_dim_cl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/ncdf_dim_cl.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -30,7 +30,7 @@ - #include - #include - #include --#include -+#include - - #include "datatypes.hpp" - #include "math_utl.hpp" -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/ncdf_var_cl.cpp gdl/src/ncdf_var_cl.cpp ---- gdl-0.9.3/src/ncdf_var_cl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/ncdf_var_cl.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -31,7 +31,7 @@ - #include - #include - #include --#include -+#include - - #include "datatypes.hpp" - #include "math_utl.hpp" -@@ -57,27 +57,10 @@ - - void exceed_message(const char * name,int index, int set) - { -- int mema=3; - string mess; - mess=name; -- mess+="Limit exceeded on index "; -- char * n=new char(mema); -- while (snprintf(n, sizeof n, "%d", index) >= sizeof n) -- { delete n; mema++; n=new char(mema); -- } -- mess+=n; -- delete n; -- -- mess+=", setting to "; -- mema=3; -- n=new char(mema); -- while (snprintf(n, sizeof n, "%d", set) >= sizeof n) -- { -- delete n;mema++; n=new char(mema); -- } -- mess+=n; -- delete n; -- mess+="."; -+ mess+="Limit exceeded on index "+i2s(index); -+ mess+=", setting to "+i2s(set)+"."; - Message(mess); - - } -@@ -87,28 +70,14 @@ - int mema=3; - string mess; - mess=name; -- mess+="Value of index"; -- char * n=new char(mema); -- while (snprintf(n, sizeof n, "%d", index) >= sizeof n) -- { delete n; mema++; n=new char(mema); -- } -- mess+=n; -- delete n; -+ mess+="Value of index "+i2s(index); - if(set > 0) - mess+=" is negative or zero, setting to "; - else if(set == 0) - mess+=" is negative , setting to "; - else - mess+=" INTERNAL ERROR NCDF_VAR_CL.CPP negzero_message"; -- -- mema=3; -- n=new char(mema); -- while (snprintf(n, sizeof n, "%d", set) >= sizeof n) -- { -- delete n;mema++; n=new char(mema); -- } -- mess+=n; -- delete n; -+ mess+=i2s(set); - mess+="."; - Message(mess); - -@@ -660,22 +629,9 @@ - int mema=3; - string mess; - mess = "NCDF_VARGET: Requested read is larget than data in dimension "; -- char * n=new char(mema); -- while (snprintf(n, sizeof n, "%d", i) >= sizeof n) -- { -- delete n; mema++; n=new char(mema); -- } -- mess+=n; -- delete n; -+ mess+=i2s(i); - mess+=". Reducing COUNT to "; -- mema=3; -- n=new char[3]; -- while (snprintf(n, sizeof n, "%d", cou[trans[i]]) >= sizeof n) -- { -- delete n; mema++; n=new char(mema); -- } -- mess+=n; -- delete n; -+ mess+=i2s(cou[trans[i]]); - mess+="."; - Message(mess); - } -@@ -764,7 +720,7 @@ - { - v=e->GetParDefined(2); - DIntGDL* dim_in=static_cast(v->Convert2(GDL_INT, BaseGDL::COPY)); -- auto_ptr dim_in_guard( dim_in); -+ Guard dim_in_guard( dim_in); - var_ndims=dim_in->N_Elements(); - if(var_ndims > NC_MAX_VAR_DIMS) - { -@@ -962,7 +918,7 @@ - } - } - -- int total = 1; -+ long total = 1; - - if (e->GetKW(0) != NULL) - { -@@ -1042,7 +998,7 @@ - case GDL_ULONG64 : - { - BaseGDL* val; -- auto_ptr val_guard(val); -+ Guard val_guard(val); - switch (var_type) - { - case NC_BYTE : // 8-bit signed integer -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/new.cpp gdl/src/new.cpp ---- gdl-0.9.3/src/new.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/new.cpp 2013-02-25 17:04:25.000000000 -0700 -@@ -22,7 +22,7 @@ - - #include "datatypes.hpp" - #include "envt.hpp" -+#include "dinterpreter.hpp" - - namespace lib { - } -- -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/newprognode.cpp gdl/src/newprognode.cpp ---- gdl-0.9.3/src/newprognode.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/newprognode.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -359,7 +359,7 @@ - { - if( !newNode->ConstantExpr()) return newNode; - -- auto_ptr guard( newNode); -+ Guard guard( newNode); - - BaseGDL* cData = newNode->Eval(); - -@@ -373,7 +373,7 @@ - { - if( !newUnary->ConstantExpr()) return newUnary; - -- auto_ptr guard( newUnary); -+ Guard guard( newUnary); - - BaseGDL* cData = newUnary->Eval(); - -@@ -540,7 +540,7 @@ - { - if( !newNode->ConstantExpr()) return newNode; - -- auto_ptr guard( newNode); -+ Guard guard( newNode); - - BaseGDL* cData = newNode->Eval(); - -@@ -554,7 +554,7 @@ - { - if( !newUnary->ConstantExpr()) return newUnary; - -- auto_ptr guard( newUnary); -+ Guard guard( newUnary); - - BaseGDL* cData = newUnary->Eval(); - -@@ -576,7 +576,7 @@ - if( !static_cast(c->libFun)->RetConstant() - || !ConstantPar( c->getFirstChild())) return c; - -- auto_ptr< ProgNode> guard( c); -+ Guard< ProgNode> guard( c); - - BaseGDL* cData = c->Eval(); - -@@ -593,7 +593,7 @@ - if( !static_cast(c->libFun)->RetConstant() - || !ConstantPar( c->getFirstChild())) return c; - -- auto_ptr< ProgNode> guard( c); -+ Guard< ProgNode> guard( c); - - BaseGDL* cData = c->Eval(); - -@@ -610,7 +610,7 @@ - if( !static_cast(c->libFun)->RetConstant() - || !ConstantPar( c->getFirstChild())) return c; - -- auto_ptr< ProgNode> guard( c); -+ Guard< ProgNode> guard( c); - - BaseGDL* cData = c->Eval(); - -@@ -698,7 +698,7 @@ - ARRAYDEFNode* c = new ARRAYDEFNode( refNode); - if( !c->ConstantArray()) return c; - -- auto_ptr< ARRAYDEFNode> guard( c); -+ Guard< ARRAYDEFNode> guard( c); - - BaseGDL* cData = c->Eval(); - -@@ -723,7 +723,7 @@ - // cout << endl; - assert( c->ConstantArray()); - -- auto_ptr< ProgNode> guard( c); -+ Guard< ProgNode> guard( c); - - BaseGDL* cData = c->Eval(); - -@@ -741,7 +741,7 @@ - // refNode->setNextSibling(antlr::nullAST); - - // ProgNodeP c = new ARRAYDEFNode( refNode); --// auto_ptr< ProgNode> guard( c); -+// Guard< ProgNode> guard( c); - // //c->setType( GDLTokenTypes::ARRAYDEF); - - // // evaluate constant -@@ -963,7 +963,7 @@ - new ParameterNode( refNode);//->GetFirstChild()); - return firstChild; - --// auto_ptr guard(nn); -+// Guard guard(nn); - // return nn->StealFirstChild(); - } - case GDLTokenTypes::REF_EXPR_VN: -@@ -978,7 +978,7 @@ - new ParameterNode( refNode);//->GetFirstChild()); - return firstChild; - --// auto_ptr guard(nn); -+// Guard guard(nn); - // return nn->StealFirstChild(); - } - case GDLTokenTypes::KEYDEF_REF_CHECK: -@@ -1004,7 +1004,7 @@ - new ParameterNode( refNode); - return firstChild; - --// auto_ptr guard(nn); -+// Guard guard(nn); - // ProgNodeP firstChild = nn->StealFirstChild(); - // firstChild->SetNextSibling( nn->StealNextSibling()); - // return firstChild; -@@ -1021,7 +1021,7 @@ - new ParameterNode( refNode); - return firstChild; - --// auto_ptr guard(nn); -+// Guard guard(nn); - // ProgNodeP firstChild = nn->StealFirstChild(); - // firstChild->SetNextSibling( nn->StealNextSibling()); - // return firstChild; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/nullgdl.cpp gdl/src/nullgdl.cpp ---- gdl-0.9.3/src/nullgdl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/nullgdl.cpp 2013-07-31 09:41:44.145244980 -0600 -@@ -204,7 +204,7 @@ - throw GDLException("NullGDL::SetBufferSize called."); - } - --int NullGDL::Scalar2index(SizeT& ret) const -+int NullGDL::Scalar2Index(SizeT& ret) const - { - throw GDLException("Operation not defined for !NULL 1."); - } -@@ -499,7 +499,7 @@ - throw GDLException("Operation not defined for !NULL 170."); - } - --BaseGDL* NullGDL::MatrixOp( BaseGDL* r, bool rtranspose, bool transposeResult, bool strassen) -+BaseGDL* NullGDL::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose) - { - throw GDLException("Operation not defined for !NULL 18."); - } -@@ -551,6 +551,10 @@ - int minN, char fill, NullGDL::IOMode oM) - {throw GDLException("NullGDL::OFmtI(...) called.");} - -+SizeT NullGDL::OFmtCal( std::ostream* os, SizeT offs, SizeT num, int width, -+ int minN, char fill, NullGDL::Cal_IOMode cM) -+{throw GDLException("NullGDL::OFmtCal(...) called.");} -+ - SizeT NullGDL::IFmtA( std::istream* is, SizeT offset, SizeT num, int width) - {throw GDLException("NullGDL::IFmtA(...) called.");} - -@@ -561,8 +565,8 @@ - NullGDL::IOMode oM) - {throw GDLException("NullGDL::IFmtI(...) called.");} - --BaseGDL* NullGDL::Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode) -+BaseGDL* NullGDL::Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode) - { - throw GDLException("NullGDL::Convol(...) called."); - } -@@ -714,6 +718,10 @@ - { - throw GDLException("Operation not defined for !NULL 29."); - } -+DDouble NullGDL::HashValue() const -+{ -+ throw GDLException("Operation not defined for !NULL 29a."); -+} - - BaseGDL* NullGDL::Rotate( DLong dir) - { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/nullgdl.hpp gdl/src/nullgdl.hpp ---- gdl-0.9.3/src/nullgdl.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/nullgdl.hpp 2013-07-31 09:41:44.147244973 -0600 -@@ -124,11 +124,13 @@ - /*virtual*/ BaseGDL* GetEmptyInstance() const; - /*virtual*/ BaseGDL* SetBuffer( const void* b); - /*virtual*/ void SetBufferSize( SizeT s); -- /*virtual*/ int Scalar2index(SizeT& ret) const; -+ /*virtual*/ int Scalar2Index(SizeT& ret) const; - /*virtual*/ int Scalar2RangeT(RangeT& ret) const; - /*virtual*/ SizeT GetAsIndex( SizeT i) const; - /*virtual*/ SizeT GetAsIndexStrict( SizeT i) const; - /*virtual*/ RangeT LoopIndex() const; -+ /*virtual*/ DDouble HashValue() const; -+ - /*virtual*/ bool True(); - /*virtual*/ bool False(); - /*virtual*/ bool LogTrue(); -@@ -164,8 +166,8 @@ - /*virtual*/ BaseGDL* NewIxFromStride( SizeT s, SizeT e, SizeT stride); - - // library functions -- /*virtual*/ BaseGDL* Convol( BaseGDL* kIn, BaseGDL* scaleIn, -- bool center, int edgeMode); -+ /*virtual*/ BaseGDL* Convol( BaseGDL* kIn, BaseGDL* scaleIn, BaseGDL* bias, -+ bool center, bool normalize, int edgeMode); - /*virtual*/ BaseGDL* Rebin( const dimension& newDim, bool sample); - // for STRUCT_ASSIGN - /*virtual*/ void Assign( BaseGDL* src, SizeT nEl); -@@ -281,7 +283,7 @@ - - - // /*virtual*/ BaseGDL* PowInvNew( BaseGDL* r); -- /*virtual*/ BaseGDL* MatrixOp( BaseGDL* r, bool rtranspose = false, bool transposeResult =false, bool strassen = false); -+ /*virtual*/ BaseGDL* MatrixOp( BaseGDL* r, bool atranspose, bool btranspose); - /*virtual*/ void AssignAt( BaseGDL* srcIn, ArrayIndexListT* ixList, SizeT offset); - /*virtual*/ void AssignAt( BaseGDL* srcIn, ArrayIndexListT* ixList); - /*virtual*/ void AssignAt( BaseGDL* srcIn); -@@ -300,6 +302,8 @@ - int prec, char fill, IOMode oM = FIXED); - /*virtual*/ SizeT OFmtI( std::ostream* os, SizeT offs, SizeT num, int width, - int minN, char fill, BaseGDL::IOMode oM = DEC); -+ /*virtual*/ SizeT OFmtCal( std::ostream* os, SizeT offs, SizeT num, int width, -+ int minN, char fill, BaseGDL::Cal_IOMode oM = BaseGDL::DEFAULT); - /*virtual*/ SizeT IFmtA( std::istream* is, SizeT offset, SizeT num, int width); - /*virtual*/ SizeT IFmtF( std::istream* is, SizeT offs, SizeT num, int width); - /*virtual*/ SizeT IFmtI( std::istream* is, SizeT offs, SizeT num, int width, -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/objects.cpp gdl/src/objects.cpp ---- gdl-0.9.3/src/objects.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/objects.cpp 2013-07-31 09:41:44.148244970 -0600 -@@ -32,6 +32,10 @@ - - //#include "dinterpreter.hpp" - -+#ifdef _OPENMP -+#include -+#endif -+ - #ifdef HAVE_LIBWXWIDGETS - #include "gdlwidget.hpp" - #endif -@@ -64,6 +68,14 @@ - volatile bool sigControlC; - int debugMode; - -+namespace structDesc { -+ // set in InitStructs() -+ DStructDesc* LIST = NULL; -+ DStructDesc* HASH = NULL; -+ DStructDesc* GDL_CONTAINER_NODE = NULL; -+ DStructDesc* GDL_HASHTABLEENTRY = NULL; -+} -+ - // for OpenMP - DLong CpuTPOOL_NTHREADS; - DLong CpuTPOOL_MIN_ELTS; -@@ -78,14 +90,20 @@ - { - Graphics::DestroyDevices(); - -- Purge(sysVarList); -- Purge(funList); -- Purge(proList); -- Purge(structList); // now deletes member subroutines (and they in turn common block references -- // hence delete common blocks after structList -- Purge(commonList); -- // no purging of library -+ fileUnits.clear(); -+ cerr << flush; cout << flush; clog << flush; - -+ PurgeContainer(sysVarList); -+ PurgeContainer(funList); -+ PurgeContainer(proList); -+ PurgeContainer(structList); // now deletes member subroutines (and they in turn common block references -+ // hence delete common blocks after structList -+ PurgeContainer(commonList); -+ -+ // don't purge library here -+// PurgeContainer(libFunList); -+// PurgeContainer(libProList); -+ - #ifdef USE_PYTHON - PythonEnd(); - #endif -@@ -106,7 +124,7 @@ - SpDPtr aPtrRef; - SpDObj aObjRef; - -- // OBJECTS -+ // OBJECTS ================================================= - - DStructDesc* gdl_object = new DStructDesc( GDL_OBJECT_NAME); - gdl_object->AddTag("GDL_OBJ_TOP", &aLong64); -@@ -117,40 +135,49 @@ - // insert into structList - structList.push_back(gdl_object); - --// DStructDesc* gdlList = new DStructDesc( "LIST"); --// gdlList->AddTag("GDL_CONTAINER_TOP", &aLong64); --// gdlList->AddTag("GDLCONTAINERVERSION", &aInt); --// gdlList->AddTag("PHEAD", &aPtrRef); --// gdlList->AddTag("PTAIL", &aPtrRef); --// gdlList->AddTag("NLIST", &aLong); --// gdlList->AddTag("GDL_CONTAINER_BOTTOM", &aLong64); --// // insert into structList --// structList.push_back(gdlList); --// --// DStructDesc* gdlContainerNode = new DStructDesc( "GDL_CONTAINER_NODE"); --// gdlContainerNode->AddTag("PNEXT", &aPtrRef); -+ DStructDesc* gdlList = new DStructDesc( "LIST"); -+ gdlList->AddTag("GDL_CONTAINER_TOP", &aLong64); -+ gdlList->AddTag("GDLCONTAINERVERSION", &aInt); -+ gdlList->AddTag("PHEAD", &aPtrRef); -+ gdlList->AddTag("PTAIL", &aPtrRef); -+ gdlList->AddTag("NLIST", &aLong); -+ gdlList->AddTag("GDL_CONTAINER_BOTTOM", &aLong64); -+ // use operator overloading (note: gdl_object's operators are not set yet) -+ gdlList->AddParent(gdl_object); -+ // insert into structList -+ structList.push_back(gdlList); -+ structDesc::LIST = gdlList; -+ -+ DStructDesc* gdlContainerNode = new DStructDesc( "GDL_CONTAINER_NODE"); -+ gdlContainerNode->AddTag("PNEXT", &aPtrRef); -+ gdlContainerNode->AddTag("PDATA", &aPtrRef); - // gdlContainerNode->AddTag("OOBJ", &aObjRef); - // gdlContainerNode->AddTag("FLAGS", &aLong); --// // insert into structList --// structList.push_back(gdlContainerNode); --// --// DStructDesc* gdlHash = new DStructDesc( "HASH"); --// gdlHash->AddTag("TABLE_BITS", &aULong); --// gdlHash->AddTag("TABLE_SIZE", &aULong); --// gdlHash->AddTag("TABLE_COUNT", &aULong); --// gdlHash->AddTag("TABLE_REMOVE", &aULong); --// gdlHash->AddTag("TABLE_FOREACH", &aULong); --// gdlHash->AddTag("TABLE_DATA", &aPtrRef); --// // insert into structList --// structList.push_back(gdlHash); --// --// DStructDesc* gdlHashTE = new DStructDesc( "GDL_HASHTABLEENTRY"); --// gdlHashTE->AddTag("PKEY", &aPtrRef); --// gdlHashTE->AddTag("PVALUE", &aPtrRef); --// // insert into structList --// structList.push_back(gdlHashTE); --// --// // OBJECTS END -+ // insert into structList -+ structList.push_back(gdlContainerNode); -+ structDesc::GDL_CONTAINER_NODE = gdlContainerNode; -+ -+ DStructDesc* gdlHash = new DStructDesc( "HASH"); -+ gdlHash->AddTag("TABLE_BITS", &aULong); -+ gdlHash->AddTag("TABLE_SIZE", &aULong); -+ gdlHash->AddTag("TABLE_COUNT", &aULong); -+ gdlHash->AddTag("TABLE_REMOVE", &aULong); -+ gdlHash->AddTag("TABLE_FOREACH", &aULong); -+ gdlHash->AddTag("TABLE_DATA", &aPtrRef); -+ // use operator overloading (note: gdl_object's operators are not set yet) -+ gdlHash->AddParent(gdl_object); -+ // insert into structList -+ structList.push_back(gdlHash); -+ structDesc::HASH = gdlHash; -+ -+ DStructDesc* gdlHashTE = new DStructDesc( "GDL_HASHTABLEENTRY"); -+ gdlHashTE->AddTag("PKEY", &aPtrRef); -+ gdlHashTE->AddTag("PVALUE", &aPtrRef); -+ // insert into structList -+ structList.push_back(gdlHashTE); -+ structDesc::GDL_HASHTABLEENTRY = gdlHashTE; -+ -+ // OBJECTS END ======================================================= - - - -@@ -443,3 +470,105 @@ - cout << "objects.cpp: at breakpoint(): " << num << endl; - num++; - } -+ -+ -+#ifndef _OPENMP -+int get_suggested_omp_num_threads() { -+ return 1; -+} -+#endif -+ -+#if defined _OPENMP -+int get_suggested_omp_num_threads() { -+ -+ int default_num_threads=1, suggested_num_threads=1; -+ -+ char* env_var_c; -+ env_var_c = getenv ("OMP_NUM_THREADS"); -+ if(env_var_c) -+ { -+ return atoi(env_var_c); -+ } -+ // cout<<"OMP_NUM_THREADS is not defined"</dev/null|cut -d\" \" -f3", "r"); -+ if (!iff) -+ { -+ return default_num_threads; -+ } -+ -+#elif defined(_WIN32) || defined(__WIN32__) || defined(__WINDOWS__) -+ cout<<"is windows"<5?1:0); -+ -+ suggested_num_threads=nbofproc-avload; -+ return suggested_num_threads; -+} -+#endif -+ -+ -Only in gdl-0.9.3/src: .#objects.cpp.1.22 -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/objects.hpp gdl/src/objects.hpp ---- gdl-0.9.3/src/objects.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/objects.hpp 2013-07-31 09:41:44.150244963 -0600 -@@ -73,13 +73,16 @@ - DEBUG_STEPOVER= 4 - }; - --template< class Container> void Purge( Container& s) -+template< class Container> void PurgeContainer( Container& s) - { - typename Container::iterator i; - for(i = s.begin(); i != s.end(); ++i) -- { delete *i; *i = NULL;} -+ { delete *i;}// *i = NULL;} -+ s.clear(); - } - -+void InitGDL(); // defined in gdl.cpp -+ - void InitObjects(); - void ResetObjects(); - -@@ -95,6 +98,8 @@ - - bool BigEndian(); - -+int get_suggested_omp_num_threads(); -+ - template class RefHeap { - private: - T* ptr; -@@ -111,7 +116,7 @@ - - void Inc() {++count;} - void Add( SizeT add) {count += add;} -- bool Dec() {return (--count==0);} -+ bool Dec() {assert(count > 0); return (--count==0);} - - RefHeap(T* p = 0) - : ptr(p), count(1) -@@ -140,5 +145,16 @@ - } - }; - -+namespace structDesc { -+ -+ // these are used mainly in list.cpp and hash.cpp -+ // as for .RESET_SESSION the pointers change -+ // one can still use these as they get updated on every new creation in InitStructs() -+ extern DStructDesc* LIST; -+ extern DStructDesc* HASH; -+ extern DStructDesc* GDL_CONTAINER_NODE; -+ extern DStructDesc* GDL_HASHTABLEENTRY; -+ -+} - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/ofmt.cpp gdl/src/ofmt.cpp ---- gdl-0.9.3/src/ofmt.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/ofmt.cpp 2013-08-04 20:25:18.990699436 -0600 -@@ -300,8 +300,7 @@ - } - - return tCountOut; --} -- -+} - // F code **************************************************** - // other - template SizeT Data_:: -@@ -675,8 +674,11 @@ - (*os) << oct << setw(w) << setfill(f) << (*this)[ i]; - else if ( oMode == BIN) - for( SizeT i=offs; i)i, w); -+#endif - else if ( oMode == HEX) - for( SizeT i=offs; i 32) --// (*os) << binstr((std::bitset<32>)i >> 32, w - 32); --// (*os) << binstr((std::bitset<32>)i, w <= 32 ? w : 32); -- if (w > 32) (*os) << binstr((*this)[ i] >> 32, w - 32); -+#ifdef _MSC_VER -+ if (w > 32) -+ (*os) << binstr((int)(*this)[ i] >> 32, w - 32); -+ (*os) << binstr((int)(*this)[ i], w <= 32 ? w : 32); -+#else -+ if (w > 32) -+ (*os) << binstr((*this)[ i] >> 32, w - 32); - (*os) << binstr((*this)[ i], w <= 32 ? w : 32); -+#endif - } - else if ( oMode == HEX) - for( SizeT i=offs; i 2 ? C - 4716 : C - 4715; -+ // hours -+ iHour = (DLong) (F * 24); -+ F -= (DDouble)iHour / 24; -+ // minutes -+ iMinute = (DLong) (F * 1440); -+ F -= (DDouble)iMinute / 1440; -+ // seconds -+ Second = F * 86400; -+ } -+ static struct -+ { -+ DLong iMonth; -+ DLong iDay; -+ DLong iYear; -+ DLong iHour; -+ DLong iMinute; -+ DLong dow; -+ DLong icap; -+ DDouble Second; -+ } mytime; -+ -+// other -+ -+ template SizeT Data_:: -+ OFmtCal( ostream* os, SizeT offs, SizeT r, int w, -+ int d, char f, BaseGDL::Cal_IOMode cMode) -+ { -+ DDoubleGDL* cVal = static_cast -+ ( this->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ SizeT retVal = cVal->OFmtCal( os, offs, r, w, d, f, cMode); -+ delete cVal; -+ return retVal; -+ } -+void outA( ostream* os, string s, int w) -+{ -+ if (w==-1) w=3; -+ if (w < 0) { -+ (*os) << left; -+ (*os) << setw(-w) << s; -+ } -+ else if (w == 0) { -+ (*os) << right; -+ (*os) << s; -+ } -+ else { -+ (*os) << right; -+ (*os) << setw(w) << s.substr(0, w); -+ } -+} -+ //double -+ template<> SizeT Data_:: -+ OFmtCal( ostream* os, SizeT offs, SizeT r, int w, -+ int d, char f, BaseGDL::Cal_IOMode cMode) -+ { -+ static string theMonth[12]={"January","February","March","April","May","June", -+ "July","August","September","October","November","December"}; -+ static string theMONTH[12]={"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE", -+ "JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"}; -+ static string themonth[12]={"january","february","march","april","may","june", -+ "july","august","september","october","november","december"}; -+ static string theDAY[7]={"MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY"}; -+ static string theDay[7]={"Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"}; -+ static string theday[7]={"monday","tuesday","wednesday","thursday","friday","saturday","sunday"}; -+ static string capa[2]={"am","pm"}; -+ static string cApa[2]={"Am","Pm"}; -+ static string cAPa[2]={"AM","PM"}; -+ -+ DLong iMonth, iDay , iYear , iHour , iMinute, dow, icap; -+ DDouble Second; -+ SizeT nTrans = ToTransfer(); -+ -+ // transfer count -+ SizeT tCount = nTrans - offs; -+ if( r < tCount) tCount = r; -+ -+ SizeT endEl = offs + tCount; -+ -+ -+ for( SizeT i=offs; i11); -+ if( cMode == DEFAULT) -+ { -+ fprintf(stderr,"cdef\n"); -+ } -+ else if( cMode == CMOA) -+ { -+ outA(os, theMONTH[iMonth], w);//std::cout << theMONTH[iMonth]; -+ } -+ else if( cMode == CMoA) -+ { -+ outA(os, theMonth[iMonth], w); -+ } -+ else if ( cMode == CmoA) -+ { -+ outA(os, themonth[iMonth], w); -+ } -+ else if ( cMode == CDWA) -+ { -+ outA(os, theDAY[dow], w); -+ } -+ else if ( cMode == CDwA) -+ { -+ outA(os,theDay[dow], w); -+ } -+ else if ( cMode == CdwA) -+ { -+ outA(os, theday[dow], w); -+ } -+ else if( cMode == CapA) -+ { -+ outA(os, capa[icap], w); -+ } -+ else if( cMode == CApA) -+ { -+ outA(os, cApa[icap], w); -+ } -+ else if( cMode == CAPA) -+ { -+ outA(os, cAPa[icap], w); -+ } -+ //integer -+ else if ( cMode == CMOI) -+ { -+ if (w==-1) w=2; -+ ZeroPad( os, w, d, f, iMonth); -+ } -+ else if ( cMode == CYI) -+ { -+ if (w==-1) w=4; -+ ZeroPad( os, w, d, f, iYear); -+ } -+ else if ( cMode == CHI) -+ { -+ if (w==-1) w=2; -+ ZeroPad( os, w, d, f, iHour); -+ } -+ else if ( cMode == ChI) -+ { -+ if (w==-1) w=2; -+ ZeroPad( os, w, d, f, iHour%12); -+ } -+ else if ( cMode == CDI) -+ { -+ if (w==-1) w=2; -+ ZeroPad( os, w, d, f, iDay); -+ } -+ else if ( cMode == CMI) -+ { -+ if (w==-1) w=2; -+ ZeroPad( os, w, d, f, iMinute); -+ } -+ else if ( cMode == CSI) -+ { -+ if (w==-1) {w=2; d=0;}; -+ ZeroPad( os, w, d, f, (DLong)Second); -+ } -+ //Float -+ else if ( cMode == CSF) -+ { -+ if (w==-1) {w=5; d=4;} -+// SetField( w, d, 6, 16, 25); -+ OutAuto( *os, Second, w, d, f); -+ } -+ } -+ return tCount; -+ } - - //#include "instantiate_templates.hpp" - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/overload.cpp gdl/src/overload.cpp ---- gdl-0.9.3/src/overload.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/overload.cpp 2013-07-31 09:41:44.171244889 -0600 -@@ -21,6 +21,10 @@ - #include "overload.hpp" - #include "prognodeexpr.hpp" - #include "dinterpreter.hpp" -+// #include "basic_pro.hpp" -+#include "nullgdl.hpp" -+#include "list.hpp" -+#include "hash.hpp" - - using namespace std; - -@@ -127,6 +131,7 @@ - *objRefP = rValue->Dup(); - } - -+ - BaseGDL* _GDL_OBJECT_OverloadBracketsRightSide( EnvUDT* e) - { - // // debug/check -@@ -270,7 +275,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*left)[i] == s); - } } - else if( left->StrictScalar(s)) -@@ -285,7 +290,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] == s); - } } - else if( rEl < nEl) -@@ -295,7 +300,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] == (*left)[i]); - } } - else // ( rEl >= nEl) -@@ -310,7 +315,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] == (*left)[i]); - } } - return res; -@@ -320,7 +325,7 @@ - { - SizeT nParam = e->NParam(); // number of parameters actually given - // int envSize = e->EnvSize(); // number of parameters + keywords 'e' (pro) has defined -- if( nParam < 2) // consider implicit SELF -+ if( nParam < 3) // consider implicit SELF - ThrowFromInternalUDSub( e, "Two parameters are needed: LEFT, RIGHT."); - - // default behavior: Exact like scalar indexing -@@ -358,7 +363,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*left)[i] != s); - } } - else if( left->StrictScalar(s)) -@@ -373,7 +378,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] != s); - } } - else if( rEl < nEl) -@@ -383,7 +388,7 @@ - #pragma omp parallel if (rEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= rEl)) - { - #pragma omp for -- for( int i=0; i < rEl; ++i) -+ for( OMPInt i=0; i < rEl; ++i) - (*res)[i] = ((*right)[i] != (*left)[i]); - } } - else // ( rEl >= nEl) -@@ -398,7 +403,7 @@ - #pragma omp parallel if (nEl >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= nEl)) - { - #pragma omp for -- for( int i=0; i < nEl; ++i) -+ for( OMPInt i=0; i < nEl; ++i) - (*res)[i] = ((*right)[i] != (*left)[i]); - } } - return res; -@@ -410,6 +415,7 @@ - BaseGDL* _GDL_OBJECT_OverloadReportIllegalOperation( EnvUDT* e) - { - ThrowFromInternalUDSub( e, "Operation illegal with object reference types."); -+ return 0; - } - - // set up the _overload... subroutines for GDL_OBJECT -@@ -420,9 +426,15 @@ - // in call_fun eventually (in GDLInterpreter::statement) tree->Run() is called - DStructDesc* gdlObjectDesc = FindInStructList(structList, GDL_OBJECT_NAME); - assert( gdlObjectDesc != NULL); -+ DStructDesc* listDesc = FindInStructList(structList, "LIST"); -+ assert( listDesc != NULL); -+ DStructDesc* hashDesc = FindInStructList(structList, "HASH"); -+ assert( hashDesc != NULL); -+ -+ WRAPPED_FUNNode *tree; - - // automatically adds "SELF" parameter (object name is != "") -- DFun *_overloadIsTrue = new DFun("_OVERLOADISTRUE",GDL_OBJECT_NAME,"*INTERNAL*"); -+ DFun *_overloadIsTrue = new DFun("_OVERLOADISTRUE",GDL_OBJECT_NAME,""); - WRAPPED_FUNNode *tree1 = new WRAPPED_FUNNode(_GDL_OBJECT_OverloadIsTrue); - _overloadIsTrue->SetTree( tree1); - // we are NOT setting the operator to have (faster) default behavior -@@ -431,7 +443,7 @@ - gdlObjectDesc->FunList().push_back(_overloadIsTrue); - // gdlObjectDesc->SetOperator(OOIsTrue,_overloadIsTrue); - -- DPro *_overloadBracketsLeftSide = new DPro("_OVERLOADBRACKETSLEFTSIDE",GDL_OBJECT_NAME,"*INTERNAL*"); -+ DPro *_overloadBracketsLeftSide = new DPro("_OVERLOADBRACKETSLEFTSIDE",GDL_OBJECT_NAME,""); - _overloadBracketsLeftSide->AddPar("OBJREF")->AddPar("RVALUE")->AddPar("ISRANGE"); - _overloadBracketsLeftSide->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); - _overloadBracketsLeftSide->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -@@ -440,7 +452,7 @@ - gdlObjectDesc->ProList().push_back(_overloadBracketsLeftSide); - // gdlObjectDesc->SetOperator(OOBracketsLeftSide,_overloadBracketsLeftSide); - -- DFun *_overloadBracketsRightSide = new DFun("_OVERLOADBRACKETSRIGHTSIDE",GDL_OBJECT_NAME,"*INTERNAL*"); -+ DFun *_overloadBracketsRightSide = new DFun("_OVERLOADBRACKETSRIGHTSIDE",GDL_OBJECT_NAME,""); - _overloadBracketsRightSide->AddPar("ISRANGE"); - _overloadBracketsRightSide->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); - _overloadBracketsRightSide->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -@@ -449,32 +461,198 @@ - gdlObjectDesc->FunList().push_back(_overloadBracketsRightSide); - // gdlObjectDesc->SetOperator(OOBracketsRightSide,_overloadBracketsRightSide); - -- DFun *_overloadEQ = new DFun("_OVERLOADEQ",GDL_OBJECT_NAME,"*INTERNAL*"); -+ DFun *_overloadEQ = new DFun("_OVERLOADEQ",GDL_OBJECT_NAME,""); - _overloadEQ->AddPar("LEFT")->AddPar("RIGHT"); - WRAPPED_FUNNode *tree4 = new WRAPPED_FUNNode(_GDL_OBJECT_OverloadEQOp); - _overloadEQ->SetTree( tree4); - gdlObjectDesc->FunList().push_back(_overloadEQ); - // gdlObjectDesc->SetOperator(OOEQ,_overloadEQ); - -- DFun *_overloadNE = new DFun("_OVERLOADNE",GDL_OBJECT_NAME,"*INTERNAL*"); -+ DFun *_overloadNE = new DFun("_OVERLOADNE",GDL_OBJECT_NAME,""); - _overloadNE->AddPar("LEFT")->AddPar("RIGHT"); - WRAPPED_FUNNode *tree5 = new WRAPPED_FUNNode(_GDL_OBJECT_OverloadNEOp); - _overloadNE->SetTree( tree5); - gdlObjectDesc->FunList().push_back(_overloadNE); - // gdlObjectDesc->SetOperator(OONE,_overloadNE); - -- DFun *_overloadPlus = new DFun("_OVERLOADPLUS",GDL_OBJECT_NAME,"*INTERNAL*"); -+ DFun *_overloadPlus = new DFun("_OVERLOADPLUS",GDL_OBJECT_NAME,""); - _overloadPlus->AddPar("LEFT")->AddPar("RIGHT"); - WRAPPED_FUNNode *tree6 = new WRAPPED_FUNNode(_GDL_OBJECT_OverloadReportIllegalOperation); - _overloadPlus->SetTree( tree6); - gdlObjectDesc->FunList().push_back(_overloadPlus); --// gdlObjectDesc->SetOperator(OOPLUS,_overloadPlus); -+// gdlObjectDesc->SetOperator(OOPlus,_overloadPlus); - -- DFun *_overloadMinus = new DFun("_OVERLOADMINUS",GDL_OBJECT_NAME,"*INTERNAL*"); -+ DFun *_overloadMinus = new DFun("_OVERLOADMINUS",GDL_OBJECT_NAME,""); - _overloadMinus->AddPar("LEFT")->AddPar("RIGHT"); - WRAPPED_FUNNode *tree7 = new WRAPPED_FUNNode(_GDL_OBJECT_OverloadReportIllegalOperation); - _overloadMinus->SetTree( tree7); - gdlObjectDesc->FunList().push_back(_overloadMinus); - // gdlObjectDesc->SetOperator(OOMINUS,_overloadMinus); - -+// LIST -+ DFun *DFunLIST__overloadBracketsRightSide = new DFun("_OVERLOADBRACKETSRIGHTSIDE","LIST",""); -+ DFunLIST__overloadBracketsRightSide->AddPar("ISRANGE"); -+ DFunLIST__overloadBracketsRightSide->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); -+ DFunLIST__overloadBracketsRightSide->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -+ tree = new WRAPPED_FUNNode( lib::LIST___OverloadBracketsRightSide); -+ DFunLIST__overloadBracketsRightSide->SetTree( tree); -+ listDesc->FunList().push_back(DFunLIST__overloadBracketsRightSide); -+ listDesc->SetOperator(OOBracketsRightSide,DFunLIST__overloadBracketsRightSide); -+ -+ DPro *DFunPro_overloadBracketsLeftSide = new DPro("_OVERLOADBRACKETSLEFTSIDE","LIST",""); -+ DFunPro_overloadBracketsLeftSide->AddPar("OBJREF")->AddPar("RVALUE")->AddPar("ISRANGE"); -+ DFunPro_overloadBracketsLeftSide->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); -+ DFunPro_overloadBracketsLeftSide->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -+ tree2 = new WRAPPED_PRONode(lib::LIST___OverloadBracketsLeftSide); -+ DFunPro_overloadBracketsLeftSide->SetTree( tree2); -+ listDesc->ProList().push_back(DFunPro_overloadBracketsLeftSide); -+ listDesc->SetOperator(OOBracketsLeftSide,DFunPro_overloadBracketsLeftSide); -+ -+ DFun *LIST_overloadPlus = new DFun("_OVERLOADPLUS","LIST",""); -+ LIST_overloadPlus->AddPar("LEFT")->AddPar("RIGHT"); -+ tree6 = new WRAPPED_FUNNode(lib::LIST___OverloadPlus); -+ LIST_overloadPlus->SetTree( tree6); -+ listDesc->FunList().push_back(LIST_overloadPlus); -+ listDesc->SetOperator(OOPlus,LIST_overloadPlus); -+ -+ DFun *LIST_overloadEQ = new DFun("_OVERLOADEQ","LIST",""); -+ LIST_overloadEQ->AddPar("LEFT")->AddPar("RIGHT"); -+ tree4 = new WRAPPED_FUNNode(lib::LIST___OverloadEQOp); -+ LIST_overloadEQ->SetTree( tree4); -+ listDesc->FunList().push_back(LIST_overloadEQ); -+ listDesc->SetOperator(OOEQ,LIST_overloadEQ); -+ -+ DFun *LIST_overloadNE = new DFun("_OVERLOADNE","LIST",""); -+ LIST_overloadNE->AddPar("LEFT")->AddPar("RIGHT"); -+ tree4 = new WRAPPED_FUNNode(lib::LIST___OverloadNEOp); -+ LIST_overloadNE->SetTree( tree4); -+ listDesc->FunList().push_back(LIST_overloadNE); -+ listDesc->SetOperator(OONE,LIST_overloadNE); -+ -+ DFun *LIST_overloadIsTrue = new DFun("_OVERLOADISTRUE","LIST",""); -+ tree4 = new WRAPPED_FUNNode(lib::LIST___OverloadIsTrue); -+ LIST_overloadIsTrue->SetTree( tree4); -+ listDesc->FunList().push_back(LIST_overloadIsTrue); -+ listDesc->SetOperator(OOIsTrue,LIST_overloadIsTrue); -+ -+// LIST::ADD -+ DPro *DProLIST__ADD = new DPro("ADD","LIST",""); -+ DProLIST__ADD->AddKey("EXTRACT","EXTRACT")->AddKey("NO_COPY","NO_COPY"); -+ DProLIST__ADD->AddPar("VALUE")->AddPar("INDEX"); -+ tree2 = new WRAPPED_PRONode( lib::list__add); -+ DProLIST__ADD->SetTree( tree2); -+ listDesc->ProList().push_back(DProLIST__ADD); -+// LIST::REMOVE() -+ DFun *DFunLIST__REMOVE = new DFun("REMOVE","LIST",""); -+ DFunLIST__REMOVE->AddKey("ALL","ALL"); -+ DFunLIST__REMOVE->AddPar("INDEX"); -+ tree = new WRAPPED_FUNNode( lib::list__remove_fun); -+ DFunLIST__REMOVE->SetTree( tree); -+ listDesc->FunList().push_back(DFunLIST__REMOVE); -+// LIST::REMOVE PRO -+ DPro *DProLIST__REMOVE = new DPro("REMOVE","LIST",""); -+ DProLIST__REMOVE->AddKey("ALL","ALL"); -+ DProLIST__REMOVE->AddPar("INDEX"); -+ tree2 = new WRAPPED_PRONode( lib::list__remove_pro); -+ DProLIST__REMOVE->SetTree( tree2); -+ listDesc->ProList().push_back(DProLIST__REMOVE); -+// LIST::REVERSE PRO -+ DPro *DProLIST__REVERSE = new DPro("REVERSE","LIST",""); -+ tree2 = new WRAPPED_PRONode( lib::list__reverse); -+ DProLIST__REVERSE->SetTree( tree2); -+ listDesc->ProList().push_back(DProLIST__REVERSE); -+// LIST::ToArray() -+ DFun *DFunLIST__TOARRAY = new DFun("TOARRAY","LIST",""); -+ DFunLIST__TOARRAY->AddKey("TYPE","TYPE"); -+ DFunLIST__TOARRAY->AddKey("MISSING","MISSING"); -+ tree = new WRAPPED_FUNNode( lib::list__toarray); -+ DFunLIST__TOARRAY->SetTree( tree); -+ listDesc->FunList().push_back(DFunLIST__TOARRAY); -+ -+ -+ -+// HASH -+ DFun *DFunHASH__overloadBracketsRightSide = new DFun("_OVERLOADBRACKETSRIGHTSIDE","HASH",""); -+ DFunHASH__overloadBracketsRightSide->AddPar("ISRANGE"); -+ DFunHASH__overloadBracketsRightSide->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); -+ DFunHASH__overloadBracketsRightSide->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -+ tree = new WRAPPED_FUNNode( lib::HASH___OverloadBracketsRightSide); -+ DFunHASH__overloadBracketsRightSide->SetTree( tree); -+ hashDesc->FunList().push_back(DFunHASH__overloadBracketsRightSide); -+ hashDesc->SetOperator(OOBracketsRightSide,DFunHASH__overloadBracketsRightSide); -+ -+ DPro *DProHASH_overloadBracketsLeftSide = new DPro("_OVERLOADBRACKETSLEFTSIDE","HASH",""); -+ DProHASH_overloadBracketsLeftSide->AddPar("OBJREF")->AddPar("RVALUE")->AddPar("ISRANGE"); -+ DProHASH_overloadBracketsLeftSide->AddPar("SUB1")->AddPar("SUB2")->AddPar("SUB3")->AddPar("SUB4"); -+ DProHASH_overloadBracketsLeftSide->AddPar("SUB5")->AddPar("SUB6")->AddPar("SUB7")->AddPar("SUB8"); -+ tree2 = new WRAPPED_PRONode(lib::HASH___OverloadBracketsLeftSide); -+ DProHASH_overloadBracketsLeftSide->SetTree( tree2); -+ hashDesc->ProList().push_back(DProHASH_overloadBracketsLeftSide); -+ hashDesc->SetOperator(OOBracketsLeftSide,DProHASH_overloadBracketsLeftSide); -+ -+ DFun *HASH_overloadPlus = new DFun("_OVERLOADPLUS","HASH",""); -+ HASH_overloadPlus->AddPar("LEFT")->AddPar("RIGHT"); -+ tree6 = new WRAPPED_FUNNode(lib::HASH___OverloadPlus); -+ HASH_overloadPlus->SetTree( tree6); -+ hashDesc->FunList().push_back(HASH_overloadPlus); -+ hashDesc->SetOperator(OOPlus,HASH_overloadPlus); -+ -+ DFun *HASH_overloadEQ = new DFun("_OVERLOADEQ","HASH",""); -+ HASH_overloadEQ->AddPar("LEFT")->AddPar("RIGHT"); -+ tree4 = new WRAPPED_FUNNode(lib::HASH___OverloadEQOp); -+ HASH_overloadEQ->SetTree( tree4); -+ hashDesc->FunList().push_back(HASH_overloadEQ); -+ hashDesc->SetOperator(OOEQ,HASH_overloadEQ); -+ -+ DFun *HASH_overloadNE = new DFun("_OVERLOADNE","HASH",""); -+ HASH_overloadNE->AddPar("LEFT")->AddPar("RIGHT"); -+ tree4 = new WRAPPED_FUNNode(lib::HASH___OverloadNEOp); -+ HASH_overloadNE->SetTree( tree4); -+ hashDesc->FunList().push_back(HASH_overloadNE); -+ hashDesc->SetOperator(OONE,HASH_overloadNE); -+ -+ DFun *HASH_overloadIsTrue = new DFun("_OVERLOADISTRUE","HASH",""); -+ tree4 = new WRAPPED_FUNNode(lib::HASH___OverloadIsTrue); -+ HASH_overloadIsTrue->SetTree( tree4); -+ hashDesc->FunList().push_back(HASH_overloadIsTrue); -+ hashDesc->SetOperator(OOIsTrue,HASH_overloadIsTrue); -+ -+// LIST::REMOVE() -+ DFun *DFunHASH__REMOVE = new DFun("REMOVE","HASH",""); -+ DFunHASH__REMOVE->AddKey("ALL","ALL"); -+ DFunHASH__REMOVE->AddPar("INDEX"); -+ tree = new WRAPPED_FUNNode( lib::hash__remove_fun); -+ DFunHASH__REMOVE->SetTree( tree); -+ hashDesc->FunList().push_back(DFunHASH__REMOVE); -+// LIST::REMOVE PRO -+ DPro *DProHASH__REMOVE = new DPro("REMOVE","HASH",""); -+ DProHASH__REMOVE->AddKey("ALL","ALL"); -+ DProHASH__REMOVE->AddPar("INDEX"); -+ tree2 = new WRAPPED_PRONode( lib::hash__remove_pro); -+ DProHASH__REMOVE->SetTree( tree2); -+ hashDesc->ProList().push_back(DProHASH__REMOVE); -+// LIST::HASKEY() -+ DFun *DFunHASH__HASKEY = new DFun("HASKEY","HASH",""); -+ DFunHASH__HASKEY->AddPar("KEYLIST"); -+ tree = new WRAPPED_FUNNode( lib::hash__haskey); -+ DFunHASH__HASKEY->SetTree( tree); -+ hashDesc->FunList().push_back(DFunHASH__HASKEY); -+// LIST::KEYS() -+ DFun *DFunHASH__KEYS = new DFun("KEYS","HASH",""); -+ tree = new WRAPPED_FUNNode( lib::hash__keys); -+ DFunHASH__KEYS->SetTree( tree); -+ hashDesc->FunList().push_back(DFunHASH__KEYS); -+// LIST::VALUES() -+ DFun *DFunHASH__VALUES = new DFun("VALUES","HASH",""); -+ tree = new WRAPPED_FUNNode( lib::hash__values); -+ DFunHASH__VALUES->SetTree( tree); -+ hashDesc->FunList().push_back(DFunHASH__VALUES); -+// LIST::TOSTRUCT() -+ DFun *DFunHASH__TOSTRUCT = new DFun("TOSTRUCT","HASH",""); -+ DFunHASH__TOSTRUCT->AddKey("SKIPPED","SKIPPED"); -+ DFunHASH__TOSTRUCT->AddKey("MISSING","MISSING"); -+ tree = new WRAPPED_FUNNode( lib::hash__tostruct); -+ DFunHASH__TOSTRUCT->SetTree( tree); -+ hashDesc->FunList().push_back(DFunHASH__TOSTRUCT); -+ - } -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/overload.hpp gdl/src/overload.hpp ---- gdl-0.9.3/src/overload.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/overload.hpp 2013-07-31 09:41:44.172244886 -0600 -@@ -89,6 +89,6 @@ - void SetOperator( SizeT op, DSubUD* opSub) { operators[op] = opSub;} - }; - -- -+void ThrowFromInternalUDSub( EnvUDT* e, const std::string& s); - - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_axis.cpp gdl/src/plotting_axis.cpp ---- gdl-0.9.3/src/plotting_axis.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_axis.cpp 2013-07-08 12:39:22.342387827 -0600 -@@ -25,29 +25,33 @@ - class axis_call : public plotting_routine_call - { - -- private: bool handle_args(EnvT* e) // {{{ -+ private: bool handle_args(EnvT* e) - { - return true; -- } // }}} -+ } - -- private: void old_body( EnvT* e, GDLGStream* actStream) // {{{ -+ private: void old_body( EnvT* e, GDLGStream* actStream) - { -- bool valid=true; -- // !X, !Y (also used below) -+ bool doT3d, real3d; -+ DDouble zValue; -+ //note: Z (VALUE) will be used uniquely if Z is not effectively defined. -+ static int zvIx = e->KeywordIx( "Z"); -+ zValue=0.0; -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ //T3D -+ static int t3dIx = e->KeywordIx( "T3D"); -+ doT3d=(e->KeywordSet(t3dIx) || T3Denabled(e)); - -- DLong xStyle=0, yStyle=0; -- DString xTitle, yTitle; -- DFloat x_CharSize, y_CharSize; - DFloat xMarginL, xMarginR, yMarginB, yMarginT; -- DFloat xTicklen, yTicklen; - -- bool xAxis=false, yAxis=false; -+ bool xAxis=false, yAxis=false, zAxis=false; - static int xaxisIx = e->KeywordIx( "XAXIS"); - static int yaxisIx = e->KeywordIx( "YAXIS"); -+ static int zaxisIx = e->KeywordIx( "ZAXIS"); - -- PLINT xaxis_value, yaxis_value; -+ PLINT xaxis_value, yaxis_value, zaxis_value; - bool standardNumPos; -- //IDL behaviour for XAXIS and YAXIS options -+ //IDL behaviour for XAXIS and YAXIS and ZAXIS options: only one option is considered, and ZAXIS above YAXIS above XAXIS - if( (e->GetKW( xaxisIx) != NULL) ) { - xAxis = true; - e->AssureLongScalarKWIfPresent( "XAXIS", xaxis_value); -@@ -58,60 +62,88 @@ - e->AssureLongScalarKWIfPresent( "YAXIS", yaxis_value); - if (yaxis_value == 0) {standardNumPos = true;} else {standardNumPos = false;} - } -- if( (e->GetKW( xaxisIx) == NULL) & (e->GetKW( yaxisIx) == NULL ) ) { -+ if( e->GetKW( zaxisIx) != NULL) { -+ zAxis = true; xAxis = false; yAxis=false; // like in IDL, zaxis overrides all -+ e->AssureLongScalarKWIfPresent( "ZAXIS", zaxis_value); -+ } -+ if( (e->GetKW( xaxisIx) == NULL) && (e->GetKW( yaxisIx) == NULL ) && ((e->GetKW( zaxisIx) == NULL )||!doT3d)) { - xAxis = true; standardNumPos = true; - } - -- // [XY]STYLE -- gkw_axis_style(e, "X", xStyle); -- gkw_axis_style(e, "Y", yStyle); -- -- e->AssureLongScalarKWIfPresent( "XSTYLE", xStyle); -- e->AssureLongScalarKWIfPresent( "YSTYLE", yStyle); -- -- // AXIS TITLE -- gkw_axis_title(e, "X", xTitle); -- gkw_axis_title(e, "Y", yTitle); - // MARGIN -- gkw_axis_margin(e, "X",xMarginL, xMarginR); -- gkw_axis_margin(e, "Y",yMarginB, yMarginT); -+ gdlGetDesiredAxisMargin(e, "X",xMarginL, xMarginR); -+ gdlGetDesiredAxisMargin(e, "Y",yMarginB, yMarginT); -+ -+ // will handle axis logness.. -+ bool xLog, yLog, zLog; -+ // is current box log or not? -+ bool xAxisWasLog, yAxisWasLog, zAxisWasLog; -+ gdlGetAxisType("X", xAxisWasLog); -+ gdlGetAxisType("Y", yAxisWasLog); -+ gdlGetAxisType("Z", zAxisWasLog); -+ xLog=xAxisWasLog; -+ yLog=yAxisWasLog; //by default logness is similar until another option is set -+ zLog=zAxisWasLog; - -- // x and y range -+ enum -+ { -+ DATA=0, -+ NORMAL, -+ DEVICE -+ } coordinateSystem=DATA; -+ //check presence of DATA,DEVICE and NORMAL options -+ if ( e->KeywordSet("DATA") ) coordinateSystem=DATA; -+ if ( e->KeywordSet("DEVICE") ) coordinateSystem=DEVICE; -+ if ( e->KeywordSet("NORMAL") ) coordinateSystem=NORMAL; -+ -+ // x and y range, old and new -+ DDouble oxStart, oxEnd; -+ DDouble oyStart, oyEnd; - DDouble xStart, xEnd; - DDouble yStart, yEnd; -- -- get_axis_crange("X", xStart, xEnd); -- get_axis_crange("Y", yStart, yEnd); -- -- DLong xnozero=1, ynozero=0; -- gkw_axis_range( e, "X", xStart, xEnd, xnozero); -- gkw_axis_range( e, "Y", yStart, yEnd, ynozero); -- -+ // get viewport coordinates in normalised units -+ PLFLT ovpXL, ovpXR, ovpYB, ovpYT; -+ actStream->gvpd(ovpXL, ovpXR, ovpYB, ovpYT); -+ //undefined previous viewport, seems IDL returns without complain: -+ if ((ovpXL==0.0 && ovpXR==0.0) || (ovpYB==0.0 && ovpYT==0.0)) return; -+ PLFLT ovpSizeX, ovpSizeY; -+ ovpSizeX=ovpXR-ovpXL; -+ ovpSizeY=ovpYT-ovpYB; -+ //get wiewport window in world coordinates -+ PLFLT xmin, xmax, ymin, ymax; -+ actStream->gvpw(xmin, xmax, ymin, ymax); -+ -+ xStart=oxStart=xmin; -+ xEnd=oxEnd=xmax; -+ yStart=oyStart=ymin; -+ yEnd=oyEnd=ymax; -+ //convert these values to real values if box was log -+ if (xAxisWasLog) {xStart=pow(10,xStart);xEnd=pow(10,xEnd);} -+ if (yAxisWasLog) {yStart=pow(10,yStart);yEnd=pow(10,yEnd);} -+ -+ static int xLogIx = e->KeywordIx( "XLOG" ); -+ static int yLogIx = e->KeywordIx( "YLOG" ); -+ xLog = (xLog || e->KeywordSet( xLogIx )); -+ yLog = (yLog || e->KeywordSet( yLogIx )); -+ -+ //YNOZERO corrects yStart -+ if ( e->KeywordSet( "YNOZERO") && yStart >0 && !yLog ) yStart=0.0; -+ bool setdummy; -+ setdummy=gdlGetDesiredAxisRange( e, "X", xStart, xEnd); -+ setdummy=gdlGetDesiredAxisRange( e, "Y", yStart, yEnd); - if (xStart == xEnd && yStart == yEnd) { - e->Throw("Invalid plotting ranges. Set up a plot window first."); - } -+ gdlHandleUnwantedAxisValue(xStart, xEnd, xLog); -+ gdlHandleUnwantedAxisValue(yStart, yEnd, yLog); - -- /* -- if ((xStyle & 1) != 1 && xAxis) { -- PLFLT intv; -- intv = AutoIntvAC(xStart, xEnd, false ); -- // xEnd = ceil(xEnd/intv) * intv; -- // xStart = floor(xStart/intv) * intv; -- } -- -- if ((yStyle & 1) != 1 && yAxis) { -- PLFLT intv; -- intv = AutoIntvAC(yStart, yEnd, false ); -- //yEnd = ceil(yEnd/intv) * intv; -- //yStart = floor(yStart/intv) * intv; -- } -- */ -- -- DDouble zVal, yVal, xVal; -+ DDouble yVal, xVal; -+ //in absence of arguments we will have: -+ yVal=(standardNumPos)?oyStart:oyEnd; -+ xVal=(standardNumPos)?oxStart:oxEnd; - //read arguments - if (nParam() == 1) { - e->AssureDoubleScalarPar( 0, xVal); -- yVal=0.; //IDL behaviour - } - if (nParam() == 2) { - e->AssureDoubleScalarPar( 0, xVal); -@@ -120,245 +152,94 @@ - if (nParam() == 3) { - e->Throw( "Sorry, we do not yet support the 3D case"); - } -- if (nParam() == 0 && standardNumPos) { xVal = xStart; yVal = yStart; } -- if (nParam() == 0 && !standardNumPos) { xVal = xEnd; yVal = yEnd; } - -- /* -- DLong ynozero, xnozero; -- //[x|y]range keyword -- gkw_axis_range(e, "X", xStart, xEnd, ynozero); -- gkw_axis_range(e, "Y", yStart, yEnd, xnozero); -- */ -- -- // AC nomore useful -- // if(xEnd == xStart) xEnd=xStart+1; -- -- DDouble minVal = yStart; -- DDouble maxVal = yEnd; -- -- DLong xTicks=0, yTicks=0; -- e->AssureLongScalarKWIfPresent( "XTICKS", xTicks); -- e->AssureLongScalarKWIfPresent( "YTICKS", yTicks); -- -- DLong xMinor=0, yMinor=0; -- e->AssureLongScalarKWIfPresent( "XMINOR", xMinor); -- e->AssureLongScalarKWIfPresent( "YMINOR", yMinor); -- -- DString xTickformat, yTickformat; -- e->AssureStringScalarKWIfPresent( "XTICKFORMAT", xTickformat); -- e->AssureStringScalarKWIfPresent( "YTICKFORMAT", yTickformat); -- -- bool xLog, yLog; -- //get_axis_type("X", xLog); -- //get_axis_type("Y", yLog); -- -- // keyword overrides -- static int xLogIx = e->KeywordIx( "XLOG"); -- static int yLogIx = e->KeywordIx( "YLOG"); -- xLog = e->KeywordSet( xLogIx); -- yLog = e->KeywordSet( yLogIx); -- -- // test for x/yVal -- if (xLog) { if (xVal <= 0.) xVal=xStart; else xVal=log10(xVal);} -- if (yLog) { if (yVal <= 0.) yVal=yStart; else yVal=log10(yVal);} -- -- DDouble ticklen = 0.02; -- e->AssureDoubleScalarKWIfPresent( "TICKLEN", ticklen); -- -- DFloat charsize, xCharSize, yCharSize; - // *** start drawing -- gkw_color(e, actStream); //COLOR -- gkw_noerase(e, actStream, true); //NOERASE -- gkw_charsize(e, actStream, charsize); //CHARSIZE -- gkw_axis_charsize(e, "X",xCharSize);//XCHARSIZE -- gkw_axis_charsize(e, "Y",yCharSize);//YCHARSIZE -- -- // plplot stuff -- // set the charsize (scale factor) -- DDouble charScale = 1.0; -- DLongGDL* pMulti = SysVar::GetPMulti(); -- if( (*pMulti)[1] > 2 || (*pMulti)[2] > 2) charScale = 0.5; -- actStream->schr( 0.0, charsize * charScale); -- -- // get subpage in mm -- PLFLT scrXL, scrXR, scrYB, scrYT; -- actStream->gspa( scrXL, scrXR, scrYB, scrYT); -- PLFLT scrX = scrXR-scrXL; -- PLFLT scrY = scrYT-scrYB; -- -- // get char size in mm (default, actual) -- PLFLT defH, actH; -- actStream->gchr( defH, actH); -- -- // get viewport coordinates in normalised units -- PLFLT vpXL, vpXR, vpYB, vpYT; -- actStream->gvpd(vpXL, vpXR, vpYB, vpYT); -- PLFLT vpX = vpXR-vpXL; -- PLFLT vpY = vpYT-vpYB; -- -- // create new viewport and draw only the relevant side (viewport -- // will be reset to its original values later) -- PLFLT svpXL, svpXR, svpYB, svpYT; //new viewport coordinates -- if (xAxis) { -- //keep the X values the same -- svpXL=vpXL; svpXR=vpXR; -- if (standardNumPos) { //our axis is the bottom of viewport -- svpYB=vpY*(yVal-yStart)/(yEnd-yStart)+vpYB; -- svpYT=svpYB+0.2; //value doesn't matter, as long as svpYT>svpYB -- } else { //our axis is the top of viewport -- svpYT=vpYT-vpY*(yEnd-yVal)/(yEnd-yStart); -- svpYB=svpYT-0.2; //value doesn't matter, as long as svpYT>svpYB -- } -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); //COLOR -+ // contrary to the documentation axis does not erase the plot (fortunately!) -+ // gdlNextPlotHandlingNoEraseOption(e, actStream, true); //NOERASE -- not supported -+ gdlSetPlotCharthick(e,actStream); -+ gdlSetPlotCharsize(e, actStream); //CHARSIZE -+ -+ PLFLT vpXL, vpXR, vpYB, vpYT; //define new viewport in relative units -+ // where is point of world coords xVal, yVal in viewport relative coords? -+ DDouble vpX,vpY; -+ if ( coordinateSystem==DEVICE ) -+ { -+ actStream->DeviceToNormedDevice(xVal, yVal, vpX, vpY); - } -- if (yAxis) { -- //keep the top and bottom the same -- svpYT=vpYT; svpYB=vpYB; -- if (standardNumPos) { //our axis is the left of the viewport -- svpXL=vpX*(xVal-xStart)/(xEnd-xStart)+vpXL; -- svpXR=svpXL+0.2; //value doesn't matter, as long as svpXR>svpXL -- } else { //our axis is the right of the viewport -- svpXR=vpXR-vpX*(xEnd-xVal)/(xEnd-xStart); -- svpXL=svpXR-0.2; //value doesn't matter, as long as svpXR>svpXL -- } -+ else if ( coordinateSystem==NORMAL ) -+ { -+ vpX=xVal; -+ vpY=yVal; -+ } -+ else -+ { -+ if (xAxisWasLog) xVal=log10(xVal); -+ if (yAxisWasLog) yVal=log10(yVal); -+ actStream->WorldToNormedDevice(xVal, yVal, vpX, vpY); -+ } -+ //compute new temporary viewport in relative coords -+#define ADDEPSILON 0.1 -+ if ( standardNumPos ) -+ { -+ vpXL=(xAxis)?ovpXL:vpX; -+ vpXR=(xAxis)?ovpXR:vpX+ovpSizeY; -+ vpYB=(xAxis)?vpY:ovpYB; -+ vpYT=(xAxis)?vpY+ovpSizeX:ovpYT; -+ } -+ else -+ { -+ vpXL=(xAxis)?ovpXL:vpX-ovpSizeY; -+ vpXR=(xAxis)?ovpXR:vpX; -+ vpYB=(xAxis)?vpY-ovpSizeX:ovpYB; -+ vpYT=(xAxis)?vpY:ovpYT; - } -- actStream->vpor(svpXL, svpXR, svpYB, svpYT); -- //The world coordinates for the relevant axis should be same as -- //the originals, while the other axis doesn't matter. -- actStream->wind(xStart, xEnd, yStart,yEnd); -- -- // POSITION -- //DFloatGDL* pos = (DFloatGDL*) 0xF; -- -- /* -- // viewport and world coordinates -- bool okVPWC = SetVP_WC( e, actStream, pos, NULL, -- xLog, yLog, -- xMarginL, xMarginR, yMarginB, yMarginT, -- xStart, xEnd, minVal, maxVal); -- if( !okVPWC) return; -- */ -- -- // pen thickness for axis -- actStream->wid( 0); -- -- // axis -- string xOpt, yOpt; -- if (standardNumPos) { xOpt = "b"; yOpt = "b";} else { xOpt = "c"; yOpt = "c"; } -- -- if (xTicks == 1) xOpt += "t"; else xOpt += "st"; -- if (yTicks == 1) yOpt += "tv"; else yOpt += "stv"; -- -- if (xTickformat != "(A1)" && standardNumPos) xOpt += "nf"; -- if (xTickformat != "(A1)" && !standardNumPos) xOpt += "mf"; -- if (yTickformat != "(A1)" && standardNumPos) yOpt += "nf"; -- if (yTickformat != "(A1)" && !standardNumPos) yOpt += "mf"; -- -- if( xLog) xOpt += "l"; -- if( yLog) yOpt += "l"; -- -- if ((xStyle & 4) == 4) xOpt = ""; -- if ((yStyle & 4) == 4) yOpt = ""; -- -- string titleOpt; -- if (xAxis) { -- -- // axis titles -- actStream->schr( 0.0, actH/defH * xCharSize); -- if (standardNumPos) { titleOpt = "b"; } else { titleOpt = "t"; } -- actStream->mtex(titleOpt.c_str(),3.5,0.5,0.5,xTitle.c_str()); -- -- // the axis (separate for x and y axis because of charsize) -- PLFLT xintv; -- if (xTicks == 0) { -- xintv = AutoTick(xEnd-xStart); -- } else { -- xintv = (xEnd - xStart) / xTicks; -- } -- actStream->box( xOpt.c_str(), xintv, xMinor, "", 0.0, 0); - -- if (e->KeywordSet("SAVE")) -- { -- // X.CRANGE -- set_axis_crange("X", xStart, xEnd, xLog); -+ actStream->OnePageSaveLayout(); // one page - -- // X.TYPE -- set_axis_type("X",xLog); -+ actStream->vpor(vpXL, vpXR, vpYB, vpYT); -+ if (xLog) {xStart=log10(xStart);xEnd=log10(xEnd);} -+ if (yLog) {yStart=log10(yStart);yEnd=log10(yEnd);} -+ actStream->wind(xStart, xEnd, yStart, yEnd); -+ -+ if ( xAxis ) -+ { //special name "axisX" needed because we artificially changed size of box -+ gdlAxis(e, actStream, "axisX", xStart, xEnd, xLog, standardNumPos?1:2, ovpSizeY); - -- // X.S ... TODO: set_axis_s() -- DStructGDL* Struct=NULL; -- Struct = SysVar::X(); -- static unsigned sTag = Struct->Desc()->TagIndex( "S"); -- PLFLT p_xmin, p_xmax, p_ymin, p_ymax; -- actStream->gvpd (p_xmin, p_xmax, p_ymin, p_ymax); -- if(Struct != NULL) -- { -- (*static_cast( Struct->GetTag( sTag, 0)))[0] = -- (p_xmin*xEnd - p_xmax*xStart) / (xEnd - xStart); -- (*static_cast( Struct->GetTag( sTag, 0)))[1] = -- (p_xmax - p_xmin) / (xEnd - xStart); -- } -+ if ( e->KeywordSet("SAVE") ) -+ { -+ gdlStoreAxisCRANGE("X", xStart, xEnd, xLog); -+ gdlStoreAxisType("X", xLog); -+ gdlStoreAxisSandWINDOW(actStream, "X", xStart, xEnd, xLog); - } - } - -- if (yAxis) { -+ if ( yAxis ) -+ {//special name "axisY" needed because we artificially changed size of box -+ gdlAxis(e, actStream, "axisY", yStart, yEnd, yLog, standardNumPos?1:2, ovpSizeX); - -- // axis titles -- actStream->schr( 0.0, actH/defH * yCharSize); -- if (standardNumPos) { titleOpt = "l"; } else { titleOpt = "r"; } -- actStream->mtex(titleOpt.c_str(),5.0,0.5,0.5,yTitle.c_str()); -- -- // the axis (separate for x and y axis because of charsize) -- PLFLT yintv; -- if (yTicks == 0) { -- yintv = AutoTick(yEnd-yStart); -- } else { -- yintv = (yEnd - yStart) / yTicks; -- } -- actStream->box( "", 0.0, 0, yOpt.c_str(), yintv, yMinor); -- -- if (e->KeywordSet("SAVE")) -+ if ( e->KeywordSet("SAVE") ) - { -- // Y.CRANGE -- set_axis_crange("Y", yStart, yEnd, yLog); -- -- // Y.TYPE -- set_axis_type("Y",yLog); -- -- // Y.S ... TODO: set_axis_s() -- DStructGDL* Struct=NULL; -- Struct = SysVar::Y(); -- static unsigned sTag = Struct->Desc()->TagIndex( "S"); -- PLFLT p_xmin, p_xmax, p_ymin, p_ymax; -- actStream->gvpd (p_xmin, p_xmax, p_ymin, p_ymax); -- if(Struct != NULL) -- { -- (*static_cast( Struct->GetTag( sTag, 0)))[0] = -- (p_ymin*yEnd - p_ymax*yStart) / (yEnd - yStart); -- (*static_cast( Struct->GetTag( sTag, 0)))[1] = -- (p_ymax - p_ymin) / (yEnd - yStart); -- } -+ gdlStoreAxisCRANGE("Y", yStart, yEnd, yLog); -+ gdlStoreAxisType("Y", yLog); -+ gdlStoreAxisSandWINDOW(actStream, "Y", yStart, yEnd, yLog); - } - } -- - // reset the viewport and world coordinates to the original values -- actStream->vpor(vpXL, vpXR, vpYB, vpYT); -- actStream->wind(xStart, xEnd, yStart,yEnd); -- -- // title and sub title -- // axis has subtitle but no title, gkw_title requires both -- // gkw_title(e, actStream, actH/defH); -+ actStream->RestoreLayout(); - -- } // }}} -+ } - -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -+ private: void call_plplot(EnvT* e, GDLGStream* actStream) - { -- } // }}} -+ } - -- private: virtual void post_call(EnvT*, GDLGStream*) // {{{ -+ private: virtual void post_call(EnvT* e, GDLGStream* actStream) - { -- } // }}} -+ actStream->sizeChar(1.0); -+ } - -- }; // axis_call -+ }; - - void axis(EnvT* e) - { -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_contour.cpp gdl/src/plotting_contour.cpp ---- gdl-0.9.3/src/plotting_contour.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_contour.cpp 2013-07-31 09:41:44.179244862 -0600 -@@ -1,884 +1,942 @@ --/*************************************************************************** -- plotting.cpp - GDL routines for plotting -- ------------------- -- begin : July 22 2002 -- copyright : (C) 2002-2011 by Marc Schellens et al. -- email : m_schellens@users.sf.net -- ***************************************************************************/ -- --/*************************************************************************** -- * * -- * This program is free software; you can redistribute it and/or modify * -- * it under the terms of the GNU General Public License as published by * -- * the Free Software Foundation; either version 2 of the License, or * -- * (at your option) any later version. * -- * * -- ***************************************************************************/ -- --#include "includefirst.hpp" --#include "plotting.hpp" --#include "math_utl.hpp" -- --#ifdef _MSC_VER --#define isinf !_finite --#endif -- --namespace lib { -- -- using namespace std; -- -- struct mypltr_passinfo // {{{ -- { -- PLFLT spa[4]; --#ifdef USE_LIBPROJ4 -- PLFLT sx[2], sy[2]; -- LPTYPE* idata; -- XYTYPE* odata; -- PROJTYPE* ref; -- DDouble d_nan; -- bool mapSet; --#endif -- bool xLog; -- bool yLog; -- }; // }}} -- -- void mypltr(PLFLT x, PLFLT y, PLFLT *tx, PLFLT *ty, void *pltr_data) // {{{ -- { -- PLFLT tr[6]={0.0,0.0,0.0,0.0,0.0,0.0}; -- struct mypltr_passinfo *ptr = (mypltr_passinfo* )pltr_data; -- -- tr[0] = ptr->spa[0]; -- tr[4] = ptr->spa[1]; -- tr[2] = ptr->spa[2]; -- // tr[5] = ptr->spa[4]; -- tr[5] = ptr->spa[3]; -- -- // conversion from array indices to data coord -- x = tr[0] * x + tr[2]; -- y = tr[4] * y + tr[5]; -- -- // conversion from lon / lat to projected values (in normal coordinates) --#ifdef USE_LIBPROJ4 -- if (ptr->mapSet) -- { -- // Convert from lon/lat in degrees to radians -- ptr->idata->lam = x * DEG_TO_RAD; -- ptr->idata->phi = y * DEG_TO_RAD; -- -- // Convert from lon/lat in radians to data coord -- *ptr->odata = PJ_FWD(*ptr->idata, ptr->ref); -- x = ptr->odata->x; -- y = ptr->odata->y; -- -- // handling inf points (not sure if this is needed?) -- if (!isfinite(x) || !isfinite(y)) x = y = ptr->d_nan; -- } --#endif -- -- // assignment to pointers passed in arguments -- *tx = ptr->xLog ? log10(x) : x; -- *ty = ptr->yLog ? log10(y) : y; -- } // }}} -- -- class contour_call : public plotting_routine_call -- { -- DDoubleGDL *zVal, *yVal, *xVal; -- auto_ptr xval_guard, yval_guard, p0_guard; -- SizeT xEl, yEl, zEl; -- DDouble xStart, xEnd, yStart, yEnd, zStart, zEnd; -- bool xLog, yLog, zLog; -- bool overplot; -- -- private: bool handle_args( EnvT* e) // {{{ -- { -- if( nParam() == 1) -- { -- BaseGDL* p0 = e->GetNumericArrayParDefined( 0)->Transpose( NULL); -- -- zVal = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- p0_guard.reset( p0); // delete upon exit -- -- xEl = zVal->Dim(1); -- yEl = zVal->Dim(0); -- -- if(zVal->Rank() != 2) -- e->Throw( "Array must have 2 dimensions: " -- +e->GetParString(0)); -- -- xVal = new DDoubleGDL( dimension( xEl), BaseGDL::INDGEN); -- xval_guard.reset( xVal); // delete upon exit -- yVal = new DDoubleGDL( dimension( yEl), BaseGDL::INDGEN); -- yval_guard.reset( yVal); // delete upon exit -- } -- else if ( nParam() == 2 || nParam() > 3) -- { -- e->Throw( "Incorrect number of arguments."); -- } -- else -- { -- BaseGDL* p0 = e->GetNumericArrayParDefined( 0)->Transpose( NULL); -- zVal = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- p0_guard.reset( p0); // delete upon exit -- -- if(zVal->Dim(0) == 1) -- e->Throw( "Array must have 2 dimensions: " -- +e->GetParString(0)); -- -- xVal = e->GetParAs< DDoubleGDL>( 1); -- yVal = e->GetParAs< DDoubleGDL>( 2); -- -- if (xVal->Rank() > 2) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- -- if (yVal->Rank() > 2) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- -- if (xVal->Rank() == 1) { -- xEl = xVal->Dim(0); -- -- if(xEl != zVal->Dim(1)) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- } -- -- if (yVal->Rank() == 1) { -- yEl = yVal->Dim(0); -- -- if(yEl != zVal->Dim(0)) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- } -- -- if (xVal->Rank() == 2) { -- if((xVal->Dim(0) != zVal->Dim(1)) && (xVal->Dim(1) != zVal->Dim(0))) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- } -- -- if (yVal->Rank() == 2) { -- if((yVal->Dim(0) != zVal->Dim(1)) && (yVal->Dim(1) != zVal->Dim(0))) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- } -- } -- static int overplotKW = e->KeywordIx("OVERPLOT"); -- overplot = e->KeywordSet( overplotKW); -- -- return overplot; -- } // }}} -- -- private: void old_body( EnvT* e, GDLGStream* actStream) // {{{ -- { -- // !P -- DLong p_background, p_noErase, p_color, p_psym, p_linestyle; -- DFloat p_symsize, p_charsize, p_thick, p_ticklen; -- DString p_title, p_subTitle; -- -- GetPData( p_background, -- p_noErase, p_color, p_psym, p_linestyle, -- p_symsize, p_charsize, p_thick, -- p_title, p_subTitle, p_ticklen); -- -- // !X, !Y, !Z (also used below) -- static DStructGDL* xStruct = SysVar::X(); -- static DStructGDL* yStruct = SysVar::Y(); -- static DStructGDL* zStruct = SysVar::Z(); -- DLong xStyle, yStyle, zStyle; -- DString xTitle, yTitle, zTitle; -- DFloat x_CharSize, y_CharSize, z_CharSize; -- DFloat xMarginL; -- DFloat xMarginR; -- DFloat yMarginB; -- DFloat yMarginF; -- DFloat zMarginB; -- DFloat zMarginT; -- DFloat xTicklen; -- DFloat yTicklen; -- DFloat zTicklen; -- GetAxisData( xStruct, xStyle, xTitle, x_CharSize, xMarginL, xMarginR, -- xTicklen); -- GetAxisData( yStruct, yStyle, yTitle, y_CharSize, yMarginB, yMarginF, -- yTicklen); -- GetAxisData( zStruct, zStyle, zTitle, z_CharSize, zMarginB, zMarginT, -- zTicklen); -- -- // [XY]STYLE -- e->AssureLongScalarKWIfPresent( "XSTYLE", xStyle); -- e->AssureLongScalarKWIfPresent( "YSTYLE", yStyle); -- e->AssureLongScalarKWIfPresent( "ZSTYLE", zStyle); -- -- // TITLE -- DString title = p_title; -- DString subTitle = p_subTitle; -- e->AssureStringScalarKWIfPresent( "TITLE", title); -- e->AssureStringScalarKWIfPresent( "SUBTITLE", subTitle); -- -- // AXIS TITLE -- e->AssureStringScalarKWIfPresent( "XTITLE", xTitle); -- e->AssureStringScalarKWIfPresent( "YTITLE", yTitle); -- e->AssureStringScalarKWIfPresent( "ZTITLE", zTitle); -- -- // MARGIN (in characters) -- static int xMarginEnvIx = e->KeywordIx( "XMARGIN"); -- static int yMarginEnvIx = e->KeywordIx( "YMARGIN"); -- static int zMarginEnvIx = e->KeywordIx( "ZMARGIN"); -- BaseGDL* xMargin = e->GetKW( xMarginEnvIx); -- BaseGDL* yMargin = e->GetKW( yMarginEnvIx); -- BaseGDL* zMargin = e->GetKW( zMarginEnvIx); -- if( xMargin != NULL) -- { -- if( xMargin->N_Elements() > 2) -- e->Throw( "Keyword array parameter XMARGIN" -- " must have from 1 to 2 elements."); -- auto_ptr guard; -- DFloatGDL* xMarginFl = static_cast -- ( xMargin->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( xMarginFl); -- xMarginL = (*xMarginFl)[0]; -- if( xMarginFl->N_Elements() > 1) -- xMarginR = (*xMarginFl)[1]; -- } -- if( yMargin != NULL) -- { -- if( yMargin->N_Elements() > 2) -- e->Throw( "Keyword array parameter YMARGIN" -- " must have from 1 to 2 elements."); -- auto_ptr guard; -- DFloatGDL* yMarginFl = static_cast -- ( yMargin->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( yMarginFl); -- yMarginB = (*yMarginFl)[0]; -- if( yMarginFl->N_Elements() > 1) -- yMarginF = (*yMarginFl)[1]; -- } -- if( zMargin != NULL) -- { -- if( zMargin->N_Elements() > 2) -- e->Throw( "Keyword array parameter ZMARGIN" -- " must have from 1 to 2 elements."); -- auto_ptr guard; -- DFloatGDL* zMarginFl = static_cast -- ( zMargin->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( zMarginFl); -- zMarginB = (*zMarginFl)[0]; -- if( zMarginFl->N_Elements() > 1) -- zMarginT = (*zMarginFl)[1]; -- } -- -- // x and y and z range -- GetMinMaxVal( xVal, &xStart, &xEnd); -- GetMinMaxVal( yVal, &yStart, &yEnd); -- GetMinMaxVal( zVal, &zStart, &zEnd); -- -- xLog = e->KeywordSet( "XLOG"); -- yLog = e->KeywordSet( "YLOG"); -- zLog = e->KeywordSet( "ZLOG"); -- -- if ((xStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(xStart, xEnd, false, xLog ); -- } -- -- if ((yStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(yStart, yEnd, false, yLog ); -- } -- -- if ((zStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(zStart, zEnd, false, zLog ); -- } -- -- //[x|y|z]range keyword -- static int zRangeEnvIx = e->KeywordIx("ZRANGE"); -- static int yRangeEnvIx = e->KeywordIx("YRANGE"); -- static int xRangeEnvIx = e->KeywordIx("XRANGE"); -- BaseGDL* xRange = e->GetKW( xRangeEnvIx); -- BaseGDL* yRange = e->GetKW( yRangeEnvIx); -- BaseGDL* zRange = e->GetKW( zRangeEnvIx); -- -- if(xRange != NULL) -- { -- if(xRange->N_Elements() != 2) -- e->Throw("Keyword array parameter XRANGE" -- " must have 2 elements."); -- auto_ptr guard; -- DFloatGDL* xRangeF = static_cast -- ( xRange->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( xRangeF); -- xStart = (*xRangeF)[0]; -- xEnd = (*xRangeF)[1]; -- } -- -- if(yRange != NULL) -- { -- if(yRange->N_Elements() != 2) -- e->Throw("Keyword array parameter YRANGE" -- " must have 2 elements."); -- auto_ptr guard; -- DFloatGDL* yRangeF = static_cast -- ( yRange->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( yRangeF); -- yStart = (*yRangeF)[0]; -- yEnd = (*yRangeF)[1]; -- } -- if(zRange != NULL) -- { -- if(zRange->N_Elements() != 2) -- e->Throw("Keyword array parameter ZRANGE" -- " must have 2 elements."); -- auto_ptr guard; -- DFloatGDL* zRangeF = static_cast -- ( zRange->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( zRangeF); -- zStart = (*zRangeF)[0]; -- zEnd = (*zRangeF)[1]; -- } -- -- bool mapSet = false; --#ifdef USE_LIBPROJ4 -- get_mapset(mapSet); --#endif -- -- DDouble minVal = zStart; -- DDouble maxVal = zEnd; -- e->AssureDoubleScalarKWIfPresent( "MIN_VALUE", minVal); -- e->AssureDoubleScalarKWIfPresent( "MAX_VALUE", maxVal); -- -- // AC july 2008 please remember that data sweep out by that -- // are really processed like MISSING data (NaN ...) -- if (minVal > zStart) cout << "This MIN_VALUE is not ready, sorry. Help welcome." <AssureLongScalarKWIfPresent( "ISOTROPIC", iso); -- -- DLong xTicks=0, yTicks=0, zTicks=0; -- e->AssureLongScalarKWIfPresent( "XTICKS", xTicks); -- e->AssureLongScalarKWIfPresent( "YTICKS", yTicks); -- e->AssureLongScalarKWIfPresent( "ZTICKS", zTicks); -- -- DLong xMinor=0, yMinor=0, zMinor=0; -- e->AssureLongScalarKWIfPresent( "XMINOR", xMinor); -- e->AssureLongScalarKWIfPresent( "YMINOR", yMinor); -- e->AssureLongScalarKWIfPresent( "ZMINOR", zMinor); -- -- DString xTickformat, yTickformat, zTickformat; -- e->AssureStringScalarKWIfPresent( "XTICKFORMAT", xTickformat); -- e->AssureStringScalarKWIfPresent( "YTICKFORMAT", yTickformat); -- e->AssureStringScalarKWIfPresent( "ZTICKFORMAT", zTickformat); -- -- if( xLog && xStart <= 0.0) -- Warning( "CONTOUR: Infinite x plot range."); -- if( yLog && yStart <= 0.0) -- Warning( "CONTOUR: Infinite y plot range."); -- if( zLog && zStart <= 0.0) -- Warning( "CONTOUR: Infinite z plot range."); -- -- DDouble ticklen = p_ticklen; -- e->AssureDoubleScalarKWIfPresent( "TICKLEN", ticklen); -- -- DLong noErase = p_noErase; -- if( e->KeywordSet( "NOERASE")) noErase = 1; -- -- // POSITION -- PLFLT xScale = 1.0; -- PLFLT yScale = 1.0; -- // PLFLT scale = 1.0; -- static int positionIx = e->KeywordIx( "POSITION"); -- DFloatGDL* pos = e->IfDefGetKWAs( positionIx); -- if (pos == NULL) pos = (DFloatGDL*) 0xF; -- /* -- PLFLT position[ 4] = { 0.0, 0.0, 1.0, 1.0}; -- if( pos != NULL) -- { -- for( SizeT i=0; i<4 && iN_Elements(); ++i) -- position[ i] = (*pos)[ i]; -- -- xScale = position[2]-position[0]; -- yScale = position[3]-position[1]; -- // scale = sqrt( pow( xScale,2) + pow( yScale,2)); -- } -- */ -- -- // CHARSIZE -- DDouble charsize = p_charsize; -- e->AssureDoubleScalarKWIfPresent( "CHARSIZE", charsize); -- if( charsize <= 0.0) charsize = 1.0; -- // charsize *= scale; -- -- // AXIS CHARSIZE -- DDouble xCharSize = x_CharSize; -- e->AssureDoubleScalarKWIfPresent( "XCHARSIZE", xCharSize); -- if( xCharSize <= 0.0) xCharSize = 1.0; -- -- DDouble yCharSize = y_CharSize; -- e->AssureDoubleScalarKWIfPresent( "YCHARSIZE", yCharSize); -- if( yCharSize <= 0.0) yCharSize = 1.0; -- // yCharSize *= scale; -- -- DDouble zCharSize = z_CharSize; -- e->AssureDoubleScalarKWIfPresent( "ZCHARSIZE", zCharSize); -- if( zCharSize <= 0.0) zCharSize = 1.0; -- -- -- // THICK -- DFloat thick = p_thick; -- e->AssureFloatScalarKWIfPresent( "THICK", thick); -- -- // CHARTHICK (thickness of "char") -- PLINT charthick=1; -- -- DDouble *sx, *sy; -- DFloat *wx, *wy; -- GetSFromPlotStructs(&sx, &sy); -- GetWFromPlotStructs(&wx, &wy); -- -- // mapping only in OVERPLOT mode -- if (!overplot) set_mapset(0); -- -- if (overplot) -- { -- //rewrite these quantities -- if (!mapSet) -- { -- get_axis_crange("X", xStart, xEnd); -- get_axis_crange("Y", yStart, yEnd); -- } -- else -- { -- DataCoordLimits(sx, sy, wx, wy, &xStart, &xEnd, &yStart, &yEnd, true); -- } -- get_axis_margin("X",xMarginL, xMarginR); -- get_axis_margin("Y",yMarginB, yMarginF); -- get_axis_type("X", xLog); -- get_axis_type("Y", yLog); -- DFloat charsizeF; -- gkw_charsize(e,actStream, charsizeF, false); -- charsize=charsizeF; -- pos = NULL; -- } -- -- // *** start drawing -- gkw_background(e, actStream); //BACKGROUND -- gkw_color(e, actStream); //COLOR -- -- if (!overplot) { -- actStream->NextPlot( !noErase); -- if( !noErase) actStream->Clear(); -- } -- -- // plplot stuff -- // set the charsize (scale factor) -- DDouble charScale = 1.0; -- DLongGDL* pMulti = SysVar::GetPMulti(); -- if( (*pMulti)[1] > 2 || (*pMulti)[2] > 2) charScale = 0.5; -- actStream->schr( 0.0, charsize * charScale); -- --#if 0 -- // get subpage in mm -- PLFLT scrXL, scrXR, scrYB, scrYF; -- actStream->gspa( scrXL, scrXR, scrYB, scrYF); -- PLFLT scrX = scrXR-scrXL; -- PLFLT scrY = scrYF-scrYB; --#endif -- -- // get char size in mm (default, actual) -- PLFLT defH, actH; -- actStream->gchr( defH, actH); -- -- // CLIPPING -- DDoubleGDL* clippingD=NULL; -- DLong noclip=0; -- e->AssureLongScalarKWIfPresent( "NOCLIP", noclip); -- if(noclip == 0) -- { -- static int clippingix = e->KeywordIx( "CLIP"); -- clippingD = e->IfDefGetKWAs( clippingix); -- } -- -- if (!overplot || !mapSet) -- { -- // viewport and world coordinates -- bool okVPWC = SetVP_WC( e, actStream, overplot?NULL:pos, clippingD, -- xLog, yLog, -- xMarginL, xMarginR, yMarginB, yMarginF, -- xStart, xEnd, yStart, yEnd, iso); -- if( !okVPWC) return; -- } else { -- // not using SetVP_WC as it seem to always select full window for plotting (FIXME) -- actStream->NoSub(); -- actStream->vpor(wx[0], wx[1], wy[0], wy[1]); -- actStream->wind( xStart, xEnd, yStart, yEnd); -- } -- -- // managing the levels list OR the nlevels value -- -- PLINT nlevel; -- PLFLT *clevel; -- ArrayGuard clevel_guard; -- -- // we need to define the NaN value -- static DStructGDL *Values = SysVar::Values(); -- DDouble d_nan=(*static_cast(Values->GetTag(Values->Desc()->TagIndex("D_NAN"), 0)))[0]; -- -- static int levelsix = e->KeywordIx( "LEVELS"); -- -- BaseGDL* b_levels=e->GetKW(levelsix); -- if(b_levels != NULL) { -- DDoubleGDL* d_levels = e->GetKWAs( levelsix); -- nlevel = d_levels->N_Elements(); -- clevel = (PLFLT *) &(*d_levels)[0]; -- // are the levels ordered ? -- for ( SizeT i=1; iThrow( "Contour levels must be in increasing order."); -- } -- } else { -- PLFLT zintv; -- // Jo: added keyword NLEVELS -- if (e->KeywordSet( "NLEVELS")) { -- DLong l_nlevel = nlevel; // GCC 3.4.4 needs that -- e->AssureLongScalarKWIfPresent( "NLEVELS", l_nlevel); -- nlevel = l_nlevel; -- if (nlevel <= 0) nlevel= 2; // AC: mimication of IDL -- -- // cokhavim: IDL does this... -- zintv = (PLFLT) ((zEnd - zStart) / (nlevel+1)); -- // ... but I think this is better: -- // if (e->KeywordSet( "FILL")) zintv = (PLFLT) ((zEnd - zStart) / (nlevel)); -- // else zintv = (PLFLT) ((zEnd - zStart) / (nlevel+1)); -- -- // SA: this indeed seems better in some cases; however, it makes calls -- // with and without the /FILL keyword behave differently. As a result, -- // when overlaing contours over a filled contour, the contours do not match, e.g.: -- // a=dist(7) & contour,a,/fill,nl=5 & contour,a,/over,/foll,nl=5 -- -- } else { -- zintv = AutoTick(zEnd - zStart); -- nlevel = (PLINT) floor((zEnd - zStart) / zintv); -- // SA: sanity check to prevent segfaults, e.g. with solely non-finite values -- if (zintv == 0 || nlevel < 0) nlevel = 0; -- } -- -- --// clevel = new PLFLT[nlevel+1]; --// clevel_guard.Reset( clevel); --// // Jo: fixed clevel to account for non-zero zMin --// for( SizeT i=1; i<=nlevel; i++) clevel[i-1] = zintv * (i-1) + zStart; --// //for( SizeT i=0; i<=nlevel; i++) clevel[i] = zintv * i + zStart; --DDouble offset=0.; --if (e->KeywordSet( "FILL")) { nlevel = nlevel + 1; offset=zintv;} --clevel = new PLFLT[nlevel]; --clevel_guard.Reset( clevel); --//IDL does this: --// for( SizeT i=1; i<=nlevel; i++) clevel[i-1] = zintv * i + zStart; --//but I think this is better: --for( SizeT i=1; i<=nlevel; i++) clevel[i-1] = zintv * i + zStart - offset; --clevel[nlevel-1]=zEnd; //make this explicit -- -- } -- --// // Jo: added keyword FILL -- -- PLINT &nlevel_fill = nlevel; -- PLFLT* &clevel_fill = clevel; -- --// PLFLT *clevel_fill; --// ArrayGuard clevel_fill_guard; --// PLINT nlevel_fill; --// if (e->KeywordSet( "FILL")) { --// // To ensure that the highest level is filled, define a new --// // clevel to include highest value of z: --// // modif by AC to manage the exception (nlevel=1) --// if (nlevel > 1) { --// nlevel_fill=nlevel+1; --// clevel_fill = new PLFLT[nlevel_fill]; --// clevel_fill_guard.Reset( clevel_fill); --// clevel_fill[nlevel_fill-1] = clevel[nlevel - 1] < zEnd ? zEnd : clevel[nlevel - 1] + 1.; --// for( SizeT i=0; i zStart ? zStart : clevel[0] - 1.; --// clevel_fill[1] = clevel[0]; --// clevel_fill[2] = clevel[0] < zEnd ? zEnd : clevel[0] + 1.; --// } -- --// } -- --// // levels outside limits are changed ... --// for (SizeT i=0; i<=nlevel; i++) { --// if (clevel[i] < zStart) clevel[i]=zStart; --// if (clevel[i] > zEnd) clevel[i]=zEnd; --// } -- -- // pen thickness for plot -- actStream->wid( static_cast(floor( thick-0.5))); -- -- // labeling -- bool label = false; -- if (e->KeywordSet("FOLLOW") || e->KeywordSet("C_CHARSIZE")) label = true; -- // TODO: if (e->KeywordSet("C_ANNOTATION") || e->KeywordSet("C_CHARTHICK") || e->KeywordSet("C_LABELS")) label = true; -- if (e->KeywordSet("FILL")) label = false; -- if (label) -- { -- // IDL default: 3/4 of the axis charsize (CHARSIZE keyword or !P.CHARSIZE) -- // PlPlot default: .3 -- DFloat label_size = .75 * charsize; -- if (e->KeywordSet("C_CHARSIZE")) e->AssureFloatScalarKWIfPresent("C_CHARSIZE", label_size); -- //usage: setcontlabelparam(PLFLT offset, PLFLT size, PLFLT spacing, PLINT active); -- actStream->setcontlabelparam(0.0, (PLFLT)label_size, .3, true); -- } -- --#ifdef USE_LIBPROJ4 -- static LPTYPE idata; -- static XYTYPE odata; -- static PROJTYPE* ref; -- if (mapSet) -- { -- ref = map_init(); -- if ( ref == NULL) e->Throw( "Projection initialization failed."); -- } --#endif -- -- // starting plotting the data -- struct mypltr_passinfo passinfo; -- -- static int c_colorsIx = e->KeywordIx("C_COLORS"); -- static int c_linestyleIx = e->KeywordIx("C_LINESTYLE"); -- // 1 DIM X & Y -- if (xVal->Rank() == 1 && yVal->Rank() == 1) -- { -- PLFLT spa[4]; -- -- // don't forgot we have to use the real limits, not the adjusted ones -- DDouble xMin, xMax, yMin, yMax; -- GetMinMaxVal( xVal, &xMin, &xMax); -- GetMinMaxVal( yVal, &yMin, &yMax); -- -- passinfo.spa[0] = (xMax - xMin) / (xEl - 1); -- passinfo.spa[1] = (yMax - yMin) / (yEl - 1); -- passinfo.spa[2] = xMin; -- passinfo.spa[3] = yMin; -- passinfo.xLog = xLog; -- passinfo.yLog = yLog; -- --#ifdef USE_LIBPROJ4 -- passinfo.mapSet = mapSet; -- if (mapSet) // which imposes overplotting -- { -- passinfo.idata = &idata; -- passinfo.odata = &odata; -- passinfo.ref = ref; -- passinfo.d_nan = d_nan; -- -- passinfo.sx[0] = sx[0]; -- passinfo.sx[1] = sx[1]; -- passinfo.sy[0] = sy[0]; -- passinfo.sy[1] = sy[1]; -- } --#endif -- -- PLFLT** z = new PLFLT*[xEl]; -- for( SizeT i=0; i maxVal) (*z)[i]= d_nan; -- // } -- //} -- -- // gkw_linestyle(e, actStream); -- //actStream->lsty(2); -- // -- // AC 18 juin 2007 LineStyle and contour -- // NOT READY NOW -- // here we plot the axis -- // actStream->cont(z, xEl, yEl, 1, xEl, 1, yEl, -- // clevel, 0, mypltr, static_cast( spa)); -- // we recover the linestyle if a !p.linestyle does exist -- //gkw_linestyle_c(e, actStream, TRUE); -- -- -- if (e->KeywordSet( "FILL")) { -- // the "clevel_fill, nlevel_fill" have been computed before -- actStream->shades(z, xEl, yEl, NULL, xStart, xEnd, yStart, yEnd, -- clevel_fill, nlevel_fill, 2, 0, 0, plstream::fill, -- mapSet, mypltr, static_cast(&passinfo)); -- -- gkw_color(e, actStream);//needs to be called again or else PS files look wrong -- // Redraw the axes just in case the filling overlaps them -- //actStream->box( xOpt.c_str(), xintv, xMinor, "", 0.0, 0); -- //actStream->box( "", 0.0, 0, yOpt.c_str(), yintv, yMinor); -- // pen thickness for axis -- actStream->wid(charthick); -- } else { -- if (e->GetKW(c_colorsIx) != NULL) -- { -- DLongGDL *colors = e->GetKWAs(c_colorsIx); -- for (SizeT i = 0; i < nlevel; ++i) -- { -- actStream->Color((*colors)[i % colors->N_Elements()], true, 2); -- actStream->cont(z, xEl, yEl, 1, xEl, 1, yEl, &(clevel[i]), 1, mypltr, static_cast(&passinfo)); -- } -- } -- else -- { -- actStream->cont(z, xEl, yEl, 1, xEl, 1, yEl, clevel, nlevel, mypltr, static_cast(&passinfo)); -- } -- } -- delete[] z; -- } -- else if (xVal->Rank() == 2 && yVal->Rank() == 2) -- { -- // FIXME: mapping not supported here yet -- -- PLcGrid2 cgrid2; -- actStream->Alloc2dGrid(&cgrid2.xg,xVal->Dim(0),xVal->Dim(1)); -- actStream->Alloc2dGrid(&cgrid2.yg,xVal->Dim(0),xVal->Dim(1)); -- cgrid2.nx = xVal->Dim(0); -- cgrid2.ny = xVal->Dim(1); -- -- for( SizeT i=0; iDim(0); i++) { -- for( SizeT j=0; jDim(1); j++) { -- cgrid2.xg[i][j] = (*xVal)[j*(xVal->Dim(0))+i]; -- cgrid2.yg[i][j] = (*yVal)[j*(xVal->Dim(0))+i]; -- } -- } -- -- PLFLT** z = new PLFLT*[xVal->Dim(0)]; -- for( SizeT i=0; iDim(0); i++) z[i] = &(*zVal)[i*xVal->Dim(1)]; -- -- for( SizeT i=0; iDim(0)*xVal->Dim(1); i++) { -- if (isinf((*zVal)[i])) (*z)[i]= d_nan; -- } -- -- if (e->KeywordSet( "FILL")) { -- // the "clevel_fill, nlevel_fill" have been computed before -- actStream->shades(z, xVal->Dim(0), xVal->Dim(1), -- NULL, xStart, xEnd, yStart, yEnd, -- clevel_fill, nlevel_fill, 2, 0, 0, plstream::fill, -- false, plstream::tr2, (void *) &cgrid2 ); -- -- gkw_color(e, actStream);//needs to be called again or else PS files look wrong -- // Redraw the axes just in case the filling overlaps them -- //actStream->box( xOpt.c_str(), xintv, xMinor, "", 0.0, 0); -- //actStream->box( "", 0.0, 0, yOpt.c_str(), yintv, yMinor); -- // pen thickness for axis -- actStream->wid(charthick); -- } else { -- if (e->GetKW(c_colorsIx) != NULL) -- { -- DLongGDL *colors = e->GetKWAs(c_colorsIx); -- for (SizeT i = 0; i < nlevel; ++i) -- { -- actStream->Color((*colors)[i % colors->N_Elements()], true, 2); -- actStream->cont(z, xVal->Dim(0), xVal->Dim(1), 1, xVal->Dim(0), 1, xVal->Dim(1), &(clevel[i]), 1, plstream::tr2, (void *) &cgrid2); -- } -- } -- else -- { -- actStream->cont(z, xVal->Dim(0), xVal->Dim(1), 1, xVal->Dim(0), 1, xVal->Dim(1), clevel, nlevel, plstream::tr2, (void *) &cgrid2); -- } -- } -- actStream->Free2dGrid(cgrid2.xg,xVal->Dim(0),xVal->Dim(1)); -- actStream->Free2dGrid(cgrid2.yg,xVal->Dim(0),xVal->Dim(1)); -- -- // AC june 07 : symetry for the previous case -- delete[] z; -- } -- -- //Draw axes after the data because /fill could potentially overlap the axes. -- //... if keyword "OVERPLOT" is not set -- if (!overplot) -- { -- gkw_background(e, actStream); //BACKGROUND -- gkw_color(e, actStream); //COLOR -- -- // pen thickness for axis -- actStream->wid( 0); -- -- // axis -- string xOpt = "bcnst"; -- string yOpt = "bcnstv"; -- -- DString xTickformat, yTickformat; -- e->AssureStringScalarKWIfPresent( "XTICKFORMAT", xTickformat); -- e->AssureStringScalarKWIfPresent( "YTICKFORMAT", yTickformat); -- AdjustAxisOpts(xOpt, yOpt, xStyle, yStyle, xTicks, yTicks, xTickformat, yTickformat, xLog, yLog); -- -- // axis titles -- actStream->schr( 0.0, actH/defH * xCharSize); -- actStream->mtex("b",3.5,0.5,0.5,xTitle.c_str()); -- -- // the axis (separate for x and y axis because of charsize) -- PLFLT xintv; -- if (xTicks == 0) { -- xintv = AutoTick(xEnd-xStart); -- } else { -- xintv = (xEnd - xStart) / xTicks; -- } -- //Draw axis if keyword "OVERPLOT" is not set -- actStream->box( xOpt.c_str(), xintv, xMinor, "", 0.0, 0); -- actStream->schr( 0.0, actH/defH * yCharSize); -- actStream->mtex("l",5.0,0.5,0.5,yTitle.c_str()); -- -- // the axis (separate for x and y axis because of charsize) -- PLFLT yintv; -- if (yTicks == 0) { -- yintv = AutoTick(yEnd-yStart); -- } else { -- yintv = (yEnd - yStart) / yTicks; -- } -- actStream->box( "", 0.0, 0, yOpt.c_str(), yintv, yMinor); -- -- // title and sub title -- actStream->schr( 0.0, 1.25*actH/defH); -- actStream->mtex("t",1.25,0.5,0.5,title.c_str()); -- actStream->schr( 0.0, actH/defH); // charsize is reset here -- actStream->mtex("b",5.4,0.5,0.5,subTitle.c_str()); -- -- } -- } // }}} -- -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -- { -- } // }}} -- -- private: virtual void post_call(EnvT*, GDLGStream* actStream) // {{{ -- { -- UpdateSWPlotStructs(actStream, xStart, xEnd, yStart, yEnd, xLog, yLog); -- -- actStream->lsty(1);//reset linestyle -- -- if (!overplot) -- { -- // set ![XY].CRANGE -- set_axis_crange("X", xStart, xEnd, xLog); -- set_axis_crange("Y", yStart, yEnd, yLog); -- -- //set ![x|y].type -- set_axis_type("X",xLog); -- set_axis_type("Y",yLog); -- } -- } // }}} -- -- }; // contour_call class -- -- void contour(EnvT* e) -- { -- contour_call contour; -- contour.call(e, 1); -- } -- --} // namespace -+/*************************************************************************** -+ plotting.cpp - GDL routines for plotting -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002-2011 by Marc Schellens et al. -+ email : m_schellens@users.sf.net -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#include "includefirst.hpp" -+#include "plotting.hpp" -+#include "math_utl.hpp" -+ -+#define LABELOFFSET 0.003 -+#define LABELSPACING 0.25 -+ -+namespace lib -+{ -+ -+ using namespace std; -+ -+// shared parameter -+ static bool xLog; -+ static bool yLog; -+ -+ PLINT doIt( PLFLT x, PLFLT y ) -+ { -+ if (xLog && x<=0 ) return 0; -+ if (yLog && y<=0 ) return 0; -+ return 1; -+ } -+ -+ class contour_call: public plotting_routine_call -+ { -+ -+ DDoubleGDL *zVal, *yVal, *xVal; -+ Guard xval_guard, yval_guard, p0_guard; -+ DDoubleGDL *yValTemp, *xValTemp; -+ Guard xval_temp_guard, yval_temp_guard; -+ SizeT xEl, yEl, zEl; -+ DDouble xStart, xEnd, yStart, yEnd, zStart, zEnd, datamax, datamin; -+ bool zLog, isLog; -+ bool overplot, make2dBox, make3dBox, nodata; -+ DLongGDL *colors,*thick,*labels,*style; -+ Guard colors_guard,thick_guard,labels_guard,style_guard; -+ DFloatGDL *spacing,*orientation; -+ Guard spacing_guard,orientation_guard; -+ bool doT3d; -+ bool irregular; -+ bool setZrange; -+ -+ //PATH_XY etc: use actStream->stransform with a crafted recording function per level [lev-maxmax]. -+ //disentangle positive and negative contours with their rotation signature. -+ private: -+ bool handle_args (EnvT* e) -+ { -+ static int irregIx = e->KeywordIx( "IRREGULAR"); -+ irregular=e->KeywordSet(irregIx); -+ if ( nParam ( )==1 ) -+ { -+ BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL ); -+ -+ zVal=static_cast -+ ( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) ); -+ p0_guard.Init ( p0 ); // delete upon exit -+ -+ xEl=zVal->Dim ( 1 ); -+ yEl=zVal->Dim ( 0 ); -+ -+ if ( zVal->Rank ( )!=2 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ -+ xVal=new DDoubleGDL ( dimension ( xEl ), BaseGDL::INDGEN ); -+ xval_guard.Init ( xVal ); // delete upon exit -+ yVal=new DDoubleGDL ( dimension ( yEl ), BaseGDL::INDGEN ); -+ yval_guard.Init ( yVal ); // delete upon exit -+ } -+ else if ( nParam ( )==2||nParam ( )>3 ) -+ { -+ e->Throw ( "Incorrect number of arguments." ); -+ } -+ else if (irregular) -+ { -+ //ZVal will be treated as 1 dim array and X and Y must have the same number of elements. -+ BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL ); -+ zVal=static_cast -+ ( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) ); -+ p0_guard.Init( p0 ); // delete upon exit -+ xValTemp=e->GetParAs< DDoubleGDL>( 1 ); -+ yValTemp=e->GetParAs< DDoubleGDL>( 2 ); -+ -+ if (xValTemp->N_Elements() != zVal->N_Elements() ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ if (yValTemp->N_Elements() != zVal->N_Elements() ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ //x-y ranges: -+ DDouble xmin,xmax,ymin,ymax; -+ GetMinMaxVal ( xValTemp, &xmin, &xmax ); -+ GetMinMaxVal ( yValTemp, &ymin, &ymax ); -+ xEl=xValTemp->N_Elements()+1; -+ yEl=yValTemp->N_Elements()+1; //all points inside -+ xVal=new DDoubleGDL ( dimension ( xEl ), BaseGDL::NOZERO ); -+ yVal=new DDoubleGDL ( dimension ( yEl ), BaseGDL::NOZERO ); -+ for(SizeT i=0; iGetNumericArrayParDefined ( 0 )->Transpose ( NULL ); -+ zVal=static_cast -+ ( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) ); -+ p0_guard.Init( p0 ); // delete upon exit -+ -+ if ( zVal->Dim ( 0 )==1 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ -+ xVal=e->GetParAs< DDoubleGDL>( 1 ); -+ yVal=e->GetParAs< DDoubleGDL>( 2 ); -+ -+ if ( xVal->Rank ( )>2 ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ -+ if ( yVal->Rank ( )>2 ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ if ( xVal->Rank ( )==0 || yVal->Rank ( )==0 ) e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ -+ if ( xVal->Rank ( )==1 ) -+ { -+ xEl=xVal->Dim ( 0 ); -+ -+ if ( xEl!=zVal->Dim ( 1 ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ } -+ -+ if ( yVal->Rank ( )==1 ) -+ { -+ yEl=yVal->Dim ( 0 ); -+ -+ if ( yEl!=zVal->Dim ( 0 ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ } -+ -+ if ( xVal->Rank ( )==2 ) -+ { -+ xEl=xVal->Dim ( 0 ); -+ if ( ( xVal->Dim ( 0 )!=zVal->Dim ( 1 ) )&&( xVal->Dim ( 1 )!=zVal->Dim ( 0 ) ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ } -+ -+ if ( yVal->Rank ( )==2 ) -+ { -+ yEl=yVal->Dim ( 1 ); -+ if ( ( yVal->Dim ( 0 )!=zVal->Dim ( 1 ) )&&( yVal->Dim ( 1 )!=zVal->Dim ( 0 ) ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ } -+ } -+ -+ GetMinMaxVal ( xVal, &xStart, &xEnd ); -+ GetMinMaxVal ( yVal, &yStart, &yEnd ); -+ //XRANGE and YRANGE overrides all that, but Start/End should be recomputed accordingly -+ DDouble xAxisStart, xAxisEnd, yAxisStart, yAxisEnd; -+ bool setx=gdlGetDesiredAxisRange(e, "X", xAxisStart, xAxisEnd); -+ bool sety=gdlGetDesiredAxisRange(e, "Y", yAxisStart, yAxisEnd); -+ if(setx && sety) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+ } -+ else if (sety) -+ { -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+ } -+ else if (setx) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ //must compute min-max for other axis! -+ { -+ gdlDoRangeExtrema(xVal,yVal,yStart,yEnd,xStart,xEnd); -+ } -+ } -+ // z range -+ datamax=0.0; -+ datamin=0.0; -+ GetMinMaxVal ( zVal, &datamin, &datamax ); -+ zStart=datamin; -+ zEnd=datamax; -+ setZrange = gdlGetDesiredAxisRange(e, "Z", zStart, zEnd); -+ -+ return false; -+ } -+ -+ private: -+ -+ void old_body (EnvT* e, GDLGStream* actStream) // {{{ -+ { -+ // we need to define the NaN value -+ static DStructGDL *Values=SysVar::Values ( ); -+ static DDouble d_nan=( *static_cast ( Values->GetTag ( Values->Desc ( )->TagIndex ( "D_NAN" ), 0 ) ) )[0]; -+ static DDouble minmin=gdlAbsoluteMinValueDouble(); -+ static DDouble maxmax=gdlAbsoluteMaxValueDouble(); -+ //for 3D -+ DDoubleGDL* plplot3d; -+ DDouble az, alt, ay, scale; -+ ORIENTATION3D axisExchangeCode; -+ -+ //projection: would work only with 2D X and Y. -+ bool mapSet=false; -+#ifdef USE_LIBPROJ4 -+ static LPTYPE idata; -+ static XYTYPE odata; -+ static PROJTYPE* ref; -+ get_mapset ( mapSet ); -+ if ( mapSet ) -+ { -+ ref=map_init ( ); -+ if ( ref==NULL ) e->Throw ( "Projection initialization failed." ); -+ } -+#endif -+ //T3D -+ static int t3dIx = e->KeywordIx( "T3D"); -+ doT3d=(e->KeywordSet(t3dIx)|| T3Denabled(e)); -+ //ZVALUE -+ static int zvIx = e->KeywordIx( "ZVALUE"); -+ DDouble zValue=0.0; -+ bool hasZvalue=false; -+ if( e->KeywordPresent(zvIx)) -+ { -+ e->AssureDoubleScalarKW( zvIx, zValue ); -+ zValue=min(zValue,0.999999); //to avoid problems with plplot -+ zValue=max(zValue,0.0); -+ hasZvalue=true; -+ } -+ //NODATA -+ int nodataIx = e->KeywordIx( "NODATA"); -+ nodata=e->KeywordSet(nodataIx); -+ //We could RECORD PATH this way. Not developed since PATH_INFO seems not to be used -+ bool recordPath; -+ int pathinfoIx = e->KeywordIx( "PATH_INFO"); -+ int pathxyIx= e->KeywordIx( "PATH_XY"); -+ recordPath=(e->KeywordSet(pathinfoIx)||e->KeywordSet(pathxyIx)); -+ if (recordPath) -+ { -+ Warning( "PATH_INFO, PATH_XY not yet supported, (FIXME)"); -+ recordPath=false; -+ } -+ //recordPath--> use actStream->stransform(myrecordingfunction, &data); -+ //ISOTROPIC -+ DLong iso=0; -+ e->AssureLongScalarKWIfPresent( "ISOTROPIC", iso); -+ -+ // [XY]STYLE -+ DLong xStyle=0, yStyle=0, zStyle=0; ; -+ gdlGetDesiredAxisStyle(e, "X", xStyle); -+ gdlGetDesiredAxisStyle(e, "Y", yStyle); -+ gdlGetDesiredAxisStyle(e, "Z", zStyle); -+ -+ // MARGIN -+ DFloat xMarginL, xMarginR, yMarginB, yMarginT, zMarginF, zMarginB; -+ gdlGetDesiredAxisMargin(e, "X", xMarginL, xMarginR); -+ gdlGetDesiredAxisMargin(e, "Y", yMarginB, yMarginT); -+ gdlGetDesiredAxisMargin(e, "Z", zMarginF, zMarginB); -+ -+ xLog=e->KeywordSet ( "XLOG" ); -+ yLog=e->KeywordSet ( "YLOG" ); -+ if (xLog || yLog) isLog=true; else isLog=false; -+ zLog=e->KeywordSet ( "ZLOG" ); -+ -+ if ( ( xStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( xStart, xEnd, xLog ); -+ } -+ -+ if ( ( yStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( yStart, yEnd, yLog ); -+ } -+ -+ bool hasMinVal=e->KeywordPresent("MIN_VALUE"); -+ bool hasMaxVal=e->KeywordPresent("MAX_VALUE"); -+ DDouble minVal=datamin; -+ DDouble maxVal=datamax; -+ e->AssureDoubleScalarKWIfPresent ( "MIN_VALUE", minVal ); -+ e->AssureDoubleScalarKWIfPresent ( "MAX_VALUE", maxVal ); -+ -+ // then only apply expansion of axes: -+ if ( ( zStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( zStart, zEnd, zLog ); -+ } -+ -+ //OVERPLOT: get stored range values instead to use them! -+ static int overplotKW=e->KeywordIx ( "OVERPLOT" ); -+ overplot=e->KeywordSet(overplotKW); -+ make2dBox=(!overplot&&!doT3d); -+ make3dBox=(!overplot&& doT3d); -+ -+ if (overplot) //retrieve information in case they are not in the command line ans apply -+ // some computation (alas)! -+ { -+ gdlGetAxisType("X", xLog); -+ gdlGetAxisType("Y", yLog); -+ gdlGetAxisType("Z", zLog); -+ gdlGetCurrentAxisRange("X", xStart, xEnd); -+ gdlGetCurrentAxisRange("Y", yStart, yEnd); -+ gdlGetCurrentAxisRange("Z", zStart, zEnd); //we should memorize the number of levels! -+ } -+ -+ static DDouble x0,y0,xs,ys; //conversion to normalized coords -+ x0=(xLog)?-log10(xStart):-xStart; -+ y0=(yLog)?-log10(yStart):-yStart; -+ xs=(xLog)?(log10(xEnd)-log10(xStart)):xEnd-xStart;xs=1.0/xs; -+ ys=(yLog)?(log10(yEnd)-log10(yStart)):yEnd-yStart;ys=1.0/ys; -+ -+ if (!setZrange) { -+ zStart=max(minVal,zStart); -+ zEnd=min(zEnd,maxVal); -+ } -+ if(!overplot) { -+ // background BEFORE next plot since it is the only place plplot may redraw the background... -+ gdlSetGraphicsBackgroundColorFromKw ( e, actStream ); //BACKGROUND -+ gdlNextPlotHandlingNoEraseOption(e, actStream); //NOERASE -+ } -+ -+ if(make2dBox) { //start a plot -+ // viewport and world coordinates -+ // use POSITION -+ int positionIx = e->KeywordIx( "POSITION"); -+ DFloatGDL* boxPosition = e->IfDefGetKWAs( positionIx); -+ if (boxPosition == NULL) boxPosition = (DFloatGDL*) 0xF; -+ // set the PLOT charsize before computing box, see plot command. -+ gdlSetPlotCharsize(e, actStream); -+ if ( gdlSetViewPortAndWorldCoordinates(e, actStream, boxPosition, -+ xLog, yLog, -+ xMarginL, xMarginR, yMarginB, yMarginT, -+ xStart, xEnd, yStart, yEnd, iso)==FALSE ) return; //no good: should catch an exception to get out of this mess. -+ } -+ -+ if (doT3d) { -+ plplot3d = gdlConvertT3DMatrixToPlplotRotationMatrix( zValue, az, alt, ay, scale, axisExchangeCode); -+ if (plplot3d == NULL) -+ { -+ e->Throw("Illegal 3D transformation. (FIXME)"); -+ } -+ -+ Data3d.zValue = zValue; -+ Data3d.Matrix = plplot3d; //try to change for !P.T in future? -+ -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code012; -+ break; -+ case XY: // X->Y Y->X plane XY -+ Data3d.x0=0; -+ Data3d.y0=x0; -+ Data3d.xs=ys; -+ Data3d.ys=xs; -+ Data3d.code = code102; -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code210; -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code021; -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code120; -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code201; -+ break; -+ } -+ -+ //necessary even if overplot -+ // set the PLOT charsize before computing box, see plot command. -+ gdlSetPlotCharsize(e, actStream); -+ if (gdlSet3DViewPortAndWorldCoordinates(e, actStream, plplot3d, xLog, yLog, -+ xStart, xEnd, yStart, yEnd, zStart, zEnd, zLog) == FALSE) return; -+ //start 3D->2D coordinate conversions in plplot -+ actStream->stransform(gdl3dTo2dTransformContour, &Data3d); -+ } -+ -+ -+ -+ gdlSetPlotCharthick(e,actStream); -+ -+ if ( xLog && xStart<=0.0 ) Warning ( "CONTOUR: Infinite x plot range." ); -+ if ( yLog && yStart<=0.0 ) Warning ( "CONTOUR: Infinite y plot range." ); -+ if ( zLog && zStart<=0.0 ) Warning ( "CONTOUR: Infinite z plot range." ); -+ -+ // labeling -+ // initiated by /FOLLOW. -+ // C_ANNOTATION=vector of strings: strings replace the default numerical values. Implies FOLLOW. Impossible with PLPLOT! -+ // C_CHARSIZE. IDL doc false: c_charsize independent from /CHARSIZE. Charsize should be 3/4 size of AXIS LABELS, -+ // but in fact c_charsize is independent from all [XYZ]charsize setups. Implies FOLLOW. -+ // C_CHARTHICK Implies FOLLOW. -+ // C_COLORS=vector, (eventually converted to integer), give color index. repated if less than contours. -+ // C_LABELS=vector of 0 and 1 (float, double, int) . Implies FOLLOW. -+ // C_LINESTYLE =vector of linestyles. Defaults to !P.LINESTYLE -+ // C_ORIENTATION = vector of angles of lines to FILL (needs FILL KW) . -+ // C_SPACING= vector of spacing in CENTIMETRES of lines to FILL (needs FILL KW) . -+ // if C_SPACING and C_ORIENTATION absent, FILL will do a solid fill . -+ // C_THICK=vector of thickness. repated if less than contours. defaults to !P.THICK or THICK -+ -+ bool label=( e->KeywordSet ( "FOLLOW" ) || e->KeywordSet ( "C_CHARSIZE" ) || e->KeywordSet("C_CHARTHICK") || e->KeywordSet("C_LABELS") ); -+ bool fill=( e->KeywordSet("FILL") || e->KeywordSet ("C_SPACING") || e->KeywordSet ("C_ORIENTATION") ); -+ if (fill) label=false; //mutually exclusive -+ if (recordPath) {fill=true;} -+ -+ // managing the levels list OR the nlevels value -+ // LEVELS=vector_of_values_in_increasing_order -+ // NLEVELS=[1..60] -+ PLINT nlevel; -+ PLFLT *clevel; -+ ArrayGuard clevel_guard; -+ static int levelsix=e->KeywordIx ( "LEVELS" ); -+ BaseGDL* b_levels=e->GetKW ( levelsix ); -+ if ( b_levels!=NULL ) -+ { -+ DDoubleGDL* d_levels=e->GetKWAs( levelsix ); -+ nlevel=d_levels-> N_Elements ( ); -+ clevel=( PLFLT * ) &( *d_levels )[0]; -+ // are the levels ordered ? -+ for ( SizeT i=1; iThrow ( "Contour levels must be in increasing order." ); -+ } -+ } -+ else -+ { -+ PLFLT zintv; -+ // Jo: added keyword NLEVELS -+ if ( e->KeywordSet ( "NLEVELS" ) ) -+ { -+ DLong l_nlevel=nlevel; // GCC 3.4.4 needs that -+ e->AssureLongScalarKWIfPresent ( "NLEVELS", l_nlevel ); -+ nlevel=l_nlevel; -+ if ( nlevel<0) nlevel=2; //as IDL -+ if (nlevel==0) nlevel=3; //idem -+ -+ // cokhavim: IDL does this... -+ zintv=(PLFLT) ( ( zEnd-zStart )/( nlevel+1 ) ); -+ //gd: we can support ZLOG as well: -+ if (zLog) zintv=(PLFLT) ( ( log10(zEnd)-log10(zStart )) / ( nlevel+1 ) ); -+ -+ } -+ else -+ { -+ zintv=AutoTick ( zEnd-zStart ); if (zLog) zintv=AutoTick ( log10(zEnd)-log10(zStart) ); -+ nlevel=(PLINT) floor ( ( zEnd-zStart )/zintv ); if (zLog) nlevel=(PLINT) floor ( ( log10(zEnd)-log10(zStart) )/zintv ); -+ // SA: sanity check to prevent segfaults, e.g. with solely non-finite values -+ if ( zintv==0||nlevel<0 ) nlevel=0; -+ } -+ -+ if (fill) -+ { -+ nlevel=nlevel+1; -+ } -+ clevel=new PLFLT[nlevel]; -+ clevel_guard.Reset ( clevel ); -+ //IDL does this: -+ for( SizeT i=1; i<=nlevel; i++) clevel[i-1] = zintv * i + zStart; -+ if (zLog) for( SizeT i=1; i<=nlevel; i++) clevel[i-1] = pow(10.0,(log10(zStart)+zintv*i)); -+ } -+ -+ // set label params always since they are not forgotten by plplot.'label' tells if they should be used. -+ // IDL default: 3/4 of the axis charsize (CHARSIZE keyword or !P.CHARSIZE) -+ // PlPlot default: .3 -+ // should be: DFloat label_size=.75*actStream->charScale(); however IDL doc false. -+ DFloat label_size=0.9; //IDL behaviour, IDL doc false. -+ if ( e->KeywordSet ( "C_CHARSIZE" ) ) e->AssureFloatScalarKWIfPresent ( "C_CHARSIZE", label_size ); -+ actStream->setcontlabelparam ( LABELOFFSET, (PLFLT) label_size, LABELSPACING, (label)?1:0 ); -+ actStream->setcontlabelformat (3, 3 ); -+ -+ // PLOT ONLY IF NODATA=0 -+ if (!nodata) -+ { -+ //use of intermediate map for correct handling of blanking values and nans. We take advantage of the fact that -+ //this program makes either filled regions with plshades() [but plshades hates Nans!] or contours with plcont, -+ //which needs Nans to avoid blanked regions. The idea is to mark unwanted regions with Nans for plcont, and -+ //with a blanking value (minmin) for plshade. Eventually one could use a zdefined() function testing on top of it. -+ PLFLT ** map; -+ actStream->Alloc2dGrid( &map, xEl, yEl); -+ -+ if (irregular) -+ { -+ PLFLT data=0; -+ actStream->griddata(&(*xValTemp)[0],&(*yValTemp)[0],&(*zVal)[0],xEl-1, -+ &(*xVal)[0],xEl,&(*yVal)[0],yEl,map,GRID_DTLI,data); -+ for ( SizeT i=0, k=0; i maxVal) v=(fill)?maxmax:d_nan; -+ map[i][j] = v; -+ } -+ } -+ -+ }else{ -+ for ( SizeT i=0, k=0; i maxVal) v=(fill)?minmin:d_nan; -+ map[i][j] = v; -+ } -+ } -+ } -+ // provision for 2 types of grids. -+ PLcGrid cgrid1; // X and Y independent deformation -+ PLFLT* xg1; -+ PLFLT* yg1; -+ PLcGrid2 cgrid2; // Dependent X Y (e.g., rotation) -+ bool tidyGrid1WorldData=false; -+ bool tidyGrid2WorldData=false; -+ bool oneDim=true; -+ // the Grids: -+ // 1 DIM X & Y -+ if ( xVal->Rank ( )==1&&yVal->Rank ( )==1 ) -+ { -+ oneDim=true; -+ xg1 = new PLFLT[xEl]; -+ yg1 = new PLFLT[yEl]; -+ cgrid1.xg = xg1; -+ cgrid1.yg = yg1; -+ cgrid1.nx = xEl; -+ cgrid1.ny = yEl; -+ for ( SizeT i=0; i0?log10(cgrid1.xg[i]):1E-12; // #define EXTENDED_DEFAULT_LOGRANGE 12 -+ if (yLog) for ( SizeT i=0; i0?log10(cgrid1.yg[i]):1E-12; -+ tidyGrid1WorldData=true; -+ } -+ else //if ( xVal->Rank ( )==2&&yVal->Rank ( )==2 ) -+ { -+ oneDim=false; -+ -+ actStream->Alloc2dGrid ( &cgrid2.xg, xEl, yEl ); -+ actStream->Alloc2dGrid ( &cgrid2.yg, xEl, yEl ); -+ tidyGrid2WorldData=true; -+ cgrid2.nx=xEl; -+ cgrid2.ny=yEl; -+ //create 2D grid -+ for ( SizeT i=0; i0)?log10(cgrid2.xg[i][j]):1E-12; -+ } -+ if (yLog) for ( SizeT i=0; i0)?log10(cgrid2.yg[i][j]):1E-12; -+ } -+ } -+ -+ // Graphic options -+ // C_COLORS=vector, (eventually converted to integer), give color index. repated if less than contours. -+ // C_LABELS=vector of 0 and 1 (float, double, int) . Implies FOLLOW. -+ // C_LINESTYLE =vector of linestyles. Defaults to !P.LINESTYLE -+ // C_THICK=vector of thickness. repated if less than contours. defaults to !P.THICK or THICK -+ int c_colorsIx=e->KeywordIx ( "C_COLORS" ); bool docolors=false; -+ int c_linestyleIx=e->KeywordIx ( "C_LINESTYLE" ); bool dostyle=false; -+ int c_thickIx=e->KeywordIx ( "C_THICK" ); bool dothick=false; -+ int c_labelsIx=e->KeywordIx ( "C_LABELS" ); bool dolabels=false; -+ int c_orientationIx=e->KeywordIx ( "C_ORIENTATION" ); bool doori=false; -+ int c_spacingIx=e->KeywordIx ( "C_SPACING" ); bool dospacing=false; -+ if ( e->GetKW ( c_colorsIx )!=NULL ) -+ { -+ colors=e->GetKWAs( c_colorsIx ); docolors=true; -+ } -+ if ( e->GetKW ( c_thickIx )!=NULL ) -+ { -+ thick=e->GetKWAs( c_thickIx ); dothick=true; -+ } -+ if ( e->GetKW ( c_labelsIx )!=NULL ) -+ { -+ labels=e->GetKWAs( c_labelsIx ); dolabels=true; -+ } -+ else //every other level -+ { -+ labels=new DLongGDL ( dimension (2), BaseGDL::ZERO ); -+ labels_guard.Init( labels); -+ (*labels)[0]=1;(*labels)[1]=0; -+ if (label) dolabels=true; //yes! -+ } -+ if ( e->GetKW ( c_linestyleIx )!=NULL ) -+ { -+ style=e->GetKWAs( c_linestyleIx ); dostyle=true; -+ } -+ if ( e->GetKW ( c_orientationIx )!=NULL ) -+ { -+ orientation=e->GetKWAs( c_orientationIx ); doori=true; -+ } -+ else -+ { -+ orientation=new DFloatGDL ( dimension (1), BaseGDL::ZERO ); -+ orientation_guard.Init( orientation); -+ (*orientation)[0]=0; -+ } -+ if ( e->GetKW ( c_spacingIx )!=NULL ) -+ { -+ spacing=e->GetKWAs( c_spacingIx ); dospacing=true; -+ } -+ else -+ { -+ spacing=new DFloatGDL ( dimension (1), BaseGDL::ZERO ); -+ spacing_guard.Init(spacing); -+ (*spacing)[0]=0.25; -+ } -+ bool hachures=(dospacing || doori); -+ // Get decomposed value for colors -+ DLong decomposed=Graphics::GetDevice()->GetDecomposed(); -+ -+ // Important: make all clipping computations BEFORE setting graphic properties (color, size) -+ bool doClip=(e->KeywordSet("CLIP")||e->KeywordSet("NOCLIP")); -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, false)==TRUE ) stopClip=true; -+ -+ if (fill) { -+ const PLINT COLORTABLE0 = 0; -+ const PLINT COLORTABLE1 = 1; -+ const PLFLT colorindex_table_0_color=2; -+ PLFLT colorindex_table_1_color=0; -+ if (hachures) { -+ PLINT ori; -+ PLINT spa; -+ -+ actStream->psty(1); -+ // C_ORIENTATION = vector of angles of lines to FILL (needs FILL KW) . -+ // C_SPACING= vector of spacing in CENTIMETRES of lines to FILL (needs FILL KW) . -+ // if C_SPACING and C_ORIENTATION absent, FILL will do a solid fill . -+ for ( SizeT i=0; istransform(gdl3dTo2dTransformContour, &Data3d); -+ } -+ ori=floor(10.0*(*orientation)[i%orientation->N_Elements()]); -+ spa=floor(10000*(*spacing)[i%spacing->N_Elements()]); -+ actStream->pat(1,&ori,&spa); -+ -+ if (docolors) actStream->Color ( ( *colors )[i%colors->N_Elements ( )], decomposed, (PLINT)colorindex_table_0_color ); -+ if (dothick) actStream->wid ( ( *thick )[i%thick->N_Elements ( )]); -+ if (dostyle) gdlLineStyle(actStream, ( *style )[i%style->N_Elements ( )]); -+ actStream->shade( map, xEl, yEl, isLog?doIt:NULL, xStart, xEnd, yStart, yEnd, -+ clevel[i], clevel[i+1], -+ COLORTABLE0, colorindex_table_0_color, 1, //colorindex is an int passed as a double in case map0 -+ 0,0,0,0, -+ (plstream::fill), (oneDim), -+ (oneDim)?(plstream::tr1):(plstream::tr2), (oneDim)?(void *)&cgrid1:(void *)&cgrid2); -+ } -+ actStream->psty(0); -+ if (docolors) gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ if (dothick) gdlSetPenThickness(e, actStream); -+ if (dostyle) gdlLineStyle(actStream, 0); -+ } -+ else if (doT3d & !hasZvalue) { -+ for ( SizeT i=0; istransform(gdl3dTo2dTransformContour, &Data3d); -+ if (docolors) -+ { -+ actStream->Color ( ( *colors )[i%colors->N_Elements ( )], decomposed, (PLINT)colorindex_table_0_color ); -+ actStream->shade( map, xEl, yEl, isLog?doIt:NULL, -+ xStart, xEnd, yStart, yEnd, -+ clevel[i], maxmax, //clevel[nlevel-1], -+ COLORTABLE0, colorindex_table_0_color, 1, -+ 0,0,0,0, -+ plstream::fill, (oneDim), //Onedim is accelerator since rectangles are kept rectangles see plplot doc -+ (oneDim)?(plstream::tr1):(plstream::tr2), (oneDim)?(void *)&cgrid1:(void *)&cgrid2); -+ } -+ else -+ { -+ actStream->shade( map, xEl, yEl, isLog?doIt:NULL, -+ xStart, xEnd, yStart, yEnd, -+ clevel[i], maxmax, //clevel[nlevel-1], -+ COLORTABLE1, colorindex_table_1_color, 1, //colorindex is a double [0.0..1.0] in case map1 -+ 0,0,0,0, -+ plstream::fill, (oneDim), //Onedim is accelerator since rectangles are kept rectangles see plplot doc -+ (oneDim)?(plstream::tr1):(plstream::tr2), (oneDim)?(void *)&cgrid1:(void *)&cgrid2); -+ } -+ } -+ if (docolors) gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ } -+ else { -+ //useful? -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ // note that plshade is not protected against 1 level (color formula is -+ // "shade_color = color_min + i / (PLFLT) ( nlevel - 2 ) * color_range;" -+ // meaning that nlevel must be >=2 for plshade!) -+ if (nlevel>2 && !(docolors)) { -+ actStream->shades( map, xEl, yEl, isLog?doIt:NULL, xStart, xEnd, yStart, yEnd, -+ clevel, nlevel, 1, 0, 0, plstream::fill, (oneDim), -+ (oneDim)?(plstream::tr1):(plstream::tr2), -+ (oneDim)?(void *)&cgrid1:(void *)&cgrid2); -+ } -+ else { -+ for ( SizeT i=0; iColor ( ( *colors )[i%colors->N_Elements ( )], decomposed, (PLINT)colorindex_table_0_color ); -+ actStream->shade( map, xEl, yEl, isLog?doIt:NULL, -+ xStart, xEnd, yStart, yEnd, -+ clevel[i], maxmax, -+ COLORTABLE0, colorindex_table_0_color , 1, -+ 0,0,0,0, -+ plstream::fill, (oneDim), //Onedim is accelerator since rectangles are kept rectangles see plplot doc -+ (oneDim)?(plstream::tr1):(plstream::tr2), (oneDim)?(void *)&cgrid1:(void *)&cgrid2); -+ } -+ } -+ //useful? -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); //needs to be called again or else PS files look wrong -+ } -+ } -+ else { -+ //useful? -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ gdlSetPenThickness(e, actStream); -+ gdlSetPlotCharsize(e, actStream); -+ for ( SizeT i=0; istransform(gdl3dTo2dTransformContour, &Data3d); -+ } -+ if (docolors) actStream->Color ( ( *colors )[i%colors->N_Elements ( )], decomposed, 2); -+ if (dothick) actStream->wid ( ( *thick )[i%thick->N_Elements ( )]); -+ if (dostyle) gdlLineStyle(actStream, ( *style )[i%style->N_Elements ( )]); -+ if (dolabels) actStream->setcontlabelparam ( LABELOFFSET, (PLFLT) label_size, LABELSPACING, -+ (PLINT)(*labels)[i%labels->N_Elements()] ); -+ actStream->cont ( map, xEl, yEl, 1, xEl, 1, yEl, &( clevel[i] ), 1, -+ (oneDim)?(plstream::tr1):(plstream::tr2), (oneDim)?(void *)&cgrid1:(void *)&cgrid2); -+ } -+ if (docolors) gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ if (dothick) gdlSetPenThickness(e, actStream); -+ if (dostyle) gdlLineStyle(actStream, 0); -+ } -+ if (tidyGrid2WorldData) -+ { -+ actStream->Free2dGrid ( cgrid2.xg, xEl, yEl ); -+ actStream->Free2dGrid ( cgrid2.yg, xEl, yEl ); -+ } -+ if (tidyGrid1WorldData) -+ { -+ delete[] xg1; -+ delete[] yg1; -+ } -+ -+ if (stopClip) stopClipping(actStream); -+ actStream->Free2dGrid(map, xEl, yEl); -+ } -+ //finished? Store Zrange and Loginess unless we are overplot: -+ if ( make2dBox || make3dBox ) -+ { -+ gdlStoreAxisCRANGE("Z", zStart, zEnd, zLog); -+ gdlStoreAxisType("Z",zLog); -+ } -+ -+ if (doT3d) { -+ actStream->stransform(NULL,NULL); //remove transform BEFORE writing axes, ticks.. -+ } -+ //Draw axes after the data because /fill could potentially overlap the axes. -+ //... if keyword "OVERPLOT" is not set -+ if ( make2dBox ) //onlyplace where tick etc is relevant! -+ { -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); //COLOR -+ gdlBox(e, actStream, xStart, xEnd, yStart, yEnd, xLog, yLog); -+ } -+ if(make3dBox) { //overplot box -+ DDouble t3xStart, t3xEnd, t3yStart, t3yEnd, t3zStart, t3zEnd; -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ t3xStart=(xLog)?log10(xStart):xStart, -+ t3xEnd=(xLog)?log10(xEnd):xEnd, -+ t3yStart=(yLog)?log10(yStart):yStart, -+ t3yEnd=(yLog)?log10(yEnd):yEnd, -+ t3zStart=0; -+ t3zEnd=1.0; -+ actStream->w3d(scale, scale, scale*(1.0 - zValue), -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "X", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "Y", yStart, yEnd, yLog); -+ break; -+ case XY: // X->Y Y->X plane XY -+ t3yStart=(xLog)?log10(xStart):xStart, -+ t3yEnd=(xLog)?log10(xEnd):xEnd, -+ t3xStart=(yLog)?log10(yStart):yStart, -+ t3xEnd=(yLog)?log10(yEnd):yEnd, -+ t3zStart=0; -+ t3zEnd=1.0; -+ actStream->w3d(scale, scale, scale*(1.0 - zValue), -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Y", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "X", yStart, yEnd, yLog); -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ t3zStart=(xLog)?log10(xStart):xStart, -+ t3zEnd=(xLog)?log10(xEnd):xEnd, -+ t3yStart=(yLog)?log10(yStart):yStart, -+ t3yEnd=(yLog)?log10(yEnd):yEnd, -+ t3xStart=0; -+ t3xEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Z", xStart, xEnd, xLog, 0); -+ gdlAxis3(e, actStream, "Y", yStart, yEnd, yLog); -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ t3xStart=(xLog)?log10(xStart):xStart, -+ t3xEnd=(xLog)?log10(xEnd):xEnd, -+ t3zStart=(yLog)?log10(yStart):yStart, -+ t3zEnd=(yLog)?log10(yEnd):yEnd, -+ t3yStart=0; -+ t3yEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "X", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "Z", yStart, yEnd, yLog,1); -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ t3yStart=(xLog)?log10(xStart):xStart, -+ t3yEnd=(xLog)?log10(xEnd):xEnd, -+ t3zStart=(yLog)?log10(yStart):yStart, -+ t3zEnd=(yLog)?log10(yEnd):yEnd, -+ t3xStart=0; -+ t3xEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Y", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "Z", yStart, yEnd, yLog); -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ t3zStart=(xLog)?log10(xStart):xStart, -+ t3zEnd=(xLog)?log10(xEnd):xEnd, -+ t3xStart=(yLog)?log10(yStart):yStart, -+ t3xEnd=(yLog)?log10(yEnd):yEnd, -+ t3yStart=0; -+ t3yEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Z", xStart, xEnd, xLog,1); -+ gdlAxis3(e, actStream, "X", yStart, yEnd, yLog); -+ break; -+ } -+ // title and sub title -+ gdlWriteTitleAndSubtitle(e, actStream); -+ } -+ } -+ -+ private: -+ -+ void call_plplot (EnvT* e, GDLGStream* actStream) -+ { -+ } -+ -+ private: -+ -+ virtual void post_call (EnvT*, GDLGStream* actStream) -+ { -+ actStream->lsty(1);//reset linestyle -+ actStream->sizeChar(1.0); -+ } -+ -+ }; // contour_call class -+ -+ void contour (EnvT* e) -+ { -+ contour_call contour; -+ contour.call ( e, 1 ); -+ } -+ -+} // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_convert_coord.cpp gdl/src/plotting_convert_coord.cpp ---- gdl-0.9.3/src/plotting_convert_coord.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_convert_coord.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -23,8 +23,13 @@ - - using namespace std; - -+ static DDouble cubeCorners[32]= -+ { -+ 0,1,0,1,0,1,0,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1 -+ }; -+ - template< typename T1, typename T2> -- BaseGDL* convert_coord_template( EnvT* e, -+ BaseGDL* convert_coord_template( EnvT* e, - BaseGDL* p0, BaseGDL* p1, BaseGDL* p2, - DDouble *sx, DDouble *sy, DDouble *sz, - DLong xv, DLong yv, DLong xt, DLong yt) -@@ -62,7 +67,7 @@ - } else { - // rank == 2 - nrows = 1; -- for( SizeT i = 0; i<2; ++i) { -+ for( SizeT i = 0; i<2; ++i) { - nrows *= p0->Dim(i); - } - dims[1] = nrows; -@@ -74,7 +79,7 @@ - T2 *ptr1, *ptr2, *ptr3; - DLong deln=1, ires=0; - bool third = false; -- if( e->NParam() == 1) { -+ if( e->NParam() == 1) { - in = static_cast(p0->Convert2( aTy, BaseGDL::COPY)); - ptr1 = &(*in)[0]; - ptr2 = &(*in)[1]; -@@ -109,11 +114,11 @@ - - // ll -> xy - // lam = longitude phi = latitude -- if (e->KeywordSet("DATA") || (!e->KeywordSet("DEVICE") && -+ if (e->KeywordSet("DATA") || (!e->KeywordSet("DEVICE") && - !e->KeywordSet("NORMAL"))) { -- if (!e->KeywordSet("TO_DEVICE") && -+ if (!e->KeywordSet("TO_DEVICE") && - !e->KeywordSet("TO_NORMAL")) { -- for( SizeT i = 0; iKeywordSet("TO_NORMAL")) { - LPTYPE idata; - XYTYPE odata; -- for( SizeT i = 0; iKeywordSet("TO_DEVICE")) { - LPTYPE idata; - XYTYPE odata; -- for( SizeT i = 0; iKeywordSet("DEVICE")) { - XYTYPE idata; - LPTYPE odata; -- for( SizeT i = 0; i(Values->GetTag(Values->Desc()->TagIndex("D_NAN"), 0)))[0]; -- for( SizeT i = 0; iN_Elements(); ++i) { -- if (isinf((DDouble) (*res)[i]) != 0) (*res)[i] = d_nan; -+ for( SizeT i = 0; iN_Elements(); ++i) { -+ if (std::isinf((DDouble) (*res)[i]) != 0) (*res)[i] = d_nan; - } - } - return res; -@@ -202,9 +207,9 @@ - #endif - - // in: DATA out: NORMAL/DEVICE -- if (e->KeywordSet("DATA") || (!e->KeywordSet("DEVICE") && -+ if (e->KeywordSet("DATA") || (!e->KeywordSet("DEVICE") && - !e->KeywordSet("NORMAL"))) { -- for( SizeT i = 0; iNParam(); - if( nParam < 1) -@@ -364,4 +369,608 @@ - } - } - -+ //THE FOLLOWING ARE POSSIBLY THE WORST WAY TO DO THE JOB. At least they are to be used *only* -+ //for [4,4] generalized 3D matrices -+ void SelfTranspose3d(DDoubleGDL* me) -+ { -+ //crude quick hack to have the same behaviour as the other functions. -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(dim1,dim0),BaseGDL::NOZERO)); -+ for (int j=0; j < dim0; ++j) for (int i=0; i < dim1; ++i)(*mat)[i*dim1+j]=(*me)[j*dim0 + i]; -+ memcpy(me->DataAddr(),mat->DataAddr(),dim0*dim1*sizeof(double)); -+// for (int i=0; i < dim0; ++i) for (int j=0; j < dim1; ++j)(*me)[i*dim0+j]=(*mat)[i*dim0 + j]; -+ GDLDelete(mat); -+ } -+ void SelfReset3d(DDoubleGDL* me) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* Identity=(new DDoubleGDL(dimension(dim0,dim1))); -+ for(SizeT i=0; iDataAddr(),Identity->DataAddr(),dim0*dim1*sizeof(double)); -+ GDLDelete(Identity); -+ } -+ DDoubleGDL* Translate3d(DDoubleGDL* me, DDouble* trans) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ Guard mat_guard; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(dim0,dim1))); -+ mat_guard.Reset(mat); -+ SelfReset3d(mat); //identity Matrix -+ for(SizeT i=0; i<3; ++i) {(*mat)[3*dim1+i]=trans[i];} -+ return mat->MatrixOp(me,false,false); -+ } -+ void SelfTranslate3d(DDoubleGDL* me, DDouble* trans) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(dim0,dim1))); -+ SelfReset3d(mat); //identity Matrix -+ for(SizeT i=0; i<3; ++i) {(*mat)[3*dim1+i]=trans[i];} -+ memcpy(me->DataAddr(),(mat->MatrixOp(me,false,false))->DataAddr(),dim0*dim1*sizeof(double)); -+ GDLDelete(mat); -+ } -+ DDoubleGDL* Scale3d(DDoubleGDL* me, DDouble *scale) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ Guard mat_guard; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(dim0,dim1))); -+ mat_guard.Reset(mat); -+ SelfReset3d(mat); //identity Matrix -+ for(SizeT i=0; i<3; ++i) {(*mat)[i*dim1+i]=scale[i];} -+ return mat->MatrixOp(me,false,false); -+ } -+ void SelfScale3d(DDoubleGDL* me, DDouble *scale) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(dim0,dim1))); -+ SelfReset3d(mat); //identity Matrix -+ for(SizeT i=0; i<3; ++i) {(*mat)[i*dim1+i]=scale[i];} -+ memcpy(me->DataAddr(),(mat->MatrixOp(me,false,false))->DataAddr(),dim0*dim1*sizeof(double)); -+ GDLDelete(mat); -+} -+#define DPI (double)(4*atan(1.0)) -+#define DEGTORAD (DPI/180.0) -+#define RADTODEG (180.0/DPI) -+ void SelfRotate3d(DDoubleGDL* me, DDouble *rot) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(4,4))); -+ SelfReset3d(mat); -+ DDoubleGDL* maty=(new DDoubleGDL(dimension(4,4))); -+ SelfReset3d(maty); -+ DDoubleGDL* matz=(new DDoubleGDL(dimension(4,4))); -+ SelfReset3d(matz); -+ SizeT ncols=4; -+ double c,s; -+ for(SizeT j=0; j<3; ++j) -+ { -+ c=cos(rot[j]*DEGTORAD); -+ s=sin(rot[j]*DEGTORAD); -+ switch(j) -+ { -+ case 0: -+ { -+ (*mat)[1 * ncols + 1] = c; -+ (*mat)[1 * ncols + 2] = s; -+ (*mat)[2 * ncols + 1] = -s; -+ (*mat)[2 * ncols + 2] = c; -+ break; -+ } -+ case 1: -+ { -+ (*maty)[0 * ncols + 0] = c; -+ (*maty)[0 * ncols + 2] = -s; -+ (*maty)[2 * ncols + 0] = s; -+ (*maty)[2 * ncols + 2] = c; -+ memcpy(mat->DataAddr(),(maty->MatrixOp(mat,false,false))->DataAddr(),dim0*dim1*sizeof(double)); -+ break; -+ } -+ case 2: -+ { -+ (*matz)[0 * ncols + 0] = c; -+ (*matz)[0 * ncols + 1] = s; -+ (*matz)[1 * ncols + 0] = -s; -+ (*matz)[1 * ncols + 1] = c; -+ memcpy(mat->DataAddr(),(matz->MatrixOp(mat,false,false))->DataAddr(),dim0*dim1*sizeof(double)); -+ } -+ } -+ } -+ -+ memcpy(me->DataAddr(),(mat->MatrixOp(me,false,false))->DataAddr(),dim0*dim1*sizeof(double)); -+ GDLDelete(matz); -+ GDLDelete(maty); -+ GDLDelete(mat); -+ } -+ void SelfPerspective3d(DDoubleGDL* me, DDouble zdist) -+ { -+ if (!(zdist==zdist)) return; //Nan -+ if (zdist==0.0) return; -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(dim0,dim1))); -+ SelfReset3d(mat); //identity Matrix -+ (*mat)[2*dim1+3]=-1.0/zdist; -+ memcpy(me->DataAddr(),(mat->MatrixOp(me,false,false))->DataAddr(),dim0*dim1*sizeof(double)); -+ GDLDelete(mat); -+ } -+ void SelfOblique3d(DDoubleGDL* me, DDouble dist, DDouble angle) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(dim0,dim1))); -+ SelfReset3d(mat); //identity Matrix -+ (*mat)[2*dim1+2]=0.0; -+ (*mat)[2*dim1+0]=dist*cos(angle*DEGTORAD); -+ (*mat)[2*dim1+1]=dist*sin(angle*DEGTORAD); -+ memcpy(me->DataAddr(),(mat->MatrixOp(me,false,false))->DataAddr(),dim0*dim1*sizeof(double)); -+ GDLDelete(mat); -+ } -+ void SelfExch3d(DDoubleGDL* me, DLong code) -+ { -+ SizeT dim0=me->Dim(0); -+ SizeT dim1=me->Dim(1); -+ if (dim0 !=4 && dim1 !=4) return; -+ DDoubleGDL* mat=me->Dup(); -+ switch(code) -+ { -+ case 1: //exchange 0 and 1 -+ for(SizeT i=0; icode[0]]=(x+ptr->x0)*ptr->xs; -+ (*xyzw)[ptr->code[1]]=(y+ptr->y0)*ptr->ys;; -+ (*xyzw)[ptr->code[2]]=ptr->zValue; -+ DDoubleGDL* trans=xyzw->MatrixOp(ptr->Matrix,false,true); -+ *xt=(*trans)[0]; -+ *yt=(*trans)[1]; -+ GDLDelete(trans); -+ GDLDelete(xyzw); -+ } -+//Special for Contour (not special for the moment in fact): -+ void gdl3dTo2dTransformContour(PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer data) -+ { -+ struct GDL_3DTRANSFORMDATA *ptr = (GDL_3DTRANSFORMDATA* )data; -+ DDoubleGDL* xyzw=new DDoubleGDL(dimension(4)); -+ (*xyzw)[3]=1.0; -+ (*xyzw)[ptr->code[0]]=(x+ptr->x0)*ptr->xs; -+ (*xyzw)[ptr->code[1]]=(y+ptr->y0)*ptr->ys;; -+ (*xyzw)[ptr->code[2]]=ptr->zValue; -+ DDoubleGDL* trans=xyzw->MatrixOp(ptr->Matrix,false,true); -+ *xt=(*trans)[0]; -+ *yt=(*trans)[1]; -+ GDLDelete(trans); -+ GDLDelete(xyzw); -+ } -+ -+ //retrieve !P.T, -+ DDoubleGDL* gdlGetT3DMatrix() -+ { -+ DDoubleGDL* t3dMatrix=(new DDoubleGDL(dimension(4,4),BaseGDL::NOZERO)); -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned tTag=pStruct->Desc()->TagIndex("T"); -+ for (int i=0; iN_Elements(); ++i )(*t3dMatrix)[i]=(*static_cast(pStruct->GetTag(tTag, 0)))[i]; -+ SelfTranspose3d(t3dMatrix); -+ return t3dMatrix; -+ } -+ // retrieve !P.T, (or use passed matrix) -+ // scale to current X.S Y.S and Z.S, returns a matrix that can be applied directly to -+ // XYZ data to get projected X' Y' *normalized* coordinates values -+ DDoubleGDL* gdlGetScaledNormalizedT3DMatrix(DDoubleGDL* passedMatrix) -+ { -+ DDoubleGDL* t3dMatrix; -+ if (passedMatrix==NULL) t3dMatrix=gdlGetT3DMatrix(); else t3dMatrix=passedMatrix; -+ DDouble *sx, *sy, *sz; -+ GetSFromPlotStructs(&sx, &sy, &sz); -+ DDoubleGDL* toScaled=(new DDoubleGDL(dimension(4,4),BaseGDL::NOZERO)); -+ SelfReset3d(toScaled); -+ DDouble depla[3]={sx[0],sy[0],sz[0]}; -+ DDouble scale[3]={sx[1],sy[1],sz[1]}; -+ SelfScale3d(toScaled, scale); //pay attention to order for matrices! -+ SelfTranslate3d(toScaled,depla); -+ DDoubleGDL* returnMatrix=t3dMatrix->MatrixOp(toScaled,false,false); -+ GDLDelete(toScaled); -+ if (passedMatrix==NULL) GDLDelete(t3dMatrix); -+ return returnMatrix; -+ } -+ -+ void gdlNormed3dToWorld3d(DDoubleGDL *xValin, DDoubleGDL *yValin, DDoubleGDL* zValin, -+ DDoubleGDL *xValou, DDoubleGDL *yValou, DDoubleGDL* zValou) -+ { -+ DDouble *sx, *sy, *sz; -+ GetSFromPlotStructs(&sx, &sy, &sz); -+ DDoubleGDL* toWorld=(new DDoubleGDL(dimension(4,4),BaseGDL::NOZERO)); -+ SelfReset3d(toWorld); -+ DDouble depla[3]={-sx[0],-sy[0],-sz[0]}; -+ DDouble scale[3]={1/sx[1],1/sy[1],1/sz[1]}; -+ SelfTranslate3d(toWorld,depla); //pay attention to order for matrices! -+ SelfScale3d(toWorld, scale); -+ //populate a 4D matrix with reduced coordinates through sx,sy,sz: -+ SizeT nEl=xValin->N_Elements(); -+ DDoubleGDL* xyzw=new DDoubleGDL(dimension(nEl,4)); -+ memcpy(&((*xyzw)[0]),xValin->DataAddr(),nEl*sizeof(double)); -+ memcpy(&((*xyzw)[nEl]),yValin->DataAddr(),nEl*sizeof(double)); -+ if (zValin != NULL) memcpy(&((*xyzw)[2*nEl]),zValin->DataAddr(),nEl*sizeof(double)); -+ else for (int index=0; index< nEl; ++index){ (*xyzw)[2*nEl+index]=1.0;} -+ for (int index=0; index< nEl; ++index){ (*xyzw)[3*nEl+index]=1.0;} -+ DDoubleGDL* trans=xyzw->MatrixOp(toWorld,false,true); -+ memcpy(xValou->DataAddr(), trans->DataAddr(),nEl*sizeof(double)); -+ memcpy(yValou->DataAddr(), &(*trans)[nEl],nEl*sizeof(double)); -+ if (zValou != NULL) memcpy(zValou->DataAddr(), &(*trans)[2*nEl],nEl*sizeof(double)); -+ GDLDelete(trans); -+ GDLDelete(xyzw); -+ GDLDelete(toWorld); -+ } -+ void gdl3dto2dProjectDDouble(DDoubleGDL* t3dMatrix, DDoubleGDL *xVal, DDoubleGDL *yVal, DDoubleGDL* zVal, -+ DDoubleGDL *xValou, DDoubleGDL *yValou, int* code) -+ { -+ DDoubleGDL *decodedAxis[3]={xVal,yVal,zVal}; -+ int *localCode=code; -+ if (localCode == NULL) localCode=code012; -+ //populate a 4D matrix with reduced coordinates through sx,sy,sz: -+ SizeT nEl=xVal->N_Elements(); -+ DDoubleGDL* xyzw=new DDoubleGDL(dimension(nEl,4)); -+ memcpy(&((*xyzw)[0]),decodedAxis[localCode[0]]->DataAddr(),nEl*sizeof(double)); -+ memcpy(&((*xyzw)[nEl]),decodedAxis[localCode[1]]->DataAddr(),nEl*sizeof(double)); -+ memcpy(&((*xyzw)[2*nEl]),decodedAxis[localCode[2]]->DataAddr(),nEl*sizeof(double)); -+ for (int index=0; index< nEl; ++index){ (*xyzw)[3*nEl+index]=1.0;} -+ DDoubleGDL* trans=xyzw->MatrixOp(t3dMatrix,false,true); -+ memcpy(xValou->DataAddr(), trans->DataAddr(),nEl*sizeof(double)); -+ memcpy(yValou->DataAddr(), &(*trans)[nEl],nEl*sizeof(double)); -+ GDLDelete(trans); -+ GDLDelete(xyzw); -+ } -+ -+ void gdlProject3dCoordinatesIn2d(DDoubleGDL* Matrix, DDoubleGDL *xVal, DDouble* sx, -+ DDoubleGDL *yVal, DDouble *sy, DDoubleGDL* zVal, DDouble *sz , DDoubleGDL *xValou, DDoubleGDL *yValou) -+ { -+ DDoubleGDL* toScaled=(new DDoubleGDL(dimension(4,4),BaseGDL::NOZERO)); -+ SelfReset3d(toScaled); -+ DDouble depla[3]={sx[0],sy[0],sz[0]}; -+ DDouble scale[3]={sx[1],sy[1],sz[1]}; -+ SelfScale3d(toScaled, scale); -+ SelfTranslate3d(toScaled,depla); -+ //populate a 4D matrix with reduced coordinates through sx,sy,sz: -+ SizeT nEl=xVal->N_Elements(); -+ DDoubleGDL* xyzw=new DDoubleGDL(dimension(nEl,4)); -+ memcpy(&((*xyzw)[0]),xVal->DataAddr(),nEl*sizeof(double)); -+ memcpy(&((*xyzw)[nEl]),yVal->DataAddr(),nEl*sizeof(double)); -+ memcpy(&((*xyzw)[2*nEl]),zVal->DataAddr(),nEl*sizeof(double)); -+ for (int index=0; index< nEl; ++index){ (*xyzw)[3*nEl+index]=1.0;} -+ DDoubleGDL* temp=Matrix->MatrixOp(toScaled,false,false); -+ DDoubleGDL* trans=xyzw->MatrixOp(temp,false,true); -+ memcpy(xValou->DataAddr(), trans->DataAddr(),nEl*sizeof(double)); -+ memcpy(yValou->DataAddr(), &(*trans)[nEl],nEl*sizeof(double)); -+ GDLDelete(trans); -+ GDLDelete(xyzw); -+ GDLDelete(temp); -+ } -+ -+ bool isMatrixRotation(DDoubleGDL* Matrix,DDouble &rx, DDouble &ry, DDouble &rz, DDouble &scale) -+ { -+ DDoubleGDL* t3dMatrix=Matrix->Dup(); -+ // !P.T=rt#cs#9r#Ry#Rx(#Rz?)#tr !Ry contains az! -+ // r9#sc#tr# rt#cs#9r#Ry#Rx(#Rz?)#tr #rt = r9#sc#tr#!P.T#rt = Ry#Rx(#Rz?) -+ // -+ // a= r9#sc#tr#!P.T#rt -+ //construct derotator of Matrix=!P.T . We can find sc if not stretch. -+ //substract translation rt -+ static DDouble rt[3]={-0.5, -0.5, -0.5}; -+ SelfTranslate3d(t3dMatrix,rt); //!P.T#rt -+ //on the other end compute the good invert translation-rotation t3dMatrix -+ DDoubleGDL* test=(new DDoubleGDL(dimension(4,4))); -+ SelfReset3d(test); -+ static DDouble r9[3]={90.0, 0.0, 0.0}; -+ SelfRotate3d(test,r9); -+ static DDouble tr[3]={0.5, 0.5, 0.5}; -+ SelfTranslate3d(test,tr); -+ // product of the two should be a pure scaled rotx,roty(rotz)(scale) matrix, hence: -+ DDoubleGDL* xz=(t3dMatrix->MatrixOp(test,false,false)); -+ rx=atan2((*xz)[1*4+2],(*xz)[1*4+1])*RADTODEG; -+ ry=atan2((*xz)[2*4+0],sqrt(pow((*xz)[2*4+1],2.0)+pow((*xz)[2*4+2],2.0)))*RADTODEG; -+ rz=atan2((*xz)[1*4+0],(*xz)[0*4+0])*RADTODEG; -+ //test by rotation inverse -+ static DDouble Rot[3]; -+ memset(Rot,'\0',3*sizeof(DDouble)); Rot[2]=-rz; SelfRotate3d(xz,Rot); //#zR -+ memset(Rot,'\0',3*sizeof(DDouble)); Rot[0]=-rx; SelfRotate3d(xz,Rot); //#xR -+ memset(Rot,'\0',3*sizeof(DDouble)); Rot[1]=-ry; SelfRotate3d(xz,Rot); //#yR -+ scale=(*xz)[0]; -+ DDouble sum=(*xz)[0]+(*xz)[5]+(*xz)[10]; -+ sum/=scale; //sum of scaled Rotation matrix diagonal -+ if (abs(sum-3.0)<1E-4) return true; else return false; -+ } -+ DDoubleGDL* gdlConvertT3DMatrixToPlplotRotationMatrix( DDouble zValue, DDouble &az, -+ DDouble &alt, DDouble &ay, DDouble &scale, ORIENTATION3D &code) -+ { -+ //returns NULL if error! -+ DDoubleGDL* t3dMatrix=(new DDoubleGDL(dimension(4,4))); -+ //retrieve !P.T and find az, alt, inversions, and (possibly) scale and roty -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned tTag=pStruct->Desc()->TagIndex("T"); -+ for (int i=0; iN_Elements(); ++i )(*t3dMatrix)[i]=(*static_cast(pStruct->GetTag(tTag, 0)))[i]; -+ SelfTranspose3d(t3dMatrix); -+ //check repeatedly rotations & translations -+ if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+ { -+ code=NORMAL; goto done; // 0 -+ } -+ SelfExch3d(t3dMatrix,01); //XY, 1 -+ if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+ { -+ code=XY; goto done; -+ } -+ SelfExch3d(t3dMatrix,01); //-XY -+ SelfExch3d(t3dMatrix,02); //+XZ 2 -+ if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+ { -+ code=XZ; goto done; -+ } -+ SelfExch3d(t3dMatrix,02); //-XZ -+ SelfExch3d(t3dMatrix,12); //+YZ 3 -+ if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+ { -+ code=YZ; goto done; -+ } -+ SelfExch3d(t3dMatrix,12); //-YZ -+ -+ SelfExch3d(t3dMatrix,01); //XY first -+ -+ SelfExch3d(t3dMatrix,02); //+XZ 5 -+ if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+ { -+ code=XZXY; goto done; -+ } -+ SelfExch3d(t3dMatrix,02); //-XZ -+ SelfExch3d(t3dMatrix,12); //+YZ 4 -+ if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+ { -+ code=XZYZ; goto done; -+ } -+ SelfExch3d(t3dMatrix,12); //-YZ -+ SelfExch3d(t3dMatrix,01); //-XY -+//redundant -+// SelfExch3d(t3dMatrix,12); // YZ first -+// -+// SelfExch3d(t3dMatrix,01); //XY 5 -+// if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+// { -+// code=YZXY; goto done; -+// } -+// SelfExch3d(t3dMatrix,01); //-XY -+// SelfExch3d(t3dMatrix,02); //+XZ 4 -+// if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+// { -+// code=YZXZ; goto done; -+// } -+// SelfExch3d(t3dMatrix,02); //-XZ -+// SelfExch3d(t3dMatrix,12); //-YZ -+// -+// SelfExch3d(t3dMatrix,02); // XZ first -+// -+// SelfExch3d(t3dMatrix,01); //XY 4 -+// if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+// { -+// code=XZXY; goto done; -+// } -+// SelfExch3d(t3dMatrix,01); //-XY -+// SelfExch3d(t3dMatrix,12); //+YZ 4 -+// if (isMatrixRotation(t3dMatrix,alt,az,ay,scale)) -+// { -+// code=XZYZ; goto done; -+// } -+ return (DDoubleGDL*)(NULL); //ERROR! -+done: -+ if (alt > 90.0 || alt <-1.E-3) return (DDoubleGDL*)(NULL); -+ if (alt<0.0) alt=0.0; //prevents plplot complain for epsilon not being strictly positive. -+ -+ //recompute transformation matrix with plplot conventions: -+ DDoubleGDL* plplot3d=gdlComputePlplotRotationMatrix(az, alt, zValue, scale); -+ return plplot3d; -+ } -+ void scale3_pro(EnvT* e) -+ { -+ static unsigned tTag=SysVar::P()->Desc()->TagIndex("T"); -+ const double invsqrt3=1.0/sqrt(3); -+ //AX -+ DDouble ax=30.0; -+ e->AssureDoubleScalarKWIfPresent("AX", ax); -+ //AZ -+ DDouble az=30.0; -+ e->AssureDoubleScalarKWIfPresent("AZ", az); -+ DDoubleGDL* mat=(new DDoubleGDL(dimension(4,4),BaseGDL::NOZERO)); -+ SelfReset3d(mat); -+ static DDouble mytrans[3]={-0.5, -0.5, -0.5}; -+ SelfTranslate3d(mat,mytrans); -+ static DDouble myscale[3]={invsqrt3, invsqrt3, invsqrt3}; -+ SelfScale3d(mat,myscale); -+ DDouble rot1[3]={-90.0, az, 0.0}; -+ DDouble rot2[3]={ax, 0.0, 0.0}; -+ SelfRotate3d(mat,rot1); -+ SelfRotate3d(mat,rot2); -+ static DDouble mytrans2[3]={0.5, 0.5, 0.5}; -+ SelfTranslate3d(mat,mytrans2); -+ SelfTranspose3d(mat); -+ for (int i=0; iN_Elements(); ++i )(*static_cast(SysVar::P()->GetTag(tTag, 0)))[i]=(*mat)[i]; -+ -+ DDouble size; -+ //XRANGE -+ static int xrangeIx = e->KeywordIx( "XRANGE"); -+ DDoubleGDL* xrange = e->IfDefGetKWAs( xrangeIx); -+ if (xrange != NULL){ -+ if (xrange->N_Elements()<2) e->Throw("XRANGE needs at least a 2-elements vector"); -+ static unsigned sTag=SysVar::X()->Desc()->TagIndex("S"); -+ size=((*xrange)[1]-(*xrange)[0]); -+ (*static_cast(SysVar::X()->GetTag(sTag, 0)))[0]=-(*xrange)[0]/size; -+ (*static_cast(SysVar::X()->GetTag(sTag, 0)))[1]=1.0/size; -+ } -+ //YRANGE -+ static int yrangeIx = e->KeywordIx( "YRANGE"); -+ DDoubleGDL* yrange = e->IfDefGetKWAs( yrangeIx); -+ if (yrange != NULL){ -+ if (yrange->N_Elements()<2) e->Throw("YRANGE needs at least a 2-elements vector"); -+ static unsigned sTag=SysVar::Y()->Desc()->TagIndex("S"); -+ size=((*yrange)[1]-(*yrange)[0]); -+ (*static_cast(SysVar::Y()->GetTag(sTag, 0)))[0]=-(*yrange)[0]/size; -+ (*static_cast(SysVar::Y()->GetTag(sTag, 0)))[1]=1.0/size; -+ } -+ //ZRANGE -+ static int zrangeIx = e->KeywordIx( "ZRANGE"); -+ DDoubleGDL* zrange = e->IfDefGetKWAs( zrangeIx); -+ if (zrange != NULL){ -+ if (zrange->N_Elements()<2) e->Throw("ZRANGE needs at least a 2-elements vector"); -+ static unsigned sTag=SysVar::Z()->Desc()->TagIndex("S"); -+ size=((*zrange)[1]-(*zrange)[0]); -+ (*static_cast(SysVar::Z()->GetTag(sTag, 0)))[0]=-(*zrange)[0]/size; -+ (*static_cast(SysVar::Z()->GetTag(sTag, 0)))[1]=1.0/size; -+ } -+ } -+ void t3d_pro( EnvT* e) -+ { -+ static unsigned tTag=SysVar::P()->Desc()->TagIndex("T"); -+ DDoubleGDL *mat=NULL; -+ DDoubleGDL *matin=NULL; -+ // MATRIX keyword (read, write) -+ static int matrixIx=e->KeywordIx("MATRIX"); -+ bool externalarray=e->KeywordPresent(matrixIx); -+ -+ static int resetIx = e->KeywordIx( "RESET"); -+ bool reset=e->KeywordSet(resetIx); -+ if (e->NParam() > 1) -+ { -+ e->Throw("Accepts only one (optional) 4x4 array"); -+ } -+ else if (e->NParam() == 1 && !reset) -+ { -+ matin=e->GetParAs< DDoubleGDL > (0); -+ if (matin->Rank() != 2) e->Throw(e->GetParString(0)+"must be a 2d array."); -+ if (matin->Dim(0) != 4 || matin->Dim(1) != 4) e->Throw(e->GetParString(0)+"must be a [4,4] array."); -+ mat=matin->Dup(); -+ } -+ else -+ { -+ mat=(new DDoubleGDL(dimension(4,4))); -+ for (int i=0; iN_Elements(); ++i )(*mat)[i]=(*static_cast(SysVar::P()->GetTag(tTag, 0)))[i]; -+ } -+ SelfTranspose3d(mat); //for c matrix handling -+ if (reset) SelfReset3d(mat); -+ //TRANSLATE -+ static int translateIx = e->KeywordIx( "TRANSLATE"); -+ DDoubleGDL* translate = e->IfDefGetKWAs( translateIx); -+ if (translate != NULL) -+ { -+ if (translate->N_Elements() != 3) e->Throw("TRANSLATE parameter must be a [3] array."); -+ SelfTranslate3d(mat, (DDouble*)translate->DataAddr()); -+ } -+ //SCALE -+ static int scaleIx = e->KeywordIx( "SCALE"); -+ DDoubleGDL* scale = e->IfDefGetKWAs( scaleIx); -+ if (scale != NULL) -+ { -+ if (scale->N_Elements() != 3) e->Throw("SCALE parameter must be a [3] array."); -+ SelfScale3d(mat, (DDouble*)scale->DataAddr()); -+ } -+ //ROTATE -+ static int rotateIx = e->KeywordIx( "ROTATE"); -+ DDoubleGDL* rotate = e->IfDefGetKWAs( rotateIx); -+ if (rotate != NULL) -+ { -+ if (rotate->N_Elements() != 3) e->Throw("ROTATE parameter must be a [3] array."); -+ SelfRotate3d(mat, (DDouble*)rotate->DataAddr()); -+ } -+ //PERSPECTIVE -+ static int perspIx = e->KeywordIx("PERSPECTIVE"); -+ BaseGDL* perspective=e->GetKW(perspIx); -+ if (perspective != NULL) -+ { DDoubleGDL* persp= static_cast(perspective->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -+ SelfPerspective3d(mat, (*persp)[0]); -+ } -+ //OBLIQUE -+ static int obliqueIx = e->KeywordIx( "OBLIQUE"); -+ DDoubleGDL* oblique = e->IfDefGetKWAs( obliqueIx); -+ if (oblique != NULL) -+ { -+ if (oblique->N_Elements() != 2) e->Throw("OBLIQUE parameter must be a [2] array."); -+ SelfOblique3d(mat, (*oblique)[0],(*oblique)[1]); -+ } -+ DLong code; -+ //XYEXCH -+ static int exchxyIx = e->KeywordIx( "XYEXCH"); -+ bool exchxy=e->KeywordSet(exchxyIx); -+ if (exchxy) code=01; -+ //XZEXCH -+ static int exchxzIx = e->KeywordIx( "XZEXCH"); -+ bool exchxz=e->KeywordSet(exchxzIx); -+ if (exchxz) code=02; -+ //YYEXCH -+ static int exchyzIx = e->KeywordIx( "YZEXCH"); -+ bool exchyz=e->KeywordSet(exchyzIx); -+ if (exchyz) code=12; -+ -+ if (exchxy||exchxz||exchyz) SelfExch3d(mat, code ); -+ -+ SelfTranspose3d(mat); //prior to give back. -+ if ( externalarray ) -+ { -+ e->SetKW(matrixIx, mat); -+ } -+ else -+ { -+ for (int i=0; iN_Elements(); ++i )(*static_cast(SysVar::P()->GetTag(tTag, 0)))[i]=(*mat)[i]; -+ GDLDelete(mat); -+ } -+ } - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting.cpp gdl/src/plotting.cpp ---- gdl-0.9.3/src/plotting.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting.cpp 2013-08-04 20:25:19.001699394 -0600 -@@ -19,787 +19,1452 @@ - - #include - -+#include -+#include -+#include "envt.hpp" -+#include "dinterpreter.hpp" - // PLplot is used for direct graphics - #include - - #include "initsysvar.hpp" --#include "envt.hpp" - #include "graphics.hpp" - #include "plotting.hpp" - #include "math_utl.hpp" - - #ifdef _MSC_VER --#define isfinite _finite --#define isnan _isnan -+#define snprintf _snprintf - #endif - --namespace lib { -+namespace lib -+{ - - using namespace std; -+// using std::isinf; -+ using std::isnan; -+ -+//static values -+ static DDouble savedPointX=0.0; -+ static DDouble savedPointY=0.0; -+ static gdlbox saveBox; -+ static DDouble epsDouble=0.0; -+ static DDouble absoluteMinVal=0.0; -+ static DDouble absoluteMaxVal=0.0; -+ static DFloat sym1x[5]={1, -1, 0, 0, 0}; // + -+ static DFloat sym1y[5]={0, 0, 0, -1, 1}; // + -+ static DFloat sym2x[11]= {1, -1, 0, 0, 0, 0,1,-1,0,1,-1}; //* -+ static DFloat sym2y[11]= {0, 0, 0, -1, 1,0,1,-1,0,-1,1}; // * -+ static DFloat sym3x[2]={0,0}; // . -+ static DFloat sym3y[2]={0,0}; // . -+ static DFloat sym4x[5]={ 0, 1, 0, -1, 0 }; //diamond. -+ static DFloat sym4y[5]={ 1, 0, -1, 0, 1 }; //diamond. -+ static DFloat sym5x[4]={ -1, 0, 1, -1 }; // triangle up. -+ static DFloat sym5y[4]={ -1, 1, -1, -1 }; // triangle up. -+ static DFloat sym6x[5]={ -1, 1, 1, -1, -1 }; //square -+ static DFloat sym6y[5]={ 1, 1, -1, -1, 1 }; //square -+ static DFloat sym7x[5]= {1,-1,0,1,-1}; //x -+ static DFloat sym7y[5]= {1,-1,0,-1,1}; //x -+ DLong syml[7]={5,11,2,5,4,5,5}; -+ -+ struct GDL_TICKDATA -+ { -+ bool isLog; -+ }; -+ -+ struct GDL_TICKNAMEDATA -+ { -+ SizeT counter; -+ SizeT nTickName; -+ DStringGDL* TickName; -+ bool isLog; -+ }; -+ -+ struct GDL_MULTIAXISTICKDATA -+ { -+ EnvT *e; -+ SizeT counter; -+ int what; -+ SizeT nTickFormat; -+ DDouble axismin; -+ DDouble axismax; -+ DStringGDL* TickFormat; -+ SizeT nTickUnits; -+ DStringGDL* TickUnits; -+ bool isLog; -+ }; - - // local helper function -- void GetMinMaxVal( DDoubleGDL* val, double* minVal, double* maxVal) -+ DDouble gdlEpsDouble() - { -- DLong minE, maxE; -- const bool omitNaN = true; -- val->MinMax( &minE, &maxE, NULL, NULL, omitNaN); -- if( minVal != NULL) *minVal = (*val)[ minE]; -- if( maxVal != NULL) *maxVal = (*val)[ maxE]; -+ static bool done=FALSE; -+ if (!done) -+ { -+ long int ibeta, it, irnd, ngrd, machep, negep, iexp, minexp, maxexp; -+ double epsD, epsnegD, xminD, xmaxD; -+ machar_d(&ibeta, &it, &irnd, &ngrd, &machep, -+ &negep, &iexp, &minexp, &maxexp, -+ &epsDouble, &epsnegD, &xminD, &xmaxD ); -+ done=TRUE; -+ } -+ return epsDouble; - } -+ DDouble gdlAbsoluteMinValueDouble() -+ { -+ static bool done=FALSE; -+ if (!done) -+ { -+ long int ibeta, it, irnd, ngrd, machep, negep, iexp, minexp, maxexp; -+ double epsD, epsnegD, xminD, xmaxD; -+ machar_d(&ibeta, &it, &irnd, &ngrd, &machep, -+ &negep, &iexp, &minexp, &maxexp, -+ &epsD, &epsnegD, &absoluteMinVal, &xmaxD ); -+ done=TRUE; -+ } -+ return absoluteMinVal; -+ } -+ DDouble gdlAbsoluteMaxValueDouble() -+ { -+ static bool done=FALSE; -+ if (!done) -+ { -+ long int ibeta, it, irnd, ngrd, machep, negep, iexp, minexp, maxexp; -+ double epsD, epsnegD, xminD, xmaxD; -+ machar_d(&ibeta, &it, &irnd, &ngrd, &machep, -+ &negep, &iexp, &minexp, &maxexp, -+ &epsD, &epsnegD, &xminD, &absoluteMaxVal ); -+ done=TRUE; -+ } -+ return absoluteMaxVal; -+ } -+ -+ template void gdlDoRangeExtrema(T* xVal, T* yVal, DDouble &min, DDouble &max, DDouble xmin, DDouble xmax, bool doMinMax, DDouble minVal, DDouble maxVal) -+ { -+ DDouble valx, valy; -+ SizeT i,k; -+ DLong n=xVal->N_Elements(); -+ if(n!=yVal->N_Elements()) return; -+ for (i=0,k=0 ; ixmax) break; -+ //min and max of y if not NaN and in range [minVal, maxVal] if doMinMax=yes (min_value, max_value keywords) -+ valy=(*yVal)[i]; -+ if (std::isnan(valy)) break; -+ if (doMinMax &&(valymaxVal)) break; -+ if(k==0) {min=valy; max=valy;} else {min=gdlPlot_Min(min,valy); max=gdlPlot_Max(max,valy);} -+ k++; -+ } -+ } -+ template void gdlDoRangeExtrema(Data_*, Data_*, DDouble &, DDouble &, DDouble, DDouble, bool, DDouble, DDouble); - -- -+ void GetMinMaxVal(DDoubleGDL* val, double* minVal, double* maxVal) -+ { -+ DLong minE, maxE; -+ const bool omitNaN=true; -+ val->MinMax(&minE, &maxE, NULL, NULL, omitNaN); -+ if ( minVal!=NULL ) *minVal=(*val)[ minE]; -+ if ( maxVal!=NULL ) *maxVal=(*val)[ maxE]; -+ } -+ -+ //call this function if Y data is strictly >0. -+ //set yStart to 0 only if gdlYaxisNoZero is false. -+ bool gdlYaxisNoZero(EnvT* e) -+ { -+ //no explict range given? -+ SysVar::Y(); -+ DDouble test1, test2; -+ static unsigned rangeTag=SysVar::Y()->Desc()->TagIndex("RANGE"); -+ test1=(*static_cast(SysVar::Y()->GetTag(rangeTag, 0)))[0]; -+ test2=(*static_cast(SysVar::Y()->GetTag(rangeTag, 0)))[1]; -+ if(!(test1==0.0 && test2==0.0)) return TRUE; -+ if ( e->KeywordSet( "YRANGE")) return TRUE; -+ //Style contains 1? -+ DLong ystyle; -+ gdlGetDesiredAxisStyle(e, "Y", ystyle); -+ if (ystyle&1) return TRUE; -+ -+ DLong nozero=0; -+ if (ystyle&16) nozero=1; -+ if ( e->KeywordSet( "YNOZERO")) nozero = 1; -+ return (nozero==1); -+ } - PLFLT AutoTick(DDouble x) - { -- if( x == 0.0) return 1.0; -+ if ( x==0.0 ) return 1.0; - -- DLong n = static_cast( floor(log10(x/3.5))); -- DDouble y = (x / (3.5 * pow(10.,static_cast(n)))); -+ DLong n=static_cast(floor(log10(x/3.5))); -+ DDouble y=(x/(3.5*pow(10., static_cast(n)))); - DLong m; -- if (y >= 1 && y < 2) -- m = 1; -- else if (y >= 2 && y < 5) -- m = 2; -- else if (y >= 5) -- m = 5; -+ if ( y>=1&&y<2 ) -+ m=1; -+ else if ( y>=2&&y<5 ) -+ m=2; -+ else if ( y>=5 ) -+ m=5; - -- PLFLT intv = (PLFLT) (m * pow(10.,static_cast(n))); -+ PLFLT intv=(PLFLT)(m*pow(10., static_cast(n))); - return intv; - } - -- - PLFLT AutoIntv(DDouble x) - { -- if( x == 0.0) { -+ if ( x==0.0 ) -+ { - // cout << "zero"<( floor(log10(x/2.82))); -- DDouble y = (x / (2.82 * pow(10.,static_cast(n)))); -+ DLong n=static_cast(floor(log10(x/2.82))); -+ DDouble y=(x/(2.82*pow(10., static_cast(n)))); - DLong m; -- if (y >= 1 && y < 2) -- m = 1; -- else if (y >= 2 && y < 4.47) -- m = 2; -- else if (y >= 4.47) -- m = 5; -+ if ( y>=1&&y<2 ) -+ m=1; -+ else if ( y>=2&&y<4.47 ) -+ m=2; -+ else if ( y>=4.47 ) -+ m=5; - - // cout << "AutoIntv" << x << " " << y << endl; - -- PLFLT intv = (PLFLT) (m * pow(10.,static_cast(n))); -+ PLFLT intv=(PLFLT)(m*pow(10., static_cast(n))); -+ return intv; -+ } -+ -+ PLFLT gdlComputeTickInterval(EnvT *e, string axis, DDouble &min, DDouble &max, bool log) -+ { -+ DLong nticks=0; -+ DStructGDL* Struct; -+ -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ -+ if ( Struct!=NULL ) -+ { -+ static unsigned tickTag=Struct->Desc()->TagIndex("TICKS"); -+ nticks= -+ (*static_cast(Struct->GetTag(tickTag, 0)))[0]; -+ } -+ -+ string TitleName=axis+"TICKS"; -+ e->AssureLongScalarKWIfPresent(TitleName, nticks); -+ -+ PLFLT intv; -+ if (nticks == 0) -+ { -+ intv = (log)? AutoTick(log10(max-min)): AutoTick(max-min); -+ } else { -+ intv = (log)? log10(max-min)/nticks: (max-min)/nticks; -+ } - return intv; - } - -+ #define EXTENDED_DEFAULT_LOGRANGE 12 -+ //protect from (inverted, strange) axis log values -+ void gdlHandleUnwantedAxisValue(DDouble &min, DDouble &max, bool log) -+ { -+ bool invert=FALSE; -+ DDouble val_min, val_max; -+ if (!log) return; -+ -+ if(max-min >= 0) -+ { -+ val_min=min; -+ val_max=max; -+ invert=FALSE; -+ } else { -+ val_min=max; -+ val_max=min; -+ invert=TRUE; -+ } -+ -+ if ( val_min<=0. ) -+ { -+ if ( val_max<=0. ) -+ { -+ val_min=-EXTENDED_DEFAULT_LOGRANGE; -+ val_max=0.0; -+ } -+ else -+ { -+ val_min=log10(val_max)-EXTENDED_DEFAULT_LOGRANGE; -+ val_max=log10(val_max); -+ } -+ } -+ else -+ { -+ val_min=log10(val_min); -+ val_max=log10(val_max); -+ } -+ if (invert) -+ { -+ min=pow(10.,val_max); -+ max=pow(10.,val_min); -+ } else { -+ min=pow(10.,val_min); -+ max=pow(10.,val_max); -+ } -+ -+ } -+#undef EXTENDED_DEFAULT_LOGRANGE -+ -+ - //improved version of "AutoIntv" for: - // 1/ better managing ranges when all the data have same value - // 2/ mimic IDL behavior when data are all positive - // please notice that (val_min, val_max) will be changed - // and "epsilon" is a coefficient if "extended range" is expected -- PLFLT AutoIntvAC(DDouble &val_min, DDouble &val_max, DLong NoZero, bool log) -+ // input: linear min and max, output: linear min and max. -+ -+ PLFLT AutoIntvAC(DDouble &start, DDouble &end, bool log) - { -- PLFLT intv = 1.; -- int cas = 0 ; -- DDouble x; -- bool debug = false ; -- if (debug) {cout << "init: " << val_min << " " << val_max << endl;} -+ gdlHandleUnwantedAxisValue(start, end, log); -+ -+ DDouble min, max; -+ bool invert=FALSE; - -- if (log) -+ if(end-start >= 0) - { -- if (val_min == 0 || val_max == 0) return intv; -- val_min = log10(val_min); -- val_max = log10(val_max); -+ min=start; -+ max=end; -+ invert=FALSE; -+ } else { -+ min=end; -+ max=start; -+ invert=TRUE; - } - -+ PLFLT intv=1.; -+ int cas=0; -+ DDouble x; -+ bool debug=false; -+ if ( debug ) -+ { -+ cout<<"init: "<= 0.0) && (NoZero == 0)) -+ // case "all values are equal" -+ if ( cas==0 ) -+ { -+ x=max-min; -+ if ( abs(x)<1e-30 ) - { -- cas = 2 ; -- DDouble resu, val_norm ; -- // we used redundant scale (1.,1.2 and 10., 12. to avoid roundoff problem in log10) -- DDouble levels[12]={1.,1.2,1.5,2.,2.5,3.,4.,5.,6.,8.,10.,12.}; -- int nb_levels= 12; -- -- DLong n = static_cast( floor(log10(val_max))); -- DDouble scale= pow(10.,static_cast(n)); -- -- val_norm=val_max/scale; -- -- resu=levels[0]; -- for (int c = 0; c < nb_levels; c++) { -- if ((val_norm > levels[c]) && (val_norm <= levels[c+1])) resu=levels[c+1] ; -- } -- val_min=0.0; -- val_max=resu*scale; -- intv = (PLFLT)(val_max); -+ DDouble val_ref; -+ val_ref=max; -+ if ( 0.98*minDesc()->TagIndex( "BACKGROUND"); -- static unsigned noEraseTag = pStruct->Desc()->TagIndex( "NOERASE"); -- static unsigned colorTag = pStruct->Desc()->TagIndex( "COLOR"); -- static unsigned psymTag = pStruct->Desc()->TagIndex( "PSYM"); -- static unsigned linestyleTag = pStruct->Desc()->TagIndex( "LINESTYLE"); -- static unsigned symsizeTag = pStruct->Desc()->TagIndex( "SYMSIZE"); -- static unsigned charsizeTag = pStruct->Desc()->TagIndex( "CHARSIZE"); -- static unsigned thickTag = pStruct->Desc()->TagIndex( "THICK"); -- static unsigned ticklenTag = pStruct->Desc()->TagIndex( "TICKLEN"); -- static unsigned titleTag = pStruct->Desc()->TagIndex( "TITLE"); -- static unsigned subTitleTag = pStruct->Desc()->TagIndex( "SUBTITLE"); -- p_background = -- (*static_cast( pStruct->GetTag( backgroundTag, 0)))[0]; -- p_noErase = -- (*static_cast( pStruct->GetTag( noEraseTag, 0)))[0]; -- p_color = -- (*static_cast( pStruct->GetTag( colorTag, 0)))[0]; -- p_psym = -- (*static_cast( pStruct->GetTag( psymTag, 0)))[0]; -- p_linestyle = -- (*static_cast( pStruct->GetTag( linestyleTag, 0)))[0]; -- p_symsize = -- (*static_cast( pStruct->GetTag( symsizeTag, 0)))[0]; -- p_charsize = -- (*static_cast( pStruct->GetTag( charsizeTag, 0)))[0]; -- p_thick = -- (*static_cast( pStruct->GetTag( thickTag, 0)))[0]; -- p_title = -- (*static_cast( pStruct->GetTag( titleTag, 0)))[0]; -- p_subTitle = -- (*static_cast( pStruct->GetTag( subTitleTag, 0)))[0]; -- p_ticklen = -- (*static_cast( pStruct->GetTag( ticklenTag, 0)))[0]; -+ -+ void GetPData( -+ DLong& p_background, -+ DLong& p_noErase, DLong& p_color, DLong& p_psym, -+ DLong& p_linestyle, -+ DFloat& p_symsize, DFloat& p_charsize, DFloat& p_thick, -+ DString& p_title, DString& p_subTitle, DFloat& p_ticklen) -+ { -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned backgroundTag=pStruct->Desc()->TagIndex("BACKGROUND"); -+ static unsigned noEraseTag=pStruct->Desc()->TagIndex("NOERASE"); -+ static unsigned colorTag=pStruct->Desc()->TagIndex("COLOR"); -+ static unsigned psymTag=pStruct->Desc()->TagIndex("PSYM"); -+ static unsigned linestyleTag=pStruct->Desc()->TagIndex("LINESTYLE"); -+ static unsigned symsizeTag=pStruct->Desc()->TagIndex("SYMSIZE"); -+ static unsigned charsizeTag=pStruct->Desc()->TagIndex("CHARSIZE"); -+ static unsigned thickTag=pStruct->Desc()->TagIndex("THICK"); -+ static unsigned ticklenTag=pStruct->Desc()->TagIndex("TICKLEN"); -+ static unsigned titleTag=pStruct->Desc()->TagIndex("TITLE"); -+ static unsigned subTitleTag=pStruct->Desc()->TagIndex("SUBTITLE"); -+ p_background= -+ (*static_cast(pStruct->GetTag(backgroundTag, 0)))[0]; -+ p_noErase= -+ (*static_cast(pStruct->GetTag(noEraseTag, 0)))[0]; -+ p_color= -+ (*static_cast(pStruct->GetTag(colorTag, 0)))[0]; -+ p_psym= -+ (*static_cast(pStruct->GetTag(psymTag, 0)))[0]; -+ p_linestyle= -+ (*static_cast(pStruct->GetTag(linestyleTag, 0)))[0]; -+ p_symsize= -+ (*static_cast(pStruct->GetTag(symsizeTag, 0)))[0]; -+ p_charsize= -+ (*static_cast(pStruct->GetTag(charsizeTag, 0)))[0]; -+ p_thick= -+ (*static_cast(pStruct->GetTag(thickTag, 0)))[0]; -+ p_title= -+ (*static_cast(pStruct->GetTag(titleTag, 0)))[0]; -+ p_subTitle= -+ (*static_cast(pStruct->GetTag(subTitleTag, 0)))[0]; -+ p_ticklen= -+ (*static_cast(pStruct->GetTag(ticklenTag, 0)))[0]; -+ } -+ -+ void GetPData2(pstruct& p) -+ { -+ int i, j; -+ static DStructGDL* pStruct=SysVar::P(); -+ -+ static unsigned backgroundTag=pStruct->Desc()->TagIndex("BACKGROUND"); -+ p.background= -+ (*static_cast(pStruct->GetTag(backgroundTag, 0)))[0]; -+ -+ static unsigned charsizeTag=pStruct->Desc()->TagIndex("CHARSIZE"); -+ p.charSize= -+ (*static_cast(pStruct->GetTag(charsizeTag, 0)))[0]; -+ -+ static unsigned charthickTag=pStruct->Desc()->TagIndex("CHARTHICK"); -+ p.charThick= -+ (*static_cast(pStruct->GetTag(charthickTag, 0)))[0]; -+ -+ static unsigned clipTag=pStruct->Desc()->TagIndex("CLIP"); -+ for ( i=0; i<6; ++i ) p.clip[i]=(*static_cast(pStruct->GetTag(clipTag, 0)))[i]; -+ -+ static unsigned colorTag=pStruct->Desc()->TagIndex("COLOR"); -+ p.color= -+ (*static_cast(pStruct->GetTag(colorTag, 0)))[0]; -+ -+ static unsigned fontTag=pStruct->Desc()->TagIndex("FONT"); -+ p.font= -+ (*static_cast(pStruct->GetTag(fontTag, 0)))[0]; -+ -+ static unsigned linestyleTag=pStruct->Desc()->TagIndex("LINESTYLE"); -+ p.lineStyle= -+ (*static_cast(pStruct->GetTag(linestyleTag, 0)))[0]; -+ -+ static unsigned multiTag=pStruct->Desc()->TagIndex("MULTI"); -+ for ( i=0; i<5; ++i ) p.multi[i]= -+ (*static_cast(pStruct->GetTag(multiTag, 0)))[i]; -+ -+ static unsigned noClipTag=pStruct->Desc()->TagIndex("NOCLIP"); -+ p.noClip= -+ (*static_cast(pStruct->GetTag(noClipTag, 0)))[0]; -+ -+ static unsigned noEraseTag=pStruct->Desc()->TagIndex("NOERASE"); -+ p.noErase= -+ (*static_cast(pStruct->GetTag(noEraseTag, 0)))[0]; -+ -+ static unsigned nsumTag=pStruct->Desc()->TagIndex("NSUM"); -+ p.nsum= -+ (*static_cast(pStruct->GetTag(nsumTag, 0)))[0]; -+ -+ static unsigned positionTag=pStruct->Desc()->TagIndex("POSITION"); -+ for ( i=0; i<4; ++i ) p.position[i]= -+ (*static_cast(pStruct->GetTag(positionTag, 0)))[i]; -+ -+ static unsigned psymTag=pStruct->Desc()->TagIndex("PSYM"); -+ p.psym= -+ (*static_cast(pStruct->GetTag(psymTag, 0)))[0]; -+ -+ static unsigned regionTag=pStruct->Desc()->TagIndex("REGION"); -+ for ( i=0; i<4; ++i ) p.region[i]= -+ (*static_cast(pStruct->GetTag(regionTag, 0)))[i]; -+ -+ static unsigned subtitleTag=pStruct->Desc()->TagIndex("SUBTITLE"); -+ p.subTitle= -+ (*static_cast(pStruct->GetTag(subtitleTag, 0)))[0]; -+ -+ static unsigned symsizeTag=pStruct->Desc()->TagIndex("SYMSIZE"); -+ p.symSize= -+ (*static_cast(pStruct->GetTag(symsizeTag, 0)))[0]; -+ -+ static unsigned tTag=pStruct->Desc()->TagIndex("T"); -+ for ( i=0; i<4; ++i ) for ( j=0; j<4; ++j ) p.t[i][j]= -+ (*static_cast(pStruct->GetTag(tTag, 0)))[j*4+i]; -+ -+ static unsigned t3dTag=pStruct->Desc()->TagIndex("T3D"); -+ p.t3d= -+ (*static_cast(pStruct->GetTag(t3dTag, 0)))[0]; -+ -+ static unsigned thickTag=pStruct->Desc()->TagIndex("THICK"); -+ p.thick= -+ (*static_cast(pStruct->GetTag(thickTag, 0)))[0]; -+ -+ static unsigned titleTag=pStruct->Desc()->TagIndex("TITLE"); -+ p.title= -+ (*static_cast(pStruct->GetTag(titleTag, 0)))[0]; -+ -+ static unsigned ticklenTag=pStruct->Desc()->TagIndex("TICKLEN"); -+ p.ticklen= -+ (*static_cast(pStruct->GetTag(ticklenTag, 0)))[0]; -+ -+ static unsigned channelTag=pStruct->Desc()->TagIndex("CHANNEL"); -+ p.channel= -+ (*static_cast(pStruct->GetTag(channelTag, 0)))[0]; - } - - // !X, !Y, !Z -- void GetAxisData( DStructGDL* xStruct, -- DLong& style, DString& title, DFloat& charSize, -- DFloat& margin0, DFloat& margin1, DFloat& ticklen) -- { -- static unsigned styleTag = xStruct->Desc()->TagIndex( "STYLE"); -- static unsigned marginTag = xStruct->Desc()->TagIndex( "MARGIN"); -- static unsigned axisTitleTag = xStruct->Desc()->TagIndex( "TITLE"); -- static unsigned axischarsizeTag = xStruct->Desc()->TagIndex( "CHARSIZE"); -- static unsigned ticklenTag = xStruct->Desc()->TagIndex( "TICKLEN"); -- style = -- (*static_cast( xStruct->GetTag( styleTag, 0)))[0]; -- title = -- (*static_cast( xStruct->GetTag( axisTitleTag, 0)))[0]; -- charSize = -- (*static_cast( xStruct->GetTag( axischarsizeTag, 0)))[0]; -- margin0 = -- (*static_cast( xStruct->GetTag( marginTag, 0)))[0]; -- margin1 = -- (*static_cast( xStruct->GetTag( marginTag, 0)))[1]; -- ticklen = -- (*static_cast( xStruct->GetTag( ticklenTag, 0)))[0]; -- } -- -- void GetUserSymSize(EnvT *e, GDLGStream *a, DDouble& UsymConvX, DDouble& UsymConvY) -- { -- DDouble *scaleX, *scaleY; -- GetSFromPlotStructs(&scaleX, &scaleY); -- // get subpage in mm -- PLFLT scrXL, scrXR, scrYB, scrYT; -- a->gspa( scrXL, scrXR, scrYB, scrYT); -- PLFLT scrX = scrXR-scrXL; -- PLFLT scrY = scrYT-scrYB; -- // get char size in mm (default, actual) -- PLFLT defH, actH; -- a->gchr( defH, actH); -- //get symsize -- static DStructGDL* pStruct = SysVar::P(); -- DFloat symsize = (*static_cast -- (pStruct->GetTag( pStruct->Desc()->TagIndex("SYMSIZE"), 0)))[0]; -- e->AssureFloatScalarKWIfPresent( "SYMSIZE", symsize); -- if( symsize <= 0.0) symsize = 1.0; -- UsymConvX=0.5*symsize*(defH/scrX)/scaleX[1]; -- UsymConvY=0.5*symsize*(defH/scrY)/scaleY[1]; - -+ void GetAxisData(DStructGDL* xStruct, -+ DLong& style, DString& title, DFloat& charSize, -+ DFloat& margin0, DFloat& margin1, DFloat& ticklen) -+ { -+ static unsigned styleTag=xStruct->Desc()->TagIndex("STYLE"); -+ static unsigned marginTag=xStruct->Desc()->TagIndex("MARGIN"); -+ static unsigned axisTitleTag=xStruct->Desc()->TagIndex("TITLE"); -+ static unsigned axischarsizeTag=xStruct->Desc()->TagIndex("CHARSIZE"); -+ static unsigned ticklenTag=xStruct->Desc()->TagIndex("TICKLEN"); -+ style= -+ (*static_cast(xStruct->GetTag(styleTag, 0)))[0]; -+ title= -+ (*static_cast(xStruct->GetTag(axisTitleTag, 0)))[0]; -+ charSize= -+ (*static_cast(xStruct->GetTag(axischarsizeTag, 0)))[0]; -+ margin0= -+ (*static_cast(xStruct->GetTag(marginTag, 0)))[0]; -+ margin1= -+ (*static_cast(xStruct->GetTag(marginTag, 0)))[1]; -+ ticklen= -+ (*static_cast(xStruct->GetTag(ticklenTag, 0)))[0]; -+ } -+ -+ void GetUserSymSize(EnvT *e, GDLGStream *a, DDouble& UsymConvX, DDouble& UsymConvY) -+ { -+ //get symsize -+ static DStructGDL* pStruct=SysVar::P(); -+ DFloat symsize=(*static_cast -+ (pStruct->GetTag(pStruct->Desc()->TagIndex("SYMSIZE"), 0)))[0]; -+ e->AssureFloatScalarKWIfPresent("SYMSIZE", symsize); -+ if ( symsize<=0.0 ) symsize=1.0; -+ -+ UsymConvX=(0.5*symsize*(a->wCharLength()/a->charScale())); //be dependent only on symsize! -+ UsymConvY=(0.5*symsize*(a->wCharHeight()/a->charScale())); -+ PLFLT wun, wdeux, wtrois, wquatre; //take care of axes world orientation! -+ a->pageWorldCoordinates(wun, wdeux, wtrois, wquatre); -+ if ((wdeux-wun)<0) UsymConvX*=-1.0; -+ if ((wquatre-wtrois)<0) UsymConvY*=-1.0; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"GetUserSymSize(%f,%f)\n",a->wCharLength(),a->wCharHeight()); - } - - void AdjustAxisOpts(string& xOpt, string& yOpt, -- DLong xStyle, DLong yStyle, DLong xTicks, DLong yTicks, -- string& xTickformat, string& yTickformat, DLong xLog, DLong yLog -- ) // {{{ -- { -- if ((xStyle & 8) == 8) xOpt = "b"; -- if ((yStyle & 8) == 8) yOpt = "b"; -- -- if (xTicks == 1) xOpt += "t"; else xOpt += "st"; -- if (yTicks == 1) yOpt += "tv"; else yOpt += "stv"; -- -- if (xTickformat != "(A1)") xOpt += "n"; -- if (yTickformat != "(A1)") yOpt += "n"; -- -- if( xLog) xOpt += "l"; -- if( yLog) yOpt += "l"; -- -- if ((xStyle & 4) == 4) xOpt = ""; -- if ((yStyle & 4) == 4) yOpt = ""; -- } // }}} -- -- void CheckMargin( EnvT* e, GDLGStream* actStream, -- DFloat xMarginL, -- DFloat xMarginR, -- DFloat yMarginB, -- DFloat yMarginT, -- PLFLT& xMR, -- PLFLT& xML, -- PLFLT& yMB, -- PLFLT& yMT) -- { -- // get subpage in mm -- PLFLT scrXL, scrXR, scrYB, scrYT; -- actStream->gspa( scrXL, scrXR, scrYB, scrYT); -- PLFLT scrX = scrXR-scrXL; -- PLFLT scrY = scrYT-scrYB; -- -- // get char size in mm (default, actual) -- PLFLT defH, actH; -- actStream->gchr( defH, actH); -- -- xML = xMarginL * actH / scrX; -- xMR = xMarginR * actH / scrX; -- -- // factor 1.111 by ACoulais on 16/12/2010. Consequences on CONVERT_COORD -- const float yCharExtension = 1.5*1.11111; -- yMB = yMarginB * actH / scrY * yCharExtension; -- yMT = yMarginT * actH / scrY * yCharExtension; -- -- if( xML+xMR >= 1.0) -- { -- Message( e->GetProName() + ": XMARGIN to large (adjusted)."); -- PLFLT xMMult = xML+xMR; -- xML /= xMMult * 1.5; -- xMR /= xMMult * 1.5; -- } -- if( yMB+yMT >= 1.0) -- { -- Message( e->GetProName() + ": YMARGIN to large (adjusted)."); -- PLFLT yMMult = yMB+yMT; -- yMB /= yMMult * 1.5; -- yMT /= yMMult * 1.5; -- } -- } -- void Clipping( DDoubleGDL* clippingD, -- DDouble& xStart, -- DDouble& xEnd, -- DDouble& minVal, -- DDouble& maxVal) -- { //do nothing, clipping should not be done thusly. -- } -- // temporary ignor clipping --// void Clipping( DDoubleGDL* clippingD, --// DDouble& xStart, --// DDouble& xEnd, --// DDouble& minVal, --// DDouble& maxVal) --// { --// SizeT cEl=clippingD->N_Elements(); --// --// // world coordinates --// DDouble wcxs, wcxe,wcys, wcye; --// --// if(cEl >= 1) wcxs=(*clippingD)[0]; else wcxs=0; --// if(cEl >= 2) wcys=(*clippingD)[1]; else wcys=0; --// if(cEl >= 3) wcxe=(*clippingD)[2]; else wcxe=wcxs; --// if(cEl >= 4) wcye=(*clippingD)[3]; else wcye=wcys; --// --// if(wcxe < wcxs ) wcxe=wcxs; --// if(wcye < wcys ) wcye=wcys; --// --// // // viewport (0..1) --// // DDouble cxs, cxe,cys, cye; --// // cxs=(-xStart+wcxs)*(1-0)/(xEnd-xStart); --// // cxe=(-xStart+wcxe)*(1-0)/(xEnd-xStart); --// // cys=(-yStart+wcys)*(1-0)/(yEnd-yStart); --// // cye=(-yStart+wcye)*(1-0)/(yEnd-yStart); --// // actStream->vpor(cxs, cxe, cys, cye); --// --// xStart=wcxs; xEnd=wcxe; minVal=wcys; maxVal=wcye; --// } -+ DLong xStyle, DLong yStyle, DLong xTicks, DLong yTicks, -+ string& xTickformat, string& yTickformat, DLong xLog, DLong yLog -+ ) -+ { -+ if ( (xStyle&8)==8 ) xOpt="b"; -+ if ( (yStyle&8)==8 ) yOpt="b"; -+ -+ if ( xTicks==1 ) xOpt+="t"; -+ else xOpt+="st"; -+ if ( yTicks==1 ) yOpt+="tv"; -+ else yOpt+="stv"; -+ -+ if ( xTickformat!="(A1)" ) xOpt+="n"; -+ if ( yTickformat!="(A1)" ) yOpt+="n"; -+ -+ if ( xLog ) xOpt+="l"; -+ if ( yLog ) yOpt+="l"; -+ -+ if ( (xStyle&4)==4 ) xOpt=""; -+ if ( (yStyle&4)==4 ) yOpt=""; -+ } -+ -+ -+ void CheckMargin3d(EnvT* e, GDLGStream* actStream, -+ PLFLT& xMR, -+ PLFLT& xML, -+ PLFLT& yMB, -+ PLFLT& yMT) -+ { -+ // [XY]MARGIN -+ DFloat xMarginL, xMarginR, yMarginB, yMarginT; -+ gdlGetDesiredAxisMargin(e, "X", xMarginL, xMarginR); -+ gdlGetDesiredAxisMargin(e, "Y", yMarginB, yMarginT); -+// PLFLT scl=actStream->dCharLength()/actStream->xSubPageSize(); //current char length/subpage size -+ PLFLT scl=actStream->nCharLength(); //current char length -+ xML=xMarginL*scl; //margin as percentage of subpage -+ xMR=xMarginR*scl; -+ cout<dCharHeight()/actStream->ySubPageSize(); //current char length/subpage size -+ scl=actStream->nCharHeight(); //current char height -+ cout<=1.0 ) -+ { -+ Message(e->GetProName()+": XMARGIN to large (adjusted)."); -+ PLFLT xMMult=xML+xMR; -+ xML/=xMMult*1.5; -+ xMR/=xMMult*1.5; -+ } -+ if ( yMB+yMT>=1.0 ) -+ { -+ Message(e->GetProName()+": YMARGIN to large (adjusted)."); -+ PLFLT yMMult=yMB+yMT; -+ yMB/=yMMult*1.5; -+ yMT/=yMMult*1.5; -+ } -+ } -+ -+ -+ void CheckMargin(EnvT* e, GDLGStream* actStream, -+ DFloat xMarginL, -+ DFloat xMarginR, -+ DFloat yMarginB, -+ DFloat yMarginT, -+ PLFLT& xMR, -+ PLFLT& xML, -+ PLFLT& yMB, -+ PLFLT& yMT) -+ { -+ PLFLT scl=actStream->dCharLength()/actStream->xSubPageSize(); //current char length/subpage size -+ xML=xMarginL*scl; //margin as percentage of subpage -+ xMR=xMarginR*scl; -+ scl=actStream->dCharHeight()/actStream->ySubPageSize(); //current char length/subpage size -+ yMB=(yMarginB+1.85)*scl; -+ yMT=(yMarginT+1.85)*scl; //to allow subscripts and superscripts (as in IDL) -+ -+ if ( xML+xMR>=1.0 ) -+ { -+ Message(e->GetProName()+": XMARGIN to large (adjusted)."); -+ PLFLT xMMult=xML+xMR; -+ xML/=xMMult*1.5; -+ xMR/=xMMult*1.5; -+ } -+ if ( yMB+yMT>=1.0 ) -+ { -+ Message(e->GetProName()+": YMARGIN to large (adjusted)."); -+ PLFLT yMMult=yMB+yMT; -+ yMB/=yMMult*1.5; -+ yMT/=yMMult*1.5; -+ } -+ } -+ - void setIsoPort(GDLGStream* actStream, -- PLFLT x1, -- PLFLT x2, -- PLFLT y1, -- PLFLT y2, -- PLFLT aspect) -+ PLFLT x1, -+ PLFLT x2, -+ PLFLT y1, -+ PLFLT y2, -+ PLFLT aspect) - { -- PLFLT X1, X2, Y1, Y2, X1s, X2s, Y1s, Y2s, displacx,displacy, scalex,scaley,offsetx,offsety; -- if (aspect <= 0.0) -+ PLFLT X1, X2, Y1, Y2, X1s, X2s, Y1s, Y2s, displacx, displacy, scalex, scaley, offsetx, offsety; -+ if ( aspect<=0.0 ) - { - actStream->vpor(x1, x2, y1, y2); - return; - } - // here we need too compensate for the change of aspect due to eventual !P.MULTI plots -- actStream->vpor(x1, x2, y1, y2); //ask for non-iso window -- actStream->gvpd(X1, X2, Y1, Y2); //get viewport values -- //compute relation desiredViewport-page viewport x=scalex*X+offsetx: -- scalex=(x2-x1)/(X2-X1); -- offsetx=(x1*X2-x2*X1)/(X2-X1); -- scaley=(y2-y1)/(Y2-Y1); -- offsety=(y1*Y2-y2*Y1)/(Y2-Y1); -- //ask for wiewport scaled to isotropic by plplot -- actStream->vpas(x1, x2, y1, y2, aspect); -- //retrieve values -- actStream->gvpd(X1s, X2s, Y1s, Y2s); -- //measure displacement -- displacx=X1s-X1; -- displacy=Y1s-Y1; -- //set wiewport scaled by plplot, displaced, as vpor using above linear transformation -- x1=(X1s-displacx)*scalex+offsetx; -- x2=(X2s-displacx)*scalex+offsetx; -- y1=(Y1s-displacy)*scaley+offsety; -- y2=(Y2s-displacy)*scaley+offsety; -- actStream->vpor(x1, x2, y1, y2); --} -- -- bool SetVP_WC( EnvT* e, -- GDLGStream* actStream, -- DFloatGDL* pos, -- DDoubleGDL* clippingD, -- bool xLog, bool yLog, -- DFloat xMarginL, -- DFloat xMarginR, -- DFloat yMarginB, -- DFloat yMarginT, -- // input/output -- DDouble xStart, -- DDouble xEnd, -- DDouble yStart, -- DDouble yEnd, -- DLong iso ) -- { -- // cout << "xStart " << xStart << " xEnd "<vpor(x1, x2, y1, y2); //ask for non-iso window -+ actStream->gvpd(X1, X2, Y1, Y2); //get viewport values -+ //compute relation desiredViewport-page viewport x=scalex*X+offsetx: -+ scalex=(x2-x1)/(X2-X1); -+ offsetx=(x1*X2-x2*X1)/(X2-X1); -+ scaley=(y2-y1)/(Y2-Y1); -+ offsety=(y1*Y2-y2*Y1)/(Y2-Y1); -+ //ask for wiewport scaled to isotropic by plplot -+ actStream->vpas(x1, x2, y1, y2, aspect); -+ //retrieve values -+ actStream->gvpd(X1s, X2s, Y1s, Y2s); -+ //measure displacement -+ displacx=X1s-X1; -+ displacy=Y1s-Y1; -+ //set wiewport scaled by plplot, displaced, as vpor using above linear transformation -+ x1=(X1s-displacx)*scalex+offsetx; -+ x2=(X2s-displacx)*scalex+offsetx; -+ y1=(Y1s-displacy)*scaley+offsety; -+ y2=(Y2s-displacy)*scaley+offsety; -+ actStream->vpor(x1, x2, y1, y2); -+ } -+ -+ bool gdlSet3DViewPortAndWorldCoordinates(EnvT* e, -+ GDLGStream* actStream, -+ DDoubleGDL* Matrix, -+ bool xLog, bool yLog, -+ DDouble xStart, -+ DDouble xEnd, -+ DDouble yStart, -+ DDouble yEnd, -+ DDouble zStart, -+ DDouble zEnd, -+ bool zLog) -+ { -+ // First, do as gdlSetViewPortAndWorldCoordinates, save some values: -+ // set ![XY].CRANGE -+ gdlStoreAxisCRANGE("X", xStart, xEnd, xLog); -+ gdlStoreAxisCRANGE("Y", yStart, yEnd, yLog); -+ gdlStoreAxisCRANGE("Z", zStart, zEnd, zLog); -+ //set ![XY].type -+ gdlStoreAxisType("X",xLog); -+ gdlStoreAxisType("Y",yLog); -+ gdlStoreAxisType("Z",zLog); -+ //set ![XY].WINDOW and ![XY].S -+ gdlStoreAxisSandWINDOW(actStream, "X", xStart, xEnd, xLog); -+ gdlStoreAxisSandWINDOW(actStream, "Y", yStart, yEnd, yLog); -+ gdlStoreAxisSandWINDOW(actStream, "Z", zStart, zEnd, zLog); -+ -+ //3D work -+ enum{ DATA=0, -+ NORMAL, -+ DEVICE -+ } coordinateSystem=DATA; -+ //To center plot, compute projected corners of 1 unit box -+ static DDouble zz[8]={0,0,0,0,1,1,1,1}; -+ static DDouble yy[8]={0,0,1,1,0,0,1,1}; -+ static DDouble xx[8]={0,1,0,1,0,1,0,1}; -+ static DDouble ww[8]={1,1,1,1,1,1,1,1}; -+ -+ DDoubleGDL* V=(new DDoubleGDL(dimension(8,4))); -+ memcpy(&((*V)[0]),xx,8*sizeof(double)); -+ memcpy(&((*V)[8]),yy,8*sizeof(double)); -+ memcpy(&((*V)[16]),zz,8*sizeof(double)); -+ memcpy(&((*V)[24]),ww,8*sizeof(double)); -+ -+ DDoubleGDL* pV=(Matrix->MatrixOp(V,false,true)); -+ -+ DDouble xmin,xmax,ymin,ymax; -+ DLong iMin,iMax; -+ pV->MinMax(&iMin,&iMax,NULL,NULL,false,0,0,4); -+ xmin=(*pV)[iMin]; -+ xmax=(*pV)[iMax]; -+ pV->MinMax(&iMin,&iMax,NULL,NULL,false,1,0,4); -+ ymin=(*pV)[iMin]; -+ ymax=(*pV)[iMax]; -+ -+ PLFLT xMR, xML, yMB, yMT; -+ DFloat xMarginL, xMarginR, yMarginB, yMarginT; -+ gdlGetDesiredAxisMargin(e, "X", xMarginL, xMarginR); -+ gdlGetDesiredAxisMargin(e, "Y", yMarginB, yMarginT); -+ PLFLT scl=actStream->nCharLength(); //current char length -+ xML=xMarginL*scl; //margin as percentage of subpage -+ xMR=xMarginR*scl; -+ scl=actStream->nCharHeight(); //current char height -+ yMB=(yMarginB)*scl; -+ yMT=(yMarginT)*scl; -+ -+ if ( xML+xMR>=1.0 ) -+ { -+ PLFLT xMMult=xML+xMR; -+ xML/=xMMult*1.5; -+ xMR/=xMMult*1.5; -+ } -+ if ( yMB+yMT>=1.0 ) -+ { -+ PLFLT yMMult=yMB+yMT; -+ yMB/=yMMult*1.5; -+ yMT/=yMMult*1.5; -+ } -+ -+ static bool kwP=FALSE; -+ PLFLT positionP[4]={0, 0, 0, 0}; -+//default box for 3d: evrything minus P.Title /P.subtitle place -+ PLFLT position[4]={0,0,1,1}; -+ // Get !P.position default values -+ static unsigned positionTag=SysVar::P()->Desc()->TagIndex("POSITION"); -+ for ( SizeT i=0; i<4; ++i ) positionP[i]=(PLFLT)(*static_cast(SysVar::P()->GetTag(positionTag, 0)))[i]; -+ //check presence of DATA,DEVICE and NORMAL options -+ if ( e->KeywordSet( "DATA")) coordinateSystem=DATA; -+ if ( e->KeywordSet( "DEVICE")) coordinateSystem=DEVICE; -+ if ( e->KeywordSet( "NORMAL")) coordinateSystem=NORMAL; -+ if (coordinateSystem==DATA && !actStream->validWorldBox()) e->Throw("PLOT: Data coordinate system not established."); -+ // read boxPosition if needed -+ int positionIx = e->KeywordIx( "POSITION"); -+ DFloatGDL* boxPosition = e->IfDefGetKWAs( positionIx); -+ if (boxPosition == NULL) boxPosition = (DFloatGDL*) 0xF; -+ if ( boxPosition!=(DFloatGDL*)0xF) -+ { -+ for ( SizeT i=0; i<4&&iN_Elements(); ++i ) position[i]=(*boxPosition)[i]; -+ } -+ // modify positionP and/or boxPosition to NORMAL if DEVICE is present -+ if (coordinateSystem==DEVICE) -+ { -+ PLFLT normx; -+ PLFLT normy; -+ actStream->DeviceToNormedDevice(positionP[0], positionP[1], normx, normy); -+ positionP[0]=normx; -+ positionP[1]=normy; -+ actStream->DeviceToNormedDevice(positionP[2], positionP[3], normx, normy); -+ positionP[2]=normx; -+ positionP[3]=normy; -+ if ( boxPosition!=(DFloatGDL*)0xF) -+ { -+ actStream->DeviceToNormedDevice(position[0], position[1], normx, normy); -+ position[0]=normx; -+ position[1]=normy; -+ actStream->DeviceToNormedDevice(position[2], position[3], normx, normy); -+ position[2]=normx; -+ position[3]=normy; -+ } -+ } -+ -+ // New plot without POSITION=[] as argument -+ if ( boxPosition==(DFloatGDL*)0xF ) -+ { -+ kwP=false; -+ // If !P.position not set use default values. coordinatesSystem not used even if present! -+ if ( positionP[0]==0&&positionP[1]==0&& -+ positionP[2]==0&&positionP[3]==0 ) -+ { -+ // Set to (smart?) default values -+ position[0]=0; -+ position[1]=0+2*(yMB/yMarginB); //subtitle -+ position[2]=1.0; -+ position[3]=1.0-2*(yMT/yMarginT); //title -+ actStream->vpor(position[0], position[2], position[1], position[3]); -+ } -+ else -+ { -+ // Use !P.position values. -+ actStream->vpor(positionP[0], positionP[2], positionP[1], positionP[3]); -+ } -+ } -+ else // Position keyword set -+ { -+ kwP=true; -+ actStream->vpor(position[0], position[2], position[1], position[3]); -+ } -+ //adjust 'world' values to give room to axis labels. Could be better if we take -+ //into account projection angles -+ // fix word values without labels: -+ actStream->wind(xmin, xmax, ymin, ymax); -+ //compute world Charsize -+ PLFLT xb, xe, yb, ye; -+ xb=xmin-xMarginL*actStream->wCharLength(); -+ xe=xmax+xMarginR*actStream->wCharLength(); -+ yb=ymin-yMarginB*actStream->wCharHeight(); -+ ye=ymax-yMarginT*actStream->wCharHeight(); -+ actStream->wind(xb, xe, yb, ye); -+ -+ //Clipping is false in 3D... -+ -+ //set P.CLIP (done by PLOT, CONTOUR, SHADE_SURF, and SURFACE) -+ Guard clipbox_guard; -+ DLongGDL* clipBox= new DLongGDL(4, BaseGDL::ZERO); clipbox_guard.Reset(clipBox); -+ PLFLT x,y; -+ actStream->gvpd(xmin, xmax, ymin, ymax); -+ -+ actStream->NormedDeviceToDevice(xmin, ymin, x,y); -+ (*clipBox)[0]=x; -+ (*clipBox)[1]=y; -+ actStream->NormedDeviceToDevice(xmax, ymax,x,y); -+ (*clipBox)[2]=x; -+ (*clipBox)[3]=y; -+ gdlStoreCLIP(clipBox); -+ return true; -+ } -+ - -+ //TODO: put margin discovery in gdlSetViewPortAndWorldCoordinates (simplify call list) -+ //also, solve the proble of passing back xStart etc if they are changed by unwantedaxisvalue()) -+ -+ bool gdlSetViewPortAndWorldCoordinates(EnvT* e, -+ GDLGStream* actStream, -+ DFloatGDL* boxPosition, -+ bool xLog, bool yLog, -+ DFloat xMarginL, -+ DFloat xMarginR, -+ DFloat yMarginB, -+ DFloat yMarginT, -+ DDouble xStart, -+ DDouble xEnd, -+ DDouble yStart, -+ DDouble yEnd, -+ DLong iso) -+ { - - PLFLT xMR; - PLFLT xML; - PLFLT yMB; - PLFLT yMT; -- -- CheckMargin( e, actStream, -- xMarginL, -- xMarginR, -- yMarginB, -- yMarginT, -- xMR, xML, yMB, yMT); -+ enum{ DATA=0, -+ NORMAL, -+ DEVICE -+ } coordinateSystem=DATA; -+ -+ CheckMargin(e, actStream, -+ xMarginL, -+ xMarginR, -+ yMarginB, -+ yMarginT, -+ xMR, xML, yMB, yMT); - - // viewport - POSITION overrides - static bool kwP=FALSE; - static bool do_iso=FALSE; - static PLFLT aspect=0.0; -- static PLFLT positionP[ 4]={0,0,0,0}; -- static PLFLT position[ 4]; -- DStructGDL* pStruct = SysVar::P(); -- -- // Get !P.position values -- if(pStruct != NULL) { -- static unsigned positionTag = pStruct->Desc()->TagIndex( "POSITION"); -- for( SizeT i=0; i<4; ++i) -- positionP[i] = (PLFLT) -- (*static_cast(pStruct->GetTag( positionTag, 0)))[i]; -- } - -- // If pos == NULL (oplot, /OVERPLOT etc. Reuse previous values) -- if (pos == NULL) -+ static PLFLT positionP[4]={0, 0, 0, 0}; -+ static PLFLT regionP[4]={0, 0, 0, 0}; -+ static PLFLT position[4]={0,0,1,1}; -+ DStructGDL* pStruct=SysVar::P(); -+ // Get !P.position values. !P.REGION is superseded by !P.POSITION -+ if ( pStruct!=NULL ) -+ { -+ -+ static unsigned regionTag=pStruct->Desc()->TagIndex("REGION"); -+ for ( SizeT i=0; i<4; ++i ) regionP[i]=(PLFLT)(*static_cast(pStruct->GetTag(regionTag, 0)))[i]; -+ static unsigned positionTag=pStruct->Desc()->TagIndex("POSITION"); -+ for ( SizeT i=0; i<4; ++i ) positionP[i]=(PLFLT)(*static_cast(pStruct->GetTag(positionTag, 0)))[i]; -+ } -+ if (regionP[0]!=regionP[2] && positionP[0]==positionP[2]) //if not ignored, and will be used, as -+ //a surrogate of !P.Position: -+ { -+ //compute position removing margins -+ positionP[0]=regionP[0]+xMarginL*actStream->nCharLength(); -+ positionP[1]=regionP[1]+yMarginB*actStream->nCharHeight(); -+ positionP[2]=regionP[2]-xMarginR*actStream->nCharLength(); -+ positionP[3]=regionP[3]-yMarginT*actStream->nCharHeight(); -+ } -+ //compatibility: Position NEVER outside [0,1]: -+ positionP[0]=max(0.0,positionP[0]); -+ positionP[1]=max(0.0,positionP[1]); -+ positionP[2]=min(1.0,positionP[2]); -+ positionP[3]=min(1.0,positionP[3]); -+ -+ //check presence of DATA,DEVICE and NORMAL options -+ if ( e->KeywordSet( "DATA")) coordinateSystem=DATA; -+ if ( e->KeywordSet( "DEVICE")) coordinateSystem=DEVICE; -+ if ( e->KeywordSet( "NORMAL")) coordinateSystem=NORMAL; -+ if (coordinateSystem==DATA && !actStream->validWorldBox()) e->Throw("PLOT: Data coordinate system not established."); -+ // read boxPosition if needed -+ if ( boxPosition!=NULL && boxPosition!=(DFloatGDL*)0xF ) -+ { -+ for ( SizeT i=0; i<4&&iN_Elements(); ++i ) position[i]=(*boxPosition)[i]; -+ } -+ // modify positionP and/or boxPosition to NORMAL if DEVICE is present -+ if (coordinateSystem==DEVICE) -+ { -+ PLFLT normx; -+ PLFLT normy; -+ actStream->DeviceToNormedDevice(positionP[0], positionP[1], normx, normy); -+ positionP[0]=normx; -+ positionP[1]=normy; -+ actStream->DeviceToNormedDevice(positionP[2], positionP[3], normx, normy); -+ positionP[2]=normx; -+ positionP[3]=normy; -+ if ( boxPosition!=NULL && boxPosition!=(DFloatGDL*)0xF ) -+ { -+ actStream->DeviceToNormedDevice(position[0], position[1], normx, normy); -+ position[0]=normx; -+ position[1]=normy; -+ actStream->DeviceToNormedDevice(position[2], position[3], normx, normy); -+ position[2]=normx; -+ position[3]=normy; -+ } -+ } -+ // Adjust Start and End for Log (convert to log) -+ if ( boxPosition!=NULL ) //new box -+ { -+ if ( xLog ) -+ { -+ gdlHandleUnwantedAxisValue(xStart, xEnd, xLog); -+ xStart=log10(xStart); -+ xEnd=log10(xEnd); -+ } -+ if ( yLog ) -+ { -+ gdlHandleUnwantedAxisValue(yStart, yEnd, yLog); -+ yStart=log10(yStart); -+ yEnd=log10(yEnd); -+ } -+ } -+ // If pos == NULL (oplot, /OVERPLOT etc: Reuse previous values) -+ if ( boxPosition==NULL ) - { - // If position keyword previously set -- if (kwP) -+ if ( kwP ) - { --// Creates a viewport with the specified normalized subpage coordinates. -- if (do_iso) setIsoPort(actStream,position[0], position[2], position[1], position[3], aspect); -+ // Creates a viewport with the specified normalized subpage coordinates. -+ if ( do_iso ) setIsoPort(actStream, position[0], position[2], position[1], position[3], aspect); - else actStream->vpor(position[0], position[2], position[1], position[3]); - } - else - { - // If !P.position not set -- if (positionP[0] == 0 && positionP[1] == 0 && -- positionP[2] == 0 && positionP[3] == 0) -+ if ( positionP[0]==0&&positionP[1]==0&& -+ positionP[2]==0&&positionP[3]==0 ) - { -- if (do_iso) setIsoPort(actStream,position[0], position[2], position[1], position[3], aspect); -+ if ( do_iso ) setIsoPort(actStream, position[0], position[2], position[1], position[3], aspect); - else actStream->vpor(position[0], position[2], position[1], position[3]); -- } -+ } - else - { - // !P.position set -- if (do_iso) setIsoPort(actStream,positionP[0], positionP[2], positionP[1], positionP[3], aspect); -+ if ( do_iso ) setIsoPort(actStream, positionP[0], positionP[2], positionP[1], positionP[3], aspect); - else actStream->vpor(positionP[0], positionP[2], positionP[1], positionP[3]); - } - } - } - else //New Plot - { -- if (iso == 1) // Check ISOTROPIC first -+ if ( iso==1 ) // Check ISOTROPIC first - { -- do_iso = TRUE; -- if ((xLog) && (yLog)) -- { -- aspect = abs(log10(yEnd/yStart) / log10(xEnd/xStart)); -- } else if (xLog) -- { -- aspect = abs((yEnd-yStart) / log10(xEnd/xStart)); -- } else if (yLog) -- { -- aspect = abs( log10(yEnd/yStart) / (xEnd-xStart)); -- } else -- { -- aspect = abs((yEnd-yStart)/(xEnd-xStart)); -- } -+ do_iso=TRUE; -+ aspect=abs((yEnd-yStart)/(xEnd-xStart)); //log-log or lin-log - } - else - { -- do_iso = FALSE; -- aspect = 0.0; // vpas with aspect=0.0 equals vpor. -+ do_iso=FALSE; -+ aspect=0.0; // vpas with aspect=0.0 equals vpor. - } - - // New plot without POSITION=[] as argument -- if (pos == (DFloatGDL*) 0xF) -+ if ( boxPosition==(DFloatGDL*)0xF ) - { -- kwP = false; -- //compute isotropic ratio & save values -- -- // If !P.position not set use default values -- if (positionP[0] == 0 && positionP[1] == 0 && -- positionP[2] == 0 && positionP[3] == 0) -+ kwP=false; -+ // If !P.position not set use default values. coordinatesSystem not used even if present! -+ if ( positionP[0]==0&&positionP[1]==0&& -+ positionP[2]==0&&positionP[3]==0 ) - { - - // Set to default values -- position[0] = xML; -- position[1] = yMB; -- position[2] = 1.0 - xMR; -- position[3] = 1.0 - yMT; -- if (do_iso) setIsoPort(actStream,position[0], position[2], position[1], position[3], aspect); -+ position[0]=xML; -+ position[1]=yMB; -+ position[2]=1.0-xMR; -+ position[3]=1.0-yMT; -+ if ( do_iso ) setIsoPort(actStream, position[0], position[2], position[1], position[3], aspect); - else actStream->vpor(position[0], position[2], position[1], position[3]); -- } -+ } - else - { -- // Use !P.position values -- if (do_iso) setIsoPort(actStream,positionP[0], positionP[2], positionP[1], positionP[3], aspect); -+ // Use !P.position values. -+ if ( do_iso ) setIsoPort(actStream, positionP[0], positionP[2], positionP[1], positionP[3], aspect); - else actStream->vpor(positionP[0], positionP[2], positionP[1], positionP[3]); - } - } -- else // Position keyword set -+ else // Position keyword set - { -- kwP = true; -- for (SizeT i = 0; i < 4 && i < pos->N_Elements(); ++i) position[ i] = (*pos)[ i]; -- if (do_iso) setIsoPort(actStream,position[0], position[2], position[1], position[3], aspect); -+ kwP=true; -+ if ( do_iso ) setIsoPort(actStream, position[0], position[2], position[1], position[3], aspect); - else actStream->vpor(position[0], position[2], position[1], position[3]); - } - } - -- // CLIPPING -- if( clippingD != NULL) -- Clipping( clippingD, xStart, xEnd, yStart, yEnd); -- - // for OPLOT start and end values are already log - // SA: changing only local variables! -- if( pos != NULL) -- { -- if( xLog) //normally xStart at this point should never be <=0! -- { -- if( xStart <= 0.0) xStart = -12; else xStart = log10( xStart); -- if( xEnd <= 0.0) return false; else xEnd = log10( xEnd); -- } -- if( yLog) //normally yStart at this point should never be <=0! -- { -- if( yStart <= 0.0) yStart = -12; else yStart = log10( yStart); -- if( yEnd <= 0.0) return false; else yEnd = log10( yEnd); -- } -- } --// cout << "VP wind: "<wind( xStart, xEnd, yStart, yEnd); --// cout << "xStart " << xStart << " xEnd "<gvpd (p_xmin, p_xmax, p_ymin, p_ymax); - -- DStructGDL* Struct = NULL; -- if (xLog) xStart=log10(xStart); -- if (xLog) xEnd=log10(xEnd); -- if (yLog) yStart=log10(yStart); -- if (yLog) yEnd=log10(yEnd); -- -- Struct = SysVar::X(); -- static unsigned windowTag = Struct->Desc()->TagIndex( "WINDOW"); -- static unsigned sTag = Struct->Desc()->TagIndex( "S"); -- if (Struct != NULL) -+ //cout << "VP wind: "<( Struct->GetTag( windowTag, 0)))[0] = p_xmin; -- (*static_cast( Struct->GetTag( windowTag, 0)))[1] = p_xmax; -- -- (*static_cast( Struct->GetTag( sTag, 0)))[0] = -- (p_xmin*xEnd - p_xmax*xStart) / (xEnd - xStart); -- (*static_cast( Struct->GetTag( sTag, 0)))[1] = -- (p_xmax - p_xmin) / (xEnd - xStart); -+ Message(e->GetProName()+"Coordinate system in error, please report to authors."); -+ xStart=0.0; -+ xEnd=1.0; - } -- -- Struct = SysVar::Y(); -- if(Struct != NULL) -+ if (yStart==yEnd) - { -- (*static_cast( Struct->GetTag( windowTag, 0)))[0] = p_ymin; -- (*static_cast( Struct->GetTag( windowTag, 0)))[1] = p_ymax; -- -- (*static_cast( Struct->GetTag( sTag, 0)))[0] = -- (p_ymin*yEnd - p_ymax*yStart) / (yEnd - yStart); -- (*static_cast( Struct->GetTag( sTag, 0)))[1] = -- (p_ymax - p_ymin) / (yEnd - yStart); -- } -+ Message(e->GetProName()+"Coordinate system in error, please report to authors."); -+ yStart=0.0; -+ yEnd=1.0; -+ } -+ actStream->wind(xStart, xEnd, yStart, yEnd); -+ // cout << "xStart " << xStart << " xEnd "< clipbox_guard; -+ DLongGDL* clipBox= new DLongGDL(4, BaseGDL::ZERO); clipbox_guard.Reset(clipBox); -+ PLFLT xmin, xmax, ymin, ymax, x,y; -+ actStream->gvpd(xmin, xmax, ymin, ymax); -+ -+ actStream->NormedDeviceToDevice(xmin, ymin, x,y); -+ (*clipBox)[0]=x; -+ (*clipBox)[1]=y; -+ actStream->NormedDeviceToDevice(xmax, ymax,x,y); -+ (*clipBox)[2]=x; -+ (*clipBox)[3]=y; -+ gdlStoreCLIP(clipBox); -+ return true; - } - -- void GetSFromPlotStructs(DDouble **sx, DDouble **sy) -- { -- static DStructGDL* xStruct = SysVar::X(); -- static DStructGDL* yStruct = SysVar::Y(); -- unsigned sxTag = xStruct->Desc()->TagIndex( "S"); -- unsigned syTag = yStruct->Desc()->TagIndex( "S"); -- *sx = &(*static_cast( xStruct->GetTag( sxTag, 0)))[0]; -- *sy = &(*static_cast( yStruct->GetTag( syTag, 0)))[0]; -+ -+ void GetSFromPlotStructs(DDouble **sx, DDouble **sy, DDouble **sz) -+ { -+ static DStructGDL* xStruct=SysVar::X(); -+ static DStructGDL* yStruct=SysVar::Y(); -+ static DStructGDL* zStruct=SysVar::Z(); -+ unsigned sxTag=xStruct->Desc()->TagIndex("S"); -+ unsigned syTag=yStruct->Desc()->TagIndex("S"); -+ unsigned szTag=zStruct->Desc()->TagIndex("S"); -+ if (sx != NULL) *sx= &(*static_cast(xStruct->GetTag(sxTag, 0)))[0]; -+ if (sy != NULL) *sy= &(*static_cast(yStruct->GetTag(syTag, 0)))[0]; -+ if (sz != NULL) *sz= &(*static_cast(zStruct->GetTag(szTag, 0)))[0]; - } - - void GetWFromPlotStructs(DFloat **wx, DFloat **wy) - { -- static DStructGDL* xStruct = SysVar::X(); -- static DStructGDL* yStruct = SysVar::Y(); -- unsigned xwindowTag = xStruct->Desc()->TagIndex( "WINDOW"); -- unsigned ywindowTag = yStruct->Desc()->TagIndex( "WINDOW"); -- *wx = &(*static_cast( xStruct->GetTag( xwindowTag, 0)))[0]; -- *wy = &(*static_cast( yStruct->GetTag( ywindowTag, 0)))[0]; -+ static DStructGDL* xStruct=SysVar::X(); -+ static DStructGDL* yStruct=SysVar::Y(); -+ unsigned xwindowTag=xStruct->Desc()->TagIndex("WINDOW"); -+ unsigned ywindowTag=yStruct->Desc()->TagIndex("WINDOW"); -+ *wx= &(*static_cast(xStruct->GetTag(xwindowTag, 0)))[0]; -+ *wy= &(*static_cast(yStruct->GetTag(ywindowTag, 0)))[0]; - } - - void GetUsym(DLong **n, DInt **do_fill, DFloat **x, DFloat **y) - { -- static DStructGDL* usymStruct = SysVar::USYM(); -- unsigned nTag = usymStruct->Desc()->TagIndex( "DIM"); -- unsigned fillTag = usymStruct->Desc()->TagIndex( "FILL"); -- unsigned xTag = usymStruct->Desc()->TagIndex( "X"); -- unsigned yTag = usymStruct->Desc()->TagIndex( "Y"); -- -- *n = &(*static_cast( usymStruct->GetTag( nTag, 0)))[0]; -- *do_fill = &(*static_cast( usymStruct->GetTag( fillTag, 0)))[0]; -- *x = &(*static_cast( usymStruct->GetTag( xTag, 0)))[0]; -- *y = &(*static_cast( usymStruct->GetTag( yTag, 0)))[0]; -+ static DStructGDL* usymStruct=SysVar::USYM(); -+ unsigned nTag=usymStruct->Desc()->TagIndex("DIM"); -+ unsigned fillTag=usymStruct->Desc()->TagIndex("FILL"); -+ unsigned xTag=usymStruct->Desc()->TagIndex("X"); -+ unsigned yTag=usymStruct->Desc()->TagIndex("Y"); -+ -+ *n= &(*static_cast(usymStruct->GetTag(nTag, 0)))[0]; -+ *do_fill= &(*static_cast(usymStruct->GetTag(fillTag, 0)))[0]; -+ *x= &(*static_cast(usymStruct->GetTag(xTag, 0)))[0]; -+ *y= &(*static_cast(usymStruct->GetTag(yTag, 0)))[0]; - } - - void SetUsym(DLong n, DInt do_fill, DFloat *x, DFloat *y) - { -- static DStructGDL* usymStruct = SysVar::USYM(); -- unsigned xTag = usymStruct->Desc()->TagIndex( "X"); -- unsigned yTag = usymStruct->Desc()->TagIndex( "Y"); -- unsigned nTag = usymStruct->Desc()->TagIndex( "DIM"); -- unsigned fillTag = usymStruct->Desc()->TagIndex( "FILL"); -- -- (*static_cast( usymStruct->GetTag( nTag, 0)))[0] = n; -- (*static_cast( usymStruct->GetTag( fillTag, 0)))[0] = do_fill; -- -- for (int i=0; i( usymStruct->GetTag( xTag, 0)))[i] = x[i]; -- (*static_cast( usymStruct->GetTag( yTag, 0)))[i] = y[i]; -- } -- } -+ static DStructGDL* usymStruct=SysVar::USYM(); -+ unsigned xTag=usymStruct->Desc()->TagIndex("X"); -+ unsigned yTag=usymStruct->Desc()->TagIndex("Y"); -+ unsigned nTag=usymStruct->Desc()->TagIndex("DIM"); -+ unsigned fillTag=usymStruct->Desc()->TagIndex("FILL"); -+ -+ (*static_cast(usymStruct->GetTag(nTag, 0)))[0]=n; -+ (*static_cast(usymStruct->GetTag(fillTag, 0)))[0]=do_fill; -+ -+ for ( int i=0; i(usymStruct->GetTag(xTag, 0)))[i]=x[i]; -+ (*static_cast(usymStruct->GetTag(yTag, 0)))[i]=y[i]; -+ } -+ } - - void DataCoordLimits(DDouble *sx, DDouble *sy, DFloat *wx, DFloat *wy, -- DDouble *xStart, DDouble *xEnd, DDouble *yStart, DDouble *yEnd, bool clip_by_default) -+ DDouble *xStart, DDouble *xEnd, DDouble *yStart, DDouble *yEnd, bool clip_by_default) - { -- *xStart = (wx[0] - sx[0]) / sx[1]; -- *xEnd = (wx[1] - sx[0]) / sx[1]; -- *yStart = (wy[0] - sy[0]) / sy[1]; -- *yEnd = (wy[1] - sy[0]) / sy[1]; -+ *xStart=(wx[0]-sx[0])/sx[1]; -+ *xEnd=(wx[1]-sx[0])/sx[1]; -+ *yStart=(wy[0]-sy[0])/sy[1]; -+ *yEnd=(wy[1]-sy[0])/sy[1]; - // cout << *xStart <<" "<< *xEnd << " "<< *yStart <<" "<< *yEnd << ""<< endl; - - // patch from Joanna (tracker item no. 3029409, see test_clip.pro) -- if (!clip_by_default) { -+ if ( !clip_by_default ) -+ { - // cout << "joanna" << endl; -- DFloat wxlen = wx[1] - wx[0]; -- DFloat wylen = wy[1] - wy[0]; -- DFloat xlen = *xEnd - *xStart; -- DFloat ylen = *yEnd - *yStart; -- *xStart = *xStart - xlen/wxlen * wx[0]; -- *xEnd = *xEnd + xlen/wxlen * (1 - wx[1]); -- *yStart = *yStart - ylen/wylen * wy[0]; -- *yEnd = *yEnd + ylen/wylen * (1 - wy[1]); -+ DFloat wxlen=wx[1]-wx[0]; -+ DFloat wylen=wy[1]-wy[0]; -+ DFloat xlen= *xEnd- *xStart; -+ DFloat ylen= *yEnd- *yStart; -+ *xStart= *xStart-xlen/wxlen*wx[0]; -+ *xEnd= *xEnd+xlen/wxlen*(1-wx[1]); -+ *yStart= *yStart-ylen/wylen*wy[0]; -+ *yEnd= *yEnd+ylen/wylen*(1-wy[1]); - } - // cout << *xStart <<" "<< *xEnd << " "<< *yStart <<" "<< *yEnd << ""<< endl; - } - -- -- void ac_histo(GDLGStream *a, int i_buff, PLFLT *x_buff, PLFLT *y_buff, bool xLog ) -+ void ac_histo(GDLGStream *a, int i_buff, PLFLT *x_buff, PLFLT *y_buff, bool xLog) - { -- PLFLT x,x1,y,y1,val; -- for ( int jj=1; jjjoin(x1,y1,val,y1); -- a->join(val,y1,val,y); -- a->join(val,y,x,y); -+ if ( xLog ) -+ { -+ // val=log10((pow(10.0,x1)+pow(10.0,x))/2.0); -+ val=x1+log10(0.5+0.5*(pow(10.0, x-x1))); -+ } -+ else -+ { -+ val=(x1+x)/2.0; -+ } -+ a->join(x1, y1, val, y1); -+ a->join(val, y1, val, y); -+ a->join(val, y, x, y); - } - } -+ bool startClipping(EnvT *e, GDLGStream *a, bool UsePClip) -+ { -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"startClipping\n"); -+ //function to be called when clipping must be actived, i.e., if the combination of CLIP= and NOCLIP= necessitate it -+ //the function retrievs the pertinent information in keywords -+ enum -+ { -+ DATA=0, -+ NORMAL, -+ DEVICE -+ } coordinateSystem=DATA; -+ bool xinverted=FALSE; -+ bool yinverted=FALSE; //for inverted DATA coordinates -+ if ( e->KeywordSet("DATA") ) coordinateSystem=DATA; -+ if ( e->KeywordSet("DEVICE") ) coordinateSystem=DEVICE; -+ if ( e->KeywordSet("NORMAL") ) coordinateSystem=NORMAL; -+ //special treatment for PLOTS, XYOUTS... - -- void getNormalizedCoordinatesFromPLPLOT(GDLGStream *a, DDouble wx, DDouble wy, DDouble *nx, DDouble *ny) -- { -- // from current values derive the relative coordinates in the sense of plplot -- DDouble s1,s2; -- PLFLT nxmin,nxmax,nymin,nymax,wxmin,wxmax,wymin,wymax; -- a->gvpd(nxmin,nxmax,nymin,nymax);//norm of current box -- a->gvpw(wxmin,wxmax,wymin,wymax); --// fprintf(stderr,"World: x=[%lf,%lf] y=[%lf,%lf] Norm: x=[%lf,%lf] y=[%lf,%lf]\n",wxmin,wxmax,wymin,wymax,nxmin,nxmax,nymin,nymax); -- s1=(nxmax-nxmin)/(wxmax-wxmin); -- s2=nxmin; -- *nx=s1*(wx-wxmin)+s2; -- s1=(nymax-nymin)/(wymax-wymin); -- s2=nymin; -- *ny=s1*(wy-wymin)+s2; -- } -- void getWorldCoordinatesFromPLPLOT(GDLGStream *a, DDouble nx, DDouble ny, DDouble *wx, DDouble *wy) -- { -- // from current values derive the world coordinates in the sense of plplot -- DDouble s1,s2; -- PLFLT nxmin,nxmax,nymin,nymax,wxmin,wxmax,wymin,wymax; -- a->gvpd(nxmin,nxmax,nymin,nymax); //norm of current box -- a->gvpw(wxmin,wxmax,wymin,wymax); //world of current box --// fprintf(stderr,"World: x=[%lf,%lf] y=[%lf,%lf] Norm: x=[%lf,%lf] y=[%lf,%lf]\n",wxmin,wxmax,wymin,wymax,nxmin,nxmax,nymin,nymax); -- s1=(wxmax-wxmin)/(nxmax-nxmin); -- s2=wxmin; -- *wx=s1*(nx-nxmin)+s2; -- s1=(wymax-wymin)/(nymax-nymin); -- s2=wymin; -- *wy=s1*(ny-nymin)+s2; -- } -+ if (UsePClip) -+ { -+ coordinateSystem=DEVICE; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"USEPCLIP=TRUE!\n"); -+ } -+ int clippingix=e->KeywordIx("CLIP"); -+ DFloatGDL* clipBox=NULL; -+ clipBox=e->IfDefGetKWAs(clippingix); -+ if (clipBox!=NULL) -+ { -+ if (clipBox->N_Elements()<4) return false; -+ if ( (*clipBox)[0]==(*clipBox)[3] ||(*clipBox)[1]==(*clipBox)[2] ) return false; -+ } else if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"NULL CLIPBOX passed\n"); -+ //Save current box -+ a->gvpd(saveBox.nx1, saveBox.nx2, saveBox.ny1, saveBox.ny2); //save norm of current box -+ a->gvpw(saveBox.wx1, saveBox.wx2, saveBox.wy1, saveBox.wy2); //save world of current box -+ //test axis inversion -+ xinverted=(saveBox.wx1>saveBox.wx2); -+ yinverted=(saveBox.wy1>saveBox.wy2); -+ //GET CLIPPING -+ PLFLT dClipBox[4]={0, 0, 0, 0}; -+ PLFLT tempbox[4]={0, 0, 0, 0}; -+ DDouble un, deux, trois, quatre; -+ bool willNotClip=e->KeywordSet("NOCLIP"); -+ -+ if (willNotClip) -+ { -+ dClipBox[2]=a->xPageSize(); -+ dClipBox[3]=a->yPageSize(); -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr, "using NOCLIP, i.e. [%f,%f,%f,%f]\n", dClipBox[0], dClipBox[1], dClipBox[2], dClipBox[3]); -+ } -+ else -+ { -+ if ( clipBox==NULL || UsePClip ) //get !P.CLIP -+ { -+ DStructGDL* pStruct=SysVar::P(); -+ unsigned clipTag=pStruct->Desc()->TagIndex("CLIP"); //is in device coordinates -+ for ( int i=0; i<4; ++i ) tempbox[i]=dClipBox[i]=(*static_cast(pStruct->GetTag(clipTag, 0)))[i]; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr, "using !P.CLIP=[%f,%f,%f,%f]\n", dClipBox[0], dClipBox[1], dClipBox[2], dClipBox[3]); -+ } -+ else //get units, convert to world coords for plplot, take care of axis direction -+ { -+ for ( int i=0; i<4&&iN_Elements(); ++i ) tempbox[i]=dClipBox[i]=(*clipBox)[i]; -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr, "using given CLIP=[%f,%f,%f,%f]\n", dClipBox[0], dClipBox[1], dClipBox[2], dClipBox[3]); -+ if ( coordinateSystem==DATA ) -+ { -+ int *tx,*ty; -+ int txn[2]={0,2}; -+ int txr[2]={2,0}; -+ int tyn[2]={1,3}; -+ int tyr[2]={3,1}; -+ if(tempbox[0]WorldToDevice(un, deux, trois, quatre); -+ dClipBox[0]=trois; -+ dClipBox[1]=quatre; -+ un=tempbox[tx[1]]; -+ deux=tempbox[ty[1]]; -+ a->WorldToDevice(un, deux, trois, quatre); -+ dClipBox[2]=trois; -+ dClipBox[3]=quatre; -+ } -+ else if ( coordinateSystem==NORMAL ) -+ { -+ a->NormToDevice(tempbox[0], tempbox[1], dClipBox[0], dClipBox[1]); -+ a->NormToDevice(tempbox[2], tempbox[3], dClipBox[2], dClipBox[3]); -+ } -+ } -+ } -+ //if new box is in error, return it: -+ if (dClipBox[0]>=dClipBox[2]||dClipBox[1]>=dClipBox[3]) return FALSE; -+ //compute and set corresponding world coords before using whole page: -+ a->DeviceToWorld(dClipBox[0], dClipBox[1],tempbox[0], tempbox[1]); -+ a->DeviceToWorld(dClipBox[2], dClipBox[3],tempbox[2], tempbox[3]); - -- static DDouble savedPointX=0.0; -- static DDouble savedPointY=0.0; -- void saveLastPoint(GDLGStream *a, DDouble wx, DDouble wy) -- { -- DDouble nx; -- DDouble ny; -- getNormalizedCoordinatesFromPLPLOT(a, wx, wy, &savedPointX, &savedPointY); --// fprintf(stderr,"Saved norm: %lf %lf\n",savedPointX,savedPointY); -+ a->NoSub(); -+ // set full page viewport for the clip box boundaries: -+ PLFLT xmin,xmax,ymin,ymax; -+ a->DeviceToNormedDevice(dClipBox[0], dClipBox[1],xmin, ymin); -+ a->DeviceToNormedDevice(dClipBox[2], dClipBox[3],xmax, ymax); -+ a->vpor(xmin, xmax,ymin, ymax); -+ a->wind(tempbox[0], tempbox[2], tempbox[1], tempbox[3]); -+// a->box( "bc", 0, 0, "bc", 0.0, 0); -+ return TRUE; - } -- void getLastPoint(GDLGStream *a, DDouble* wx, DDouble* wy) -+ -+ void stopClipping(GDLGStream *a) -+ { -+ a->vpor(saveBox.nx1, saveBox.nx2, saveBox.ny1, saveBox.ny2); //restore norm of current box -+ a->wind(saveBox.wx1, saveBox.wx2, saveBox.wy1, saveBox.wy2); //give back world of current box -+ } -+ -+ void saveLastPoint(GDLGStream *a, DDouble wx, DDouble wy) - { -- getWorldCoordinatesFromPLPLOT(a, savedPointX, savedPointY , wx, wy); --// fprintf(stderr,"Got norm: %lf %lf giving %lf %lf world\n", savedPointX, savedPointY, *wx, *wy); -+ a->WorldToNormedDevice(wx, wy, savedPointX, savedPointY); -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"saveLastPoint as %lf %lf\n", savedPointX, savedPointY); - } -+ -+ void getLastPoint(GDLGStream *a, DDouble& wx, DDouble& wy) -+ { -+ a->NormedDeviceToWorld(savedPointX, savedPointY, wx, wy); -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"getLastPoint: Got dev: %lf %lf giving %lf %lf world\n", savedPointX, savedPointY, wx, wy); -+ } -+ -+ - //CORE PLOT FUNCTION -> Draws a line along xVal, yVal - - template bool draw_polyline(EnvT *e, GDLGStream *a, -- T * xVal, T* yVal, -- DDouble minVal, DDouble maxVal, bool doMinMax, -- bool xLog, bool yLog, -- DLong psym, bool append){ -- bool line = false; -- bool valid = true; -- DLong psym_ = 0; -- -- if (psym < 0) { -- line = true; -- psym_ = -psym; -- } else if (psym == 0) { -- line = true; -- psym_ = psym; -- } else { -- psym_ = psym; -+ T * xVal, T* yVal, -+ DDouble minVal, DDouble maxVal, bool doMinMax, -+ bool xLog, bool yLog, -+ DLong psym, bool append, DLongGDL *color) -+ { -+ bool docolor=(color != NULL); -+ // Get decomposed value for colors -+ DLong decomposed=Graphics::GetDevice()->GetDecomposed(); -+ -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"draw_polyline()\n"); -+ SizeT plotIndex=0; -+ bool line=false; -+ bool valid=true; -+ DLong psym_=0; -+ -+ if ( psym<0 ) -+ { -+ line=true; -+ psym_= -psym; -+ } -+ else if ( psym==0 ) -+ { -+ line=true; -+ psym_=psym; -+ } -+ else -+ { -+ psym_=psym; - } - -- //usersym -+ //usersym and other syms as well! - DFloat *userSymX, *userSymY; - DLong *userSymArrayDim; - DInt *do_fill; -- if (psym_ == 8) { -+ static DInt nofill=0; -+ DDouble UsymConvX, UsymConvY; -+ GetUserSymSize(e, a, UsymConvX, UsymConvY); -+ if ( psym_==8 ) -+ { - GetUsym(&userSymArrayDim, &do_fill, &userSymX, &userSymY); -- if (*userSymArrayDim == 0) { -+ if ( *userSymArrayDim==0 ) -+ { - e->Throw("No user symbol defined."); - } - } -- DDouble UsymConvX, UsymConvY; -- GetUserSymSize(e, a, UsymConvX, UsymConvY); -+ else if ( (psym_>0&&psym_<8)) -+ { -+ do_fill=&nofill; -+ userSymArrayDim=&(syml[psym_-1]); -+ switch(psym_) -+ { -+ case 1: -+ userSymX=sym1x; -+ userSymY=sym1y; -+ break; -+ case 2: -+ userSymX=sym2x; -+ userSymY=sym2y; -+ break; -+ case 3: -+ userSymX=sym3x; -+ userSymY=sym3y; -+ break; -+ case 4: -+ userSymX=sym4x; -+ userSymY=sym4y; -+ break; -+ case 5: -+ userSymX=sym5x; -+ userSymY=sym5y; -+ break; -+ case 6: -+ userSymX=sym6x; -+ userSymY=sym6y; -+ break; -+ case 7: -+ userSymX=sym7x; -+ userSymY=sym7y; -+ break; -+ } -+ } - -- DLong minEl = (xVal->N_Elements() < yVal->N_Elements()) ? -- xVal->N_Elements() : yVal->N_Elements(); -+ DLong minEl=(xVal->N_Elements()N_Elements())? -+ xVal->N_Elements():yVal->N_Elements(); - // if scalar x -- if (xVal->N_Elements() == 1 && xVal->Rank() == 0) -- minEl = yVal->N_Elements(); -+ if ( xVal->N_Elements()==1&&xVal->Rank()==0 ) -+ minEl=yVal->N_Elements(); - // if scalar y -- if (yVal->N_Elements() == 1 && yVal->Rank() == 0) -- minEl = xVal->N_Elements(); -+ if ( yVal->N_Elements()==1&&yVal->Rank()==0 ) -+ minEl=xVal->N_Elements(); - -- bool mapSet = false; -- #ifdef USE_LIBPROJ4 -+ bool mapSet=false; -+#ifdef USE_LIBPROJ4 - // Map Stuff (xtype = 3) - LPTYPE idata; - XYTYPE odata; -@@ -807,183 +1472,213 @@ - get_mapset(mapSet); - - DDouble xStart, xEnd; -- get_axis_crange("X", xStart, xEnd); -+ gdlGetCurrentAxisRange("X", xStart, xEnd); - -- if (mapSet) { -- ref = map_init(); -- if (ref == NULL) { -+ if ( mapSet ) -+ { -+ ref=map_init(); -+ if ( ref==NULL ) -+ { - e->Throw("Projection initialization failed."); - } - } -- #endif -+#endif - - // is one of the 2 "arrays" a singleton or not ? - -- PLFLT y, y1, yMapBefore, y_ref; -- int flag_y_const = 0; -- y_ref = static_cast((*yVal)[0]); -- if (yVal->N_Elements() == 1 && yVal->Rank() == 0) flag_y_const = 1; -+ PLFLT y, yMapBefore, y_ref; -+ int flag_y_const=0; -+ y_ref=static_cast((*yVal)[0]); -+ if ( yVal->N_Elements()==1&&yVal->Rank()==0 ) flag_y_const=1; - - PLFLT x, x1, xMapBefore, x_ref; -- int flag_x_const = 0; -- x_ref = static_cast((*xVal)[0]); -- if (xVal->N_Elements() == 1 && xVal->Rank() == 0) flag_x_const = 1; -+ int flag_x_const=0; -+ x_ref=static_cast((*xVal)[0]); -+ if ( xVal->N_Elements()==1&&xVal->Rank()==0 ) flag_x_const=1; - - // AC 070601 we use a buffer to use the fast ->line method - // instead of the slow ->join one. - // 2 tricks: - // trick 1/ size of buffer is limited to 1e4 (compromize syze/speed) in order to be able to manage very -- // large among of data whitout duplicating all the arrays -+ // large amount of data whitout duplicating all the arrays - // trick 2/ when we have a NaN or and Inf, we realize the plot, then reset. - -- int debug_ac = 0; -- -- int n_buff_max = 500000; // idl default seems to be more than 2e6 !! -+ int GDL_POLYLINE_BUFFSIZE=500000; // idl default seems to be more than 2e6 !! - -- if (minEl < n_buff_max) n_buff_max = append ? minEl + 1 : minEl; -- int i_buff = 0; -- PLFLT *x_buff = new PLFLT[n_buff_max]; -- PLFLT *y_buff = new PLFLT[n_buff_max]; -+ if ( minEl((*xVal)[i]); -- else x = x_ref; -- if (!flag_y_const) y = static_cast((*yVal)[i]); -- else y = y_ref; -- } -- #ifdef USE_LIBPROJ4 -- if (mapSet && !e->KeywordSet("NORMAL")) { -- idata.lam = x * DEG_TO_RAD; -- idata.phi = y * DEG_TO_RAD; -- if (i > 0) { -- xMapBefore = odata.x; -- yMapBefore = odata.y; -- } -- odata = PJ_FWD(idata, ref); -- x = odata.x; -- y = odata.y; -- } -- #endif -- isBad = (!isfinite(x) || !isfinite(y) || isnan(x) || isnan(y)); -- if (doMinMax) isBad = (isBad || (y < minVal) || (y > maxVal)); -- if (isBad) { -- reset = 1; -- if (i_buff > 0) { -- if (line) { -- a->line(i_buff, x_buff, y_buff); -- } -- if ((psym_ > 0 && psym_ < 8) || psym_ == 9) { -- a->poin(i_buff, x_buff, y_buff, codeArr[psym_]); -- } -- if (psym_ == 8) { -- PLFLT *xx = new PLFLT[*userSymArrayDim]; -- PLFLT *yy = new PLFLT[*userSymArrayDim]; -- for (int j = 0; j < i_buff; ++j) { -- if (debug_ac) { -- cout << "j: " << j << ", X: " << x_buff[j] << ", Y: " << y_buff[j] << endl; -- }; -- for (int kk = 0; kk < *userSymArrayDim; kk++) { -- xx[kk] = x_buff[j] + userSymX[kk] * UsymConvX; -- yy[kk] = y_buff[j] + userSymY[kk] * UsymConvY; -- } -- if (*do_fill == 1) { -- a->fill(*userSymArrayDim, xx, yy); -- } else { -- a->line(*userSymArrayDim, xx, yy); -- } -- } -- } -- if (psym_ == 10) { -- ac_histo(a, i_buff, x_buff, y_buff, xLog); -+ append=FALSE; //and stop appending after! -+ if ( xLog ) x=pow(10, x); -+ if ( yLog ) y=pow(10, y); -+ } -+ else -+ { -+ if ( !flag_x_const ) x=static_cast((*xVal)[i]); -+ else x=x_ref; -+ if ( !flag_y_const ) y=static_cast((*yVal)[i]); -+ else y=y_ref; -+ } -+#ifdef USE_LIBPROJ4 -+ if ( mapSet&& !e->KeywordSet("NORMAL") ) -+ { -+ idata.lam=x * DEG_TO_RAD; -+ idata.phi=y * DEG_TO_RAD; -+ if ( i>0 ) -+ { -+ xMapBefore=odata.x; -+ yMapBefore=odata.y; -+ } -+ odata=PJ_FWD(idata, ref); -+ x=odata.x; -+ y=odata.y; -+ } -+#endif -+ //note: here y is in minVal maxVal -+ if ( doMinMax ) isBad=((ymaxVal)); -+ if ( xLog ) x=log10(x); -+ if ( yLog ) y=log10(y); -+ isBad=(isBad||!isfinite(x)|| !isfinite(y)||std::isnan(x)||std::isnan(y)); -+ if ( isBad ) -+ { -+ reset=1; -+ if ( i_buff>0 ) -+ { -+ if ( line ) -+ { -+ if (docolor) for (SizeT jj=0; jj< i_buff-1 ; ++jj) -+ { -+ a->Color ( ( *color )[plotIndex%color->N_Elements ( )], decomposed, 2); -+ a->line(2, &(x_buff[jj]), &(y_buff[jj])); -+ plotIndex++; -+ } -+ else a->line(i_buff, x_buff, y_buff); -+ } -+ if (psym_>0&&psym_<9) -+ { -+ PLFLT *xx=new PLFLT[*userSymArrayDim]; -+ PLFLT *yy=new PLFLT[*userSymArrayDim]; -+ for ( int j=0; jColor ( ( *color )[plotIndex%color->N_Elements ( )], decomposed, 2 ); -+ plotIndex++; -+ } -+ if ( *do_fill==1 ) -+ { -+ a->fill(*userSymArrayDim, xx, yy); -+ } -+ else -+ { -+ a->line(*userSymArrayDim, xx, yy); -+ } -+ } -+ } -+ if ( psym_==10 ) -+ { -+ ac_histo(a, i_buff, x_buff, y_buff, xLog); - } -- i_buff = 0; -+ i_buff=0; - } - continue; - } - -- #ifdef USE_LIBPROJ4 -- if (mapSet && !e->KeywordSet("NORMAL")) { -- if (i > 0) //;&& (i_buff >0)) -+#ifdef USE_LIBPROJ4 -+ if ( mapSet&& !e->KeywordSet("NORMAL") ) //IS BROKEN FOR X/YLOG !!!!!! -+ { -+ if ( i>0 ) //;&& (i_buff >0)) - { -- x1 = xMapBefore; -- if (!isfinite(xMapBefore) || !isfinite(yMapBefore)) continue; -+ x1=xMapBefore; -+ if ( !isfinite(xMapBefore)|| !isfinite(yMapBefore) ) continue; - - // Break "jumps" across maps (kludge!) -- if (fabs(x - x1) > 0.5 * (xEnd - xStart)) { -- reset = 1; -- if ((i_buff > 0) && (line)) { -+ if ( fabs(x-x1)>0.5*(xEnd-xStart) ) -+ { -+ reset=1; -+ if ( (i_buff>0)&&(line) ) -+ { - a->line(i_buff, x_buff, y_buff); - // x_buff[0]=x_buff[i_buff-1]; - //y_buff[0]=y_buff[i_buff-1]; -- i_buff = 0; -+ i_buff=0; - } - continue; - } - } - } -- #endif -- //note: here y is in minVal maxVal -- if (xLog) if (x <= 0.0) continue; -- else x = log10(x); -- if (yLog) if (y <= 0.0) continue; -- else y = log10(y); -- -- x_buff[i_buff] = x; -- y_buff[i_buff] = y; -- i_buff = i_buff + 1; -+#endif -+ x_buff[i_buff]=x; -+ y_buff[i_buff]=y; -+ i_buff=i_buff+1; - - // cout << "nbuf: " << i << " " << i_buff << " "<< n_buff_max-1 << " " << minEl-1 << endl; - -- if ((i_buff == n_buff_max) || ((i == minEl - 1) && !append) || ((i == minEl) && append)) { -- if (line) { -- a->line(i_buff, x_buff, y_buff); -- }; -- if ((psym_ > 0 && psym_ < 8) || psym_ == 9) { -- a->poin(i_buff, x_buff, y_buff, codeArr[psym_]); -- } -- if (psym_ == 8) { -- PLFLT *xx = new PLFLT[*userSymArrayDim]; -- PLFLT *yy = new PLFLT[*userSymArrayDim]; -- for (int j = 0; j < i_buff; ++j) { -- if (debug_ac) { -- cout << "j: " << j << ", X: " << x_buff[j] << ", Y: " << y_buff[j] << endl; -- }; -- for (int kk = 0; kk < *userSymArrayDim; kk++) { -- xx[kk] = x_buff[j] + userSymX[kk] * UsymConvX; -- yy[kk] = y_buff[j] + userSymY[kk] * UsymConvY; -+ if ( (i_buff==GDL_POLYLINE_BUFFSIZE)||((i==minEl-1)&& !append)||((i==minEl)&&append) ) -+ { -+ if ( line ) -+ { -+ if (docolor) for (SizeT jj=0; jj< i_buff-1 ; ++jj) -+ { -+ a->Color ( ( *color )[plotIndex%color->N_Elements ( )], decomposed, 2); -+ a->line(2, &(x_buff[jj]), &(y_buff[jj])); -+ plotIndex++; -+ } -+ else a->line(i_buff, x_buff, y_buff); -+ } -+ if ( psym_>0&&psym_<9 ) -+ { -+ PLFLT *xx=new PLFLT[*userSymArrayDim]; -+ PLFLT *yy=new PLFLT[*userSymArrayDim]; -+ for ( int j=0; jColor ( ( *color )[plotIndex%color->N_Elements ( )], decomposed, 2 ); -+ plotIndex++; -+ } -+ if ( *do_fill==1 ) -+ { - a->fill(*userSymArrayDim, xx, yy); -- //to be tested: provided we define a 'non-gradient' gradient before this should work -- // a->gradient(*userSymArrayDim,xx,yy,0.0); -- } else { -+ } -+ else -+ { - a->line(*userSymArrayDim, xx, yy); - } - } - } -- if (psym_ == 10) { -+ if ( psym_==10 ) -+ { - ac_histo(a, i_buff, x_buff, y_buff, xLog); - } - - // we must recopy the last point since the line must continue (tested via small buffer ...) -- x_buff[0] = x_buff[i_buff - 1]; -- y_buff[0] = y_buff[i_buff - 1]; -- i_buff = 1; -+ x_buff[0]=x_buff[i_buff-1]; -+ y_buff[0]=y_buff[i_buff-1]; -+ i_buff=1; - } - } - -@@ -994,545 +1689,1546 @@ - return (valid); - } - // explicit instantiation for SpDDouble -- template bool draw_polyline(EnvT*, GDLGStream*, Data_*, Data_*, DDouble, DDouble, bool, bool, bool, DLong, bool); -+ template bool draw_polyline(EnvT*, GDLGStream*, Data_*, Data_*, DDouble, DDouble, bool, bool, bool, DLong, bool, DLongGDL*); - -- //[XYZ]MARGIN kw decoding -- void gkw_axis_margin(EnvT *e, string axis,DFloat &start, DFloat &end) -- { -- DStructGDL* Struct; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -- -- if(Struct != NULL) -- { -- static unsigned marginTag = Struct->Desc()->TagIndex( "MARGIN"); -- start = -- (*static_cast( Struct->GetTag( marginTag, 0)))[0]; -- end = -- (*static_cast( Struct->GetTag( marginTag, 0)))[1]; -- } -+ -+ //BACKGROUND COLOR - -- string MarginName=axis+"MARGIN"; -- BaseGDL* Margin=e->GetKW(e->KeywordIx(MarginName)); -- if(Margin !=NULL) -- { -- if(Margin->N_Elements() > 2) -- e->Throw("Keyword array parameter "+MarginName+ -- " must have from 1 to 2 elements."); -- auto_ptr guard; -- DFloatGDL* MarginF = static_cast -- ( Margin->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( MarginF); -- start = (*MarginF)[0]; -- if( MarginF->N_Elements() > 1) -- end = (*MarginF)[1]; -- } -+ void gdlSetGraphicsBackgroundColorFromKw(EnvT *e, GDLGStream *a, bool kw) -+ { -+ static DStructGDL* pStruct=SysVar::P(); -+ DLong background= -+ (*static_cast -+ (pStruct->GetTag(pStruct->Desc()->TagIndex("BACKGROUND"), 0)))[0]; -+ if ( kw ) -+ e->AssureLongScalarKWIfPresent("BACKGROUND", background); -+ a->Background(background); - } - -- //BACKGROUND COLOR -- void gkw_background(EnvT *e, GDLGStream *a, bool kw) -+ void gdlSetGraphicsPenColorToBackground(GDLGStream *a) - { -- static DStructGDL* pStruct = SysVar::P(); -- DLong background = -- (*static_cast -- (pStruct->GetTag( pStruct->Desc()->TagIndex("BACKGROUND"), 0)))[0]; -- if(kw) -- e->AssureLongScalarKWIfPresent( "BACKGROUND", background); -- -- // Get decomposed value -- Graphics* actDevice = Graphics::GetDevice(); -- DLong decomposed = actDevice->GetDecomposed(); -- if (decomposed != 0 && decomposed != 1) {decomposed=0;} -- -- a->Background( background, decomposed); -+ a->plstream::col0( 0); - } - - //COLOR -- void gkw_color(EnvT *e, GDLGStream *a) -- { -+#define GDL_PLPLOT_MAX_SIMPLE_COLORS 16 -+#define GDL_PLPLOT_INDEX_WHITE 15 -+ void gdlSetGraphicsForegroundColorFromKw(EnvT *e, GDLGStream *a, string OtherColorKw) -+ { -+ static unsigned int colorindex=1; -+ static long value[GDL_PLPLOT_MAX_SIMPLE_COLORS]; -+ static int maxindex=2; -+ static bool notDone=1; -+ - // Get COLOR from PLOT system variable -- static DStructGDL* pStruct = SysVar::P(); -- DLong color = -- (*static_cast -- (pStruct->GetTag( pStruct->Desc()->TagIndex("COLOR"), 0)))[0]; -+ static DStructGDL* pStruct=SysVar::P(); -+ DLong color= -+ (*static_cast -+ (pStruct->GetTag(pStruct->Desc()->TagIndex("COLOR"), 0)))[0]; - - // Get # of colors from DEVICE system variable -- DVar *var=FindInVarList(sysVarList,"D"); -- DStructGDL* s = static_cast( var->Data()); -- DLong ncolor = (*static_cast -- (s->GetTag(s->Desc()->TagIndex("N_COLORS"), 0)))[0]; -- -- if (ncolor > 256 && color == 255) color = ncolor - 1; -- -- e->AssureLongScalarKWIfPresent( "COLOR", color); -- -- // Get decomposed value -- Graphics* actDevice = Graphics::GetDevice(); -- DLong decomposed = actDevice->GetDecomposed(); -- if (decomposed != 0 && decomposed != 1) {decomposed=0;} -- a->Color( color, decomposed, 2); -+ DVar *var=FindInVarList(sysVarList, "D"); -+ DStructGDL* s=static_cast(var->Data()); -+ DLong ncolor=(*static_cast -+ (s->GetTag(s->Desc()->TagIndex("N_COLORS"), 0)))[0]; -+ -+ //FIXME: serves to update color if palette larger than 256. We can do better! -+ if ( ncolor>256&&color==255 ) color=ncolor-1; -+ -+ if (notDone) -+ { -+ for (int i=0; iKeywordIx ( "COLOR" ); //color may be vector in GDL! -+ else colorIx=e->KeywordIx (OtherColorKw); -+ if ( e->GetKW ( colorIx )!=NULL ) -+ { -+ colorVect=e->GetKWAs( colorIx ); -+ color=(*colorVect)[0]; //this function only sets color to 1st arg in list! -+ } -+ int i; -+ bool found=false; -+ for (i=0; iGetDecomposed(); -+ a->Color(color, decomposed, colorindex); - } - - // helper for NOERASE (but also used in XYOUTS) -+ - void handle_pmulti_position(EnvT *e, GDLGStream *a) - { -- // !P.MULTI is ignored if POSITION kw or !P.POSITION or !P.REGION is specified -+ // all but the first element of !P.MULTI are ignored if POSITION kw or !P.POSITION or !P.REGION is specified - // TODO: !P.REGION! - -- DFloatGDL* pos = NULL; -+ DFloatGDL* pos=NULL; - -- // system variable -- static DStructGDL* pStruct = SysVar::P(); -- pos = static_cast(pStruct-> GetTag( pStruct->Desc()->TagIndex("POSITION"), 0)); -- if ((*pos)[0] == (*pos)[2]) pos = NULL; -+ // system variable !P.REGION first -+ static DStructGDL* pStruct=SysVar::P(); -+ pos=static_cast(pStruct-> GetTag(pStruct->Desc()->TagIndex("POSITION"), 0)); -+ if ( (*pos)[0]==(*pos)[2] ) pos=NULL; //ignored - - // keyword -- if (pos == NULL) -+ if ( pos==NULL ) - { -- DSub* pro = e->GetPro(); -- int positionIx = pro->FindKey( "POSITION"); -- if (positionIx != -1) pos = e->IfDefGetKWAs( positionIx); -+ DSub* pro=e->GetPro(); -+ int positionIx=pro->FindKey("POSITION"); -+ if ( positionIx!= -1 ) pos=e->IfDefGetKWAs(positionIx); - } - -- if (pos != NULL) a->NoSub(); -+ if ( pos!=NULL ) a->NoSub(); - } - - //NOERASE -- void gkw_noerase(EnvT *e,GDLGStream *a, bool noe) -+ -+ void gdlNextPlotHandlingNoEraseOption(EnvT *e, GDLGStream *a, bool noe) - { -- DLong noErase=0; -- DLongGDL* pMulti = SysVar::GetPMulti(); -- static DStructGDL* pStruct = SysVar::P(); -- -- if(!noe) -- { -- noErase = (*static_cast -- ( pStruct-> -- GetTag( pStruct->Desc()->TagIndex("NOERASE"), 0)))[0]; -- if(e->KeywordSet("NOERASE")) { -- noErase=1; -- } -- } -- else -+ bool noErase=FALSE; -+ static DStructGDL* pStruct=SysVar::P(); -+ -+ if ( !noe ) -+ { -+ DLong LnoErase=(*static_cast -+ (pStruct-> -+ GetTag(pStruct->Desc()->TagIndex("NOERASE"), 0)))[0]; -+ noErase=(LnoErase==1); -+ if ( e->KeywordSet("NOERASE") ) - { -- noErase=1; -+ noErase=TRUE; - } -+ } -+ else -+ { -+ noErase=TRUE; -+ } - -- a->NextPlot( !noErase); -+ a->NextPlot(!noErase); - handle_pmulti_position(e, a); - } - - //PSYM -- void gkw_psym(EnvT *e, DLong &psym) -+ -+ void gdlGetPsym(EnvT *e, DLong &psym) - { -- static DStructGDL* pStruct = SysVar::P(); -- psym= (*static_cast -- (pStruct->GetTag(pStruct->Desc()->TagIndex("PSYM"), 0)))[0]; -+ static DStructGDL* pStruct=SysVar::P(); -+ psym=(*static_cast -+ (pStruct->GetTag(pStruct->Desc()->TagIndex("PSYM"), 0)))[0]; - -- e->AssureLongScalarKWIfPresent( "PSYM", psym); -- if( psym > 10 || psym < -8 || psym == 9) -+ e->AssureLongScalarKWIfPresent("PSYM", psym); -+ if ( psym>10||psym < -8||psym==9 ) - e->Throw( -- "PSYM (plotting symbol) out of range."); -+ "PSYM (plotting symbol) out of range."); - } - -- //SYMSIZE -- void gkw_symsize(EnvT *e, GDLGStream *a) -+ //SYMSIZE -+ -+ void gdlSetSymsize(EnvT *e, GDLGStream *a) - { -- static DStructGDL* pStruct = SysVar::P(); -- DFloat symsize = (*static_cast -- (pStruct->GetTag( pStruct->Desc()->TagIndex("SYMSIZE"), 0)))[0]; -- e->AssureFloatScalarKWIfPresent( "SYMSIZE", symsize); -- if( symsize <= 0.0) symsize = 1.0; -+ static DStructGDL* pStruct=SysVar::P(); -+ DFloat symsize=(*static_cast -+ (pStruct->GetTag(pStruct->Desc()->TagIndex("SYMSIZE"), 0)))[0]; -+ e->AssureFloatScalarKWIfPresent("SYMSIZE", symsize); -+ if ( symsize<=0.0 ) symsize=1.0; - a->ssym(0.0, symsize); - } - - //CHARSIZE -- void gkw_charsize(EnvT *e, GDLGStream *a, DFloat &charsize, bool kw) -- { -- static DStructGDL* pStruct = SysVar::P(); -- charsize = (*static_cast -- (pStruct->GetTag -- ( pStruct->Desc()->TagIndex("CHARSIZE"), 0)))[0]; -- if(kw) -- e->AssureFloatScalarKWIfPresent( "CHARSIZE", charsize); -- -- if( charsize <= 0.0) charsize = 1.0; -- a->schr(0.0, charsize); -- } -- //OLD CHARSIZE (for xyouts only?) -- void gkw_charsize_xyouts(EnvT *e, GDLGStream *a, DFloat &charsize) -- { -- static DStructGDL* pStruct = SysVar::P(); -- charsize = (*static_cast -- (pStruct->GetTag -- ( pStruct->Desc()->TagIndex("CHARSIZE"), 0)))[0]; -- //imagine CHARSIZE & SIZE: we prefer CHARSIZE of course -- if(e->KeywordSet("SIZE")) e->AssureFloatScalarKWIfPresent( "SIZE", charsize); -- e->AssureFloatScalarKWIfPresent( "CHARSIZE", charsize); - -- if( charsize <= 0.0) charsize = 1.0; -- a->schr(0.0, charsize); -+ void gdlSetPlotCharsize(EnvT *e, GDLGStream *a, bool accept_sizeKw) -+ { -+ PLFLT charsize; -+ DDouble pmultiscale=1.0; -+ // get !P preference -+ static DStructGDL* pStruct=SysVar::P(); -+ charsize=(*static_cast -+ (pStruct->GetTag -+ (pStruct->Desc()->TagIndex("CHARSIZE"), 0)))[0]; -+ //overload with command preference. Charsize may be a vector now in some gdl commands, take care of it: -+ if (accept_sizeKw) //XYOUTS specials! -+ { -+ DFloat fcharsize; -+ fcharsize=charsize; -+ e->AssureFloatScalarKWIfPresent("SIZE", fcharsize); //conversions are boring... -+ charsize=fcharsize; -+ } -+ int charsizeIx=e->KeywordIx ( "CHARSIZE" ); -+ if ( e->GetKW ( charsizeIx )!=NULL ) -+ { -+ DFloatGDL* charsizeVect=e->GetKWAs( charsizeIx ); -+ charsize=(*charsizeVect)[0]; -+ } -+ if ( charsize<=0.0 ) charsize=1.0; -+ // adjust if MULTI: -+ DLongGDL* pMulti=SysVar::GetPMulti(); -+ if ( (*pMulti)[1]>2||(*pMulti)[2]>2 ) pmultiscale=0.5; -+ a->sizeChar(charsize*pmultiscale); -+ } -+ -+ void gdlSetPlotCharthick(EnvT *e, GDLGStream *a) -+ { -+ PLINT charthick=1; -+ // get !P preference -+ static DStructGDL* pStruct=SysVar::P(); -+ charthick=(*static_cast -+ (pStruct->GetTag -+ (pStruct->Desc()->TagIndex("CHARTHICK"), 0)))[0]; -+ int charthickIx=e->KeywordIx ( "CHARTHICK" ); //Charthick values may be vector in GDL, not in IDL! -+ if ( e->GetKW ( charthickIx )!=NULL ) -+ { -+ DFloatGDL* charthickVect=e->GetKWAs( charthickIx ); -+ charthick=(*charthickVect)[0]; -+ } -+ a->wid(charthick); - } -+ -+ void gdlSetAxisCharsize(EnvT *e, GDLGStream *a, string axis) -+ { -+ -+ DFloat charsize=0.0; -+ DDouble pmultiscale=1.0; -+ gdlGetDesiredAxisCharsize(e, axis, charsize); -+ // adjust if MULTI: -+ DLongGDL* pMulti=SysVar::GetPMulti(); -+ if ( (*pMulti)[1]>2||(*pMulti)[2]>2 ) pmultiscale=0.5; //IDL behaviour -+ // scale default value (which depends on number of subpages) -+ // a->schr(0.0, charsize*pmultiscale); -+ a->sizeChar(charsize*pmultiscale); -+ } -+ -+ - //THICK -- void gkw_thick(EnvT *e, GDLGStream *a) -+ -+ void gdlSetPenThickness(EnvT *e, GDLGStream *a) - { -- static DStructGDL* pStruct = SysVar::P(); -- DFloat thick = (*static_cast -- (pStruct->GetTag( pStruct->Desc()->TagIndex("THICK"), 0)))[0]; -- -- e->AssureFloatScalarKWIfPresent( "THICK", thick); -- if( thick <= 0.0) thick = 1.0; -- a->wid( static_cast(floor( thick-0.5))); -+ static DStructGDL* pStruct=SysVar::P(); -+ DFloat thick=(*static_cast -+ (pStruct->GetTag(pStruct->Desc()->TagIndex("THICK"), 0)))[0]; -+ -+ e->AssureFloatScalarKWIfPresent("THICK", thick); -+ if ( thick<=0.0 ) thick=1.0; -+ a->wid(static_cast(floor(thick-0.5))); - } - - //LINESTYLE -- void gkw_linestyle(EnvT *e, GDLGStream *a) -+ void gdlLineStyle(GDLGStream *a, DLong style) - { -- static DStructGDL* pStruct = SysVar::P(); -+ static PLINT mark1[]={75}; -+ static PLINT space1[]={1500}; -+ static PLINT mark2[]={1500}; -+ static PLINT space2[]={1500}; -+ static PLINT mark3[]={1500, 100}; -+ static PLINT space3[]={1000, 1000}; -+ static PLINT mark4[]={1500, 100, 100, 100}; -+ static PLINT space4[]={1000, 1000, 1000, 1000}; -+ static PLINT mark5[]={3000}; -+ static PLINT space5[]={1500}; // see plplot-5.5.3/examples/c++/x09.cc -+ switch(style) -+ { -+ case 0: -+ a->styl(0, mark1, space1); -+ return; -+ case 1: -+ a->styl(1, mark1, space1); -+ return; -+ case 2: -+ a->styl(1, mark2, space2); -+ return; -+ case 3: -+ a->styl(2, mark3, space3); -+ return; -+ case 4: -+ a->styl(4, mark4, space4); -+ return; -+ case 5: -+ a->styl(1, mark5, space5); -+ return; -+ default: -+ a->styl(0, NULL, NULL); -+ return; -+ } -+ } -+ -+ void gdlSetLineStyle(EnvT *e, GDLGStream *a) -+ { -+ static DStructGDL* pStruct=SysVar::P(); - DLong linestyle= -- (*static_cast -- (pStruct->GetTag( pStruct->Desc()->TagIndex("LINESTYLE"), 0)))[0]; -+ (*static_cast -+ (pStruct->GetTag(pStruct->Desc()->TagIndex("LINESTYLE"), 0)))[0]; - - // if the LINESTYLE keyword is present, the value will be change - DLong temp_linestyle=-1111; -- e->AssureLongScalarKWIfPresent( "LINESTYLE",temp_linestyle); -+ if (e->KeywordSet("LINESTYLE")) e->AssureLongScalarKWIfPresent("LINESTYLE", temp_linestyle); - - bool debug=false; -- if (debug) { -- cout << "temp_linestyle " << temp_linestyle << endl; -- cout << " linestyle " << linestyle << endl; -- } -- if (temp_linestyle != -1111) {linestyle=temp_linestyle;}//+1; -- if (linestyle < 0 ) {linestyle=0;} -- if (linestyle > 5 ) {linestyle=5;} -- -- // see -- // file:///home/coulais/SoftsExternes/plplot-5.5.3/examples/c++/x09.cc -- // file:///home/coulais/SoftsExternes/plplot-5.5.3/doc/docbook/src/plstyl.html -- -- if (linestyle == 0) { // solid (continuous line) -- static PLINT nbp=0; -- a->styl(nbp, NULL, NULL); -- } -- if (linestyle == 1) { // dots -- static PLINT nbp=1; -- static PLINT mark[] = {75}; -- static PLINT space[] = {1500}; -- a->styl(nbp, mark, space); -- } -- if (linestyle == 2) { // dashed -- static PLINT nbp=1; -- static PLINT mark[] = {1500}; -- static PLINT space[] = {1500}; -- a->styl(nbp, mark, space); -- } -- if (linestyle == 3) { // dash dot -- static PLINT nbp=2; -- static PLINT mark[] = {1500,100}; -- static PLINT space[] = {1000,1000}; -- a->styl(nbp, mark, space); -- } -- if (linestyle == 4) { // dash dot dot -- static PLINT nbp=4; -- static PLINT mark[] = {1500,100,100,100}; -- static PLINT space[] = {1000,1000,1000,1000}; -- a->styl(nbp, mark, space); -- } -- if (linestyle == 5) { // long dash -- static PLINT nbp=1; -- static PLINT mark[] = {3000}; -- static PLINT space[] = {1500}; -- a->styl(nbp, mark, space); -+ if ( debug ) -+ { -+ cout<<"temp_linestyle "<5 ) -+ { -+ linestyle=5; -+ } -+ gdlLineStyle(a, linestyle); - } - - //TITLE -- void gkw_title(EnvT* e, GDLGStream *a, PLFLT ad) -+ -+ void gdlWriteTitleAndSubtitle(EnvT* e, GDLGStream *a) - { -- DLong thick=0; -- e->AssureLongScalarKWIfPresent("CHARTHICK",thick); -- a->wid(thick); -- -- static DStructGDL* pStruct = SysVar::P(); -- static unsigned titleTag = pStruct->Desc()->TagIndex( "TITLE"); -- static unsigned subTitleTag = pStruct->Desc()->TagIndex( "SUBTITLE"); -- DString title = -- (*static_cast( pStruct->GetTag( titleTag, 0)))[0]; -- DString subTitle = -- (*static_cast( pStruct->GetTag( subTitleTag, 0)))[0]; -- e->AssureStringScalarKWIfPresent( "TITLE", title); -- e->AssureStringScalarKWIfPresent( "SUBTITLE", subTitle); -- -- a->schr( 0.0, 1.25*ad); -- a->mtex("t",1.25,0.5,0.5,title.c_str()); -- a->schr( 0.0, ad); // charsize is reset here -- a->mtex("b",5.4,0.5,0.5,subTitle.c_str()); -- a->wid(0); -- } -+ static unsigned titleTag=SysVar::P()->Desc()->TagIndex("TITLE"); -+ static unsigned subTitleTag=SysVar::P()->Desc()->TagIndex("SUBTITLE"); -+ DString title=(*static_cast(SysVar::P()->GetTag(titleTag, 0)))[0]; -+ DString subTitle=(*static_cast(SysVar::P()->GetTag(subTitleTag, 0)))[0]; -+ e->AssureStringScalarKWIfPresent("TITLE", title); -+ e->AssureStringScalarKWIfPresent("SUBTITLE", subTitle); -+ if (title.empty() && subTitle.empty()) return; - -+ gdlSetPlotCharsize(e, a); -+ if (!title.empty()) -+ { -+ e->AssureStringScalarKWIfPresent("TITLE", title); -+ gdlSetPlotCharthick(e, a); -+ a->sizeChar(1.25*a->charScale()); -+ a->mtex("t", 1.5, 0.5, 0.5, title.c_str()); //position is in units of current char height. baseline at half-height -+ a->sizeChar(a->charScale()/1.25); -+ } -+ if (!subTitle.empty()) -+ { -+ e->AssureStringScalarKWIfPresent("SUBTITLE", subTitle); -+ a->mtex("b", 5.4, 0.5, 0.5, subTitle.c_str()); -+ } -+ } -+ - //crange to struct - -- void set_axis_crange(string axis, DDouble Start, DDouble End, bool log) -+ void gdlStoreAxisCRANGE(string axis, DDouble Start, DDouble End, bool log) - { -- DStructGDL* Struct = NULL; -- if (axis == "X") Struct = SysVar::X(); -- if (axis == "Y") Struct = SysVar::Y(); -- if (axis == "Z") Struct = SysVar::Z(); -- if (Struct != NULL) -- { -- int debug = 0; -- if (debug) cout << "Set :" << Start << " " << End << endl; -- -- static unsigned crangeTag = Struct->Desc()->TagIndex("CRANGE"); -- if (log) -- { -- (*static_cast (Struct->GetTag(crangeTag, 0)))[0] = log10(Start); -- (*static_cast (Struct->GetTag(crangeTag, 0)))[1] = log10(End); -- if (debug) cout << "set log" << Start << " " << End << endl; -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ int debug=0; -+ if ( debug ) cout<<"Set :"<Desc()->TagIndex("CRANGE"); -+ if ( log ) -+ { -+ (*static_cast(Struct->GetTag(crangeTag, 0)))[0]=log10(Start); -+ (*static_cast(Struct->GetTag(crangeTag, 0)))[1]=log10(End); -+ if ( debug ) cout<<"set log"< (Struct->GetTag(crangeTag, 0)))[0] = Start; -- (*static_cast (Struct->GetTag(crangeTag, 0)))[1] = End; -+ (*static_cast(Struct->GetTag(crangeTag, 0)))[0]=Start; -+ (*static_cast(Struct->GetTag(crangeTag, 0)))[1]=End; - } - } - } - - //CRANGE from struct -- void get_axis_crange(string axis, DDouble &Start, DDouble &End) -+ -+ void gdlGetCurrentAxisRange(string axis, DDouble &Start, DDouble &End) - { - DStructGDL* Struct=NULL; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -- if(axis=="Z") Struct = SysVar::Z(); -- if(Struct!=NULL) -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) - { -- int debug=0; -- if (debug) cout << "Get :" << Start << " " << End << endl; -+ int debug=0; -+ if ( debug ) cout<<"Get :"<Desc()->TagIndex( "CRANGE"); -- Start = (*static_cast( Struct->GetTag( crangeTag, 0)))[0]; -- End = (*static_cast( Struct->GetTag( crangeTag, 0)))[1]; -+ static unsigned crangeTag=Struct->Desc()->TagIndex("CRANGE"); -+ Start=(*static_cast(Struct->GetTag(crangeTag, 0)))[0]; -+ End=(*static_cast(Struct->GetTag(crangeTag, 0)))[1]; - -- static unsigned typeTag = Struct->Desc()->TagIndex( "TYPE"); -- if ((*static_cast(Struct->GetTag( typeTag, 0)))[0] == 1) -- { -- Start=pow(10.,Start); -- End=pow(10.,End); -- if (debug) cout << "Get log :" << Start << " " << End << endl; -- } -+ static unsigned typeTag=Struct->Desc()->TagIndex("TYPE"); -+ if ( (*static_cast(Struct->GetTag(typeTag, 0)))[0]==1 ) -+ { -+ Start=pow(10., Start); -+ End=pow(10., End); -+ if ( debug ) cout<<"Get log :"<gvpd(p_xmin, p_xmax, p_ymin, p_ymax); //viewport normalized coords -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) {Struct=SysVar::X(); norm_min=p_xmin; norm_max=p_xmax; charDim=actStream->nCharLength();} -+ if ( axis=="Y" ) {Struct=SysVar::Y(); norm_min=p_ymin; norm_max=p_ymax; charDim=actStream->nCharHeight();} -+ if ( axis=="Z" ) {Struct=SysVar::Z(); norm_min=0; norm_max=1; charDim=actStream->nCharLength();} -+ if ( Struct!=NULL ) -+ { -+ unsigned marginTag=Struct->Desc()->TagIndex("MARGIN"); -+ DFloat m1=(*static_cast(Struct->GetTag(marginTag, 0)))[0]; -+ DFloat m2=(*static_cast(Struct->GetTag(marginTag, 0)))[1]; -+ static unsigned regionTag=Struct->Desc()->TagIndex("REGION"); -+ (*static_cast(Struct->GetTag(regionTag, 0)))[0]=max(0.0,norm_min-m1*charDim); -+ (*static_cast(Struct->GetTag(regionTag, 0)))[1]=min(1.0,norm_max+m2*charDim); -+ -+ if ( log ) {Start=log10(Start); End=log10(End);} -+ static unsigned windowTag=Struct->Desc()->TagIndex("WINDOW"); -+ (*static_cast(Struct->GetTag(windowTag, 0)))[0]=norm_min; -+ (*static_cast(Struct->GetTag(windowTag, 0)))[1]=norm_max; -+ -+ static unsigned sTag=Struct->Desc()->TagIndex("S"); -+ (*static_cast(Struct->GetTag(sTag, 0)))[0]= -+ (norm_min*End-norm_max*Start)/(End-Start); -+ (*static_cast(Struct->GetTag(sTag, 0)))[1]= -+ (norm_max-norm_min)/(End-Start); -+ } -+ } -+ -+ void gdlStoreCLIP(DLongGDL* clipBox) -+ { -+ static DStructGDL* pStruct=SysVar::P(); -+ int i; -+ static unsigned clipTag=pStruct->Desc()->TagIndex("CLIP"); -+ for ( i=0; iN_Elements(); ++i ) (*static_cast(pStruct->GetTag(clipTag, 0)))[i]=(*clipBox)[i]; -+ } -+ -+ void gdlGetAxisType(string axis, bool &log) - { - DStructGDL* Struct; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -- if(axis=="Z") Struct = SysVar::Z(); -- if(Struct != NULL) { -- static unsigned typeTag = Struct->Desc()->TagIndex( "TYPE"); -- if ((*static_cast(Struct->GetTag( typeTag, 0)))[0] == 1) -- log = 1; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned typeTag=Struct->Desc()->TagIndex("TYPE"); -+ if ( (*static_cast(Struct->GetTag(typeTag, 0)))[0]==1 ) -+ log=true; - else -- log=0; -+ log=false; - } - } - - void get_mapset(bool &mapset) - { -- DStructGDL* Struct = SysVar::X(); -- if(Struct != NULL) { -- static unsigned typeTag = Struct->Desc()->TagIndex( "TYPE"); -+ DStructGDL* Struct=SysVar::X(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned typeTag=Struct->Desc()->TagIndex("TYPE"); - -- if ((*static_cast(Struct->GetTag( typeTag, 0)))[0] == 3) -- mapset = 1; -+ if ( (*static_cast(Struct->GetTag(typeTag, 0)))[0]==3 ) -+ mapset=true; - else -- mapset = 0; -+ mapset=false; - } - } - - void set_mapset(bool mapset) - { -- DStructGDL* Struct = SysVar::X(); -- if(Struct!=NULL) -- { -- static unsigned typeTag = Struct->Desc()->TagIndex( "TYPE"); -- (*static_cast( Struct->GetTag( typeTag, 0)))[0] = mapset; -- } -+ DStructGDL* Struct=SysVar::X(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned typeTag=Struct->Desc()->TagIndex("TYPE"); -+ (*static_cast(Struct->GetTag(typeTag, 0)))[0]=(mapset)?3:0; -+ } - } - - - //axis type (log..) -- void set_axis_type(string axis, bool Type) -+ -+ void gdlStoreAxisType(string axis, bool Type) - { - DStructGDL* Struct=NULL; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -- if(axis=="Z") Struct = SysVar::Z(); -- if(Struct!=NULL) -- { -- static unsigned typeTag = Struct->Desc()->TagIndex("TYPE"); -- (*static_cast(Struct->GetTag(typeTag, 0)))[0] = Type; -- } -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned typeTag=Struct->Desc()->TagIndex("TYPE"); -+ (*static_cast(Struct->GetTag(typeTag, 0)))[0]=Type; -+ } -+ } -+ -+ void gdlGetDesiredAxisCharsize(EnvT* e, string axis, DFloat &charsize) -+ { -+ //default: -+ charsize=1.0; -+ // get !P preference. Even if xcharsize is absent, presence of charsize or !P.charsize must be taken into account. -+ static DStructGDL* pStruct=SysVar::P(); -+ charsize=(*static_cast -+ (pStruct->GetTag -+ (pStruct->Desc()->TagIndex("CHARSIZE"), 0)))[0]; -+ string Charsize_s="CHARSIZE"; -+ e->AssureFloatScalarKWIfPresent(Charsize_s, charsize); // option charsize overloads P.CHARSIZE -+ if (charsize==0) charsize=1.0; -+ // Axis Preference -+ static DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ -+ if ( Struct!=NULL ) -+ { -+ DFloat axisCharsize=0.0; -+ static unsigned charsizeTag=Struct->Desc()->TagIndex("CHARSIZE"); //X.CHARSIZE -+ axisCharsize=(*static_cast(Struct->GetTag(charsizeTag, 0)))[0]; -+ Charsize_s=axis+"CHARSIZE"; //XCHARSIZE -+ e->AssureFloatScalarKWIfPresent(Charsize_s, axisCharsize); //option [XYZ]CHARSIZE overloads ![XYZ].CHARSIZE -+ if (axisCharsize>0.0) charsize*=axisCharsize; //IDL Behaviour... -+ } -+ } -+ -+ void gdlGetDesiredAxisGridStyle(EnvT* e, string axis, DLong &axisGridstyle) -+ { -+ axisGridstyle=0; -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ string gridstyle_s=axis+"GRIDSTYLE"; -+ e->AssureLongScalarKWIfPresent(gridstyle_s, axisGridstyle); -+ } - } - -- void gkw_axis_charsize(EnvT* e, string axis, DFloat &charsize) -+ //[XYZ]MARGIN kw decoding -+ void gdlGetDesiredAxisMargin(EnvT *e, string axis, DFloat &start, DFloat &end) - { - DStructGDL* Struct; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); - -- if(Struct != NULL) -- { -- static unsigned charsizeTag = Struct->Desc()->TagIndex("CHARSIZE"); -- charsize = -- (*static_cast( Struct->GetTag( charsizeTag, 0)))[0]; -- } -+ if ( Struct!=NULL ) -+ { -+ unsigned marginTag=Struct->Desc()->TagIndex("MARGIN"); -+ start= -+ (*static_cast(Struct->GetTag(marginTag, 0)))[0]; -+ end= -+ (*static_cast(Struct->GetTag(marginTag, 0)))[1]; -+ } - -- string Charsize_s=axis+"CHARSIZE"; -- e->AssureFloatScalarKWIfPresent( Charsize_s, charsize); -- if(charsize <=0.0) charsize=1.0; -+ string MarginName=axis+"MARGIN"; -+ BaseGDL* Margin=e->GetKW(e->KeywordIx(MarginName)); -+ if ( Margin!=NULL ) -+ { -+ if ( Margin->N_Elements()>2 ) -+ e->Throw("Keyword array parameter "+MarginName+ -+ " must have from 1 to 2 elements."); -+ Guard guard; -+ DFloatGDL* MarginF=static_cast -+ (Margin->Convert2(GDL_FLOAT, BaseGDL::COPY)); -+ guard.Reset(MarginF); -+ start=(*MarginF)[0]; -+ if ( MarginF->N_Elements()>1 ) -+ end=(*MarginF)[1]; -+ } -+ } -+ -+ void gdlGetDesiredAxisMinor(EnvT* e, string axis, DLong &axisMinor) -+ { -+ axisMinor=0; -+ string what_s="MINOR"; -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned AxisMinorTag=Struct->Desc()->TagIndex(what_s); -+ axisMinor=(*static_cast(Struct->GetTag(AxisMinorTag,0)))[0]; -+ } -+ what_s=axis+"MINOR"; -+ e->AssureLongScalarKWIfPresent(what_s, axisMinor); - } - -+ //GET RANGE - -- //STYLE -- void gkw_axis_style(EnvT *e, string axis, DLong &style) -+ bool gdlGetDesiredAxisRange(EnvT *e, string axis, DDouble &start, DDouble &end) - { - DStructGDL* Struct; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -- if(Struct != NULL) -- { -- static unsigned styleTag = Struct->Desc()->TagIndex( "STYLE"); -- style = -- (*static_cast( Struct->GetTag( styleTag, 0)))[0]; -+ bool set=FALSE; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ DDouble test1, test2; -+ static unsigned rangeTag=Struct->Desc()->TagIndex("RANGE"); -+ test1=(*static_cast(Struct->GetTag(rangeTag, 0)))[0]; -+ test2=(*static_cast(Struct->GetTag(rangeTag, 0)))[1]; -+ if ( !(test1==0.0&&test2==0.0) ) -+ { -+ start=test1; -+ end=test2; -+ set=TRUE; - } -+ } -+ string RangeName=axis+"RANGE"; -+ BaseGDL* Range=e->GetKW(e->KeywordIx(RangeName)); -+ if ( Range!=NULL ) -+ { -+ if ( Range->N_Elements()!=2 ) -+ e->Throw("Keyword array parameter "+RangeName+ -+ " must have 2 elements."); -+ Guard guard; -+ DDoubleGDL* RangeF=static_cast(Range->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -+ guard.Reset(RangeF); -+ start=(*RangeF)[0]; -+ end=(*RangeF)[1]; -+ set=TRUE; -+ } -+ return set; -+ } - -- string StyleName=axis+"STYLE"; -+ //STYLE - -+ void gdlGetDesiredAxisStyle(EnvT *e, string axis, DLong &style) -+ { -+ DStructGDL* Struct; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned styleTag=Struct->Desc()->TagIndex("STYLE"); -+ style= -+ (*static_cast(Struct->GetTag(styleTag, 0)))[0]; -+ } -+ -+ string style_s=axis+"STYLE"; -+ e->AssureLongScalarKWIfPresent( style_s, style); - } - -- void gkw_axis_title(EnvT *e, string axis, DString &title) -+ //XTHICK -+ void gdlGetDesiredAxisThick(EnvT *e, string axis, DFloat &thick) - { -+ thick=1.0; - DStructGDL* Struct; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); - -- if(Struct != NULL) -- { -- static unsigned titleTag = Struct->Desc()->TagIndex("TITLE"); -- title = -- (*static_cast( Struct->GetTag( titleTag, 0)))[0]; -- } -+ if ( Struct!=NULL ) -+ { -+ string thick_s=axis+"THICK"; -+ e->AssureFloatScalarKWIfPresent(thick_s, thick); -+ if ( thick<=0.0 ) thick=1.0; -+ } -+ } - -- string TitleName=axis+"TITLE"; -- e->AssureStringScalarKWIfPresent( TitleName, title); -+ void gdlGetDesiredAxisTickget(EnvT *e, string axis, DDoubleGDL *Axistickget) -+ { -+ //TODO! -+ } -+ -+ void gdlGetDesiredAxisTickFormat(EnvT* e, string axis, DStringGDL* &axisTickformatVect) -+ { -+ static DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned AxisTickformatTag=Struct->Desc()->TagIndex("TICKFORMAT"); -+ axisTickformatVect=static_cast(Struct->GetTag(AxisTickformatTag,0)); -+ } -+ string what_s=axis+"TICKFORMAT"; -+ int axistickformatIx=e->KeywordIx (what_s); -+ if (axistickformatIx==-1) -+ { -+ Warning("[XYZ]TICKFORMAT Keyword unknown (FIXME)"); -+ return; -+ } -+ if ( e->GetKW ( axistickformatIx )!=NULL ) -+ { -+ axisTickformatVect=e->GetKWAs( axistickformatIx ); -+ } -+ } - -+ void gdlGetDesiredAxisTickInterval(EnvT* e, string axis, DDouble &axisTickinterval) -+ { -+ axisTickinterval=0; -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ axisTickinterval=(*static_cast -+ (Struct->GetTag -+ (Struct->Desc()->TagIndex("TICKINTERVAL"), 0)))[0]; -+ } -+ string what_s=axis+"TICKINTERVAL"; -+ e->AssureDoubleScalarKWIfPresent(what_s, axisTickinterval); - } - -- //GET RANGE -+ void gdlGetDesiredAxisTickLayout(EnvT* e, string axis, DLong &axisTicklayout) -+ { -+ axisTicklayout=0; -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ axisTicklayout=(*static_cast -+ (Struct->GetTag -+ (Struct->Desc()->TagIndex("TICKLAYOUT"), 0)))[0]; -+ } -+ string what_s=axis+"TICKLAYOUT"; -+ e->AssureLongScalarKWIfPresent(what_s, axisTicklayout); -+ } -+ -+ void gdlGetDesiredAxisTickLen(EnvT* e, string axis, DFloat &ticklen) -+ { -+ // order: !P.TICKLEN, TICKLEN, !X.TICKLEN, /XTICKLEN -+ // get !P preference -+ static DStructGDL* pStruct=SysVar::P(); -+ ticklen=(*static_cast -+ (pStruct->GetTag -+ (pStruct->Desc()->TagIndex("TICKLEN"), 0)))[0]; //!P.TICKLEN, always exist, may be 0 -+ string ticklen_s="TICKLEN"; -+ e->AssureFloatScalarKWIfPresent(ticklen_s, ticklen); //overwritten by TICKLEN option -+ -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned ticklenTag=Struct->Desc()->TagIndex("TICKLEN"); -+ DFloat axisTicklen=0.0; -+ axisTicklen=(*static_cast(Struct->GetTag(ticklenTag, 0)))[0]; //![XYZ].TICKLEN (exist) -+ ticklen_s=axis+"TICKLEN"; -+ e->AssureFloatScalarKWIfPresent(ticklen_s, axisTicklen); //overriden by kw -+ if (axisTicklen!=0.0) ticklen=axisTicklen; -+ } -+ } -+ -+ -+ void gdlGetDesiredAxisTickName(EnvT* e, string axis, DStringGDL* &axisTicknameVect) -+ { -+ static DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned AxisTicknameTag=Struct->Desc()->TagIndex("TICKNAME"); -+ axisTicknameVect=static_cast(Struct->GetTag(AxisTicknameTag,0)); -+ } -+ string what_s=axis+"TICKNAME"; -+ int axisticknameIx=e->KeywordIx (what_s); -+ if (axisticknameIx==-1) -+ { -+ Warning("[XYZ]TICKNAME Keyword unknown (FIXME)"); -+ return; -+ } -+ if ( e->GetKW ( axisticknameIx )!=NULL ) -+ { -+ axisTicknameVect=e->GetKWAs( axisticknameIx ); -+ } -+ -+ } -+ -+ void gdlGetDesiredAxisTicks(EnvT* e, string axis, DLong &axisTicks) -+ { -+ axisTicks=0; -+ DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ axisTicks=(*static_cast -+ (Struct->GetTag -+ (Struct->Desc()->TagIndex("TICKS"), 0)))[0]; -+ } -+ string what_s=axis+"TICKS"; -+ e->AssureLongScalarKWIfPresent(what_s, axisTicks); -+ } -+ -+ void gdlGetDesiredAxisTickUnits(EnvT* e, string axis, DStringGDL* &axisTickunitsVect) -+ { -+ static DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned AxisTickunitsTag=Struct->Desc()->TagIndex("TICKUNITS"); -+ axisTickunitsVect=static_cast(Struct->GetTag(AxisTickunitsTag,0)); -+ } -+ string what_s=axis+"TICKUNITS"; -+ int axistickunitsIx=e->KeywordIx (what_s); -+ if (axistickunitsIx==-1) -+ { -+ Warning("[XYZ]TICKUNITS Keyword unknown (FIXME)"); -+ return; -+ } -+ if ( e->GetKW ( axistickunitsIx )!=NULL ) -+ { -+ axisTickunitsVect=e->GetKWAs( axistickunitsIx ); -+ } -+ } -+ -+ void gdlGetDesiredAxisTickv(EnvT* e, string axis, DDoubleGDL* axisTickvVect) -+ { -+ static DStructGDL* Struct=NULL; -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ if ( Struct!=NULL ) -+ { -+ static unsigned AxisTickvTag=Struct->Desc()->TagIndex("TICKV"); -+ axisTickvVect=static_cast(Struct->GetTag(AxisTickvTag,0)); -+ -+ } -+ string what_s=axis+"TICKV"; -+ int axistickvIx=e->KeywordIx (what_s); -+ if (axistickvIx==-1) -+ { -+ Warning("[XYZ]TICKV Keyword unknown (FIXME)"); -+ return; -+ } -+ if ( e->GetKW ( axistickvIx )!=NULL ) -+ { -+ axisTickvVect=e->GetKWAs( axistickvIx ); -+ } -+ } - -- void gkw_axis_range(EnvT *e, string axis, DDouble &start, DDouble &end, -- DLong &ynozero) -+ void gdlGetDesiredAxisTitle(EnvT *e, string axis, DString &title) - { - DStructGDL* Struct; -- if (axis == "X") Struct = SysVar::X(); -- if (axis == "Y") Struct = SysVar::Y(); -- if (Struct != NULL) -+ if ( axis=="X" ) Struct=SysVar::X(); -+ if ( axis=="Y" ) Struct=SysVar::Y(); -+ if ( axis=="Z" ) Struct=SysVar::Z(); -+ -+ if ( Struct!=NULL ) - { -- DDouble test1, test2; -- static unsigned rangeTag = Struct->Desc()->TagIndex("RANGE"); -- test1 = (*static_cast (Struct->GetTag(rangeTag, 0)))[0]; -- test2 = (*static_cast (Struct->GetTag(rangeTag, 0)))[1]; -- if (!(test1 == 0.0 && test2 == 0.0)) -+ static unsigned titleTag=Struct->Desc()->TagIndex("TITLE"); -+ title= -+ (*static_cast(Struct->GetTag(titleTag, 0)))[0]; -+ } -+ -+ string TitleName=axis+"TITLE"; -+ e->AssureStringScalarKWIfPresent(TitleName, title); -+ } -+ -+ void tickformat_date(PLFLT juliandate, string &Month , PLINT &Day , PLINT &Year , PLINT &Hour , PLINT &Minute, PLFLT &Second) -+ { -+ static string theMonth[12]={"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"}; -+ PLFLT JD,Z,F,a; -+ PLINT A,B,C,D,E,month; -+ JD = juliandate + 0.5; -+ Z = floor(JD); -+ F = JD - Z; -+ -+ if (Z < 2299161) A = (PLINT)Z; -+ else { -+ a = (int) ((Z - 1867216.25) / 36524.25); -+ A = (PLINT) (Z + 1 + a - (int)(a / 4)); -+ } -+ -+ B = A + 1524; -+ C = (PLINT) ((B - 122.1) / 365.25); -+ D = (PLINT) (365.25 * C); -+ E = (PLINT) ((B - D) / 30.6001); -+ -+ // month -+ month = E < 14 ? E - 1 : E - 13; -+ Month=theMonth[month-1]; -+ // day -+ Day=B - D - (int)(30.6001 * E); -+ // year -+ Year = month > 2 ? C - 4716 : C - 4715; -+ // hours -+ Hour = (PLINT) (F * 24); -+ F -= (double)Hour / 24; -+ // minutes -+ Minute = (int) (F * 1440); -+ F -= (double)Minute / 1440; -+ // seconds -+ Second = F * 86400; -+ } -+ -+ void doOurOwnFormat(PLINT axisNotUsed, PLFLT value, char *label, PLINT length, PLPointer data) -+ { -+ struct GDL_TICKDATA *ptr = (GDL_TICKDATA* )data; -+ static string normalfmt[7]={"%1.0fx10#u%d#d","%2.1fx10#u%d#d","%3.2fx10#u%d#d","%4.2fx10#u%d#d","%5.4fx10#u%d#d","%6.5fx10#u%d#d","%7.6fx10#u%d#d"}; -+ static string specialfmt="10#u%d#d"; -+ static string specialfmtlog="10#u%s#d"; -+ PLFLT z; -+ int ns; -+ char *i; -+ int sgn=(value<0)?-1:1; -+ if (sgn*value-4)) -+ { -+ snprintf(test, length, "%f",value); -+ ns=strlen(test); -+ i=rindex(test,'0'); -+ while (i==(test+ns-1)) //remove trailing zeros... -+ { -+ *i='\0'; -+ i=rindex(test,'0'); -+ ns--; -+ } -+ i=rindex(test,'.'); //remove trailing '.' -+ if (i==(test+ns-1)) {*i='\0'; ns--;} -+ if (ptr->isLog) snprintf( label, length, specialfmtlog.c_str(),test); -+ else -+ strncpy(label, test, length); -+ } -+ else -+ { -+ z=value*sgn/pow(10.,e); -+ snprintf(test,20,"%7.6f",z); -+ ns=strlen(test); -+ i=rindex(test,'0'); -+ while (i==(test+ns-1)) -+ { -+ *i='\0'; -+ i=rindex(test,'0'); -+ ns--; -+ } -+ ns-=2;ns=(ns>6)?6:ns; -+ if (floor(sgn*z)==1 && ns==0) snprintf( label, length, specialfmt.c_str(),e); else snprintf( label, length, normalfmt[ns].c_str(),sgn*z,e); -+ } -+ free(test); -+ } -+ -+ void gdlMultiAxisTickFunc(PLINT axis, PLFLT value, char *label, PLINT length, PLPointer data) -+ { -+ static GDL_TICKDATA tdata; -+ static SizeT internalIndex=0; -+ static DLong lastUnits=0; -+ string Month; -+ PLINT Day , Year , Hour , Minute; -+ PLFLT Second; -+ struct GDL_MULTIAXISTICKDATA *ptr = (GDL_MULTIAXISTICKDATA* )data; -+ tdata.isLog=ptr->isLog; -+ if (ptr->counter != lastUnits) -+ { -+ lastUnits=ptr->counter; -+ internalIndex=0; -+ } -+ if (ptr->what==GDL_TICKFORMAT || (ptr->what==GDL_TICKFORMAT_AND_UNITS && ptr->counter < ptr->nTickFormat) ) -+ { -+ if (ptr->counter > ptr->nTickFormat-1) -+ { -+ doOurOwnFormat(axis, value, label, length, &tdata); -+// snprintf( label, length, "%f", value ); -+ } -+ else -+ { -+ if (((*ptr->TickFormat)[ptr->counter]).substr(0,1) == "(") -+ { //internal format, call internal func "STRING" -+ EnvT *e=ptr->e; -+ static int stringIx = LibFunIx("STRING"); -+ assert( stringIx >= 0); -+ EnvT* newEnv= new EnvT(e, libFunList[stringIx], NULL); -+ Guard guard( newEnv); -+ // add parameters -+ newEnv->SetNextPar( new DDoubleGDL(value)); -+ newEnv->SetNextPar( new DStringGDL(((*ptr->TickFormat)[ptr->counter]).c_str())); -+ // make the call -+ BaseGDL* res = static_cast(newEnv->GetPro())->Fun()(newEnv); -+ strcpy(label,(*static_cast(res))[0].c_str()); -+ } -+ else if (((*ptr->TickFormat)[ptr->counter]).substr(0,10) == "LABEL_DATE") -+ { //special internal format, TBD -+ Warning("unsupported LABEL_DATE for TICKFORMAT (FIXME)"); -+ } -+ else // external function: if tickunits not specified, pass Axis (int), Index(int),Value(Double) -+ // else pass also Level(int) -+ // Thanks to Marc for code snippet! -+ { -+ EnvT *e=ptr->e; -+ DString callF=(*ptr->TickFormat)[ptr->counter]; -+ // this is a function name -> convert to UPPERCASE -+ callF = StrUpCase( callF); -+ // Search in user proc and function -+ SizeT funIx = GDLInterpreter::GetFunIx( callF); -+ -+ EnvUDT* newEnv = new EnvUDT( e->CallingNode(), funList[ funIx], (BaseGDL**)NULL); -+ Guard< EnvUDT> guard( newEnv); -+ // add parameters -+ newEnv->SetNextPar( new DLongGDL(axis)); -+ newEnv->SetNextPar( new DLongGDL(internalIndex)); -+ newEnv->SetNextPar( new DDoubleGDL(value)); -+ if (ptr->what==GDL_TICKFORMAT_AND_UNITS) newEnv->SetNextPar( new DLongGDL(ptr->counter)); -+ // guard *before* pushing new env -+ StackGuard guard1 ( e->Interpreter()->CallStack()); -+ e->Interpreter()->CallStack().push_back(newEnv); -+ guard.release(); -+ -+ BaseGDL* retValGDL = e->Interpreter()->call_fun(static_cast(newEnv->GetPro())->GetTree()); -+ // we are the owner of the returned value -+ Guard retGuard( retValGDL); -+ strcpy(label,(*static_cast(retValGDL))[0].c_str()); -+ } -+ } -+ } -+ else if (ptr->what==GDL_TICKUNITS) -+ { -+ if (ptr->counter > ptr->nTickUnits-1) - { -- start = test1; -- end = test2; -+ doOurOwnFormat(axis, value, label, length, &tdata); -+// snprintf( label, length, "%f", value ); - } -+ else -+ { -+ DString what=StrUpCase((*ptr->TickUnits)[ptr->counter]); -+ DDouble range=abs(ptr->axismax-ptr->axismin); -+ tickformat_date(value, Month , Day , Year , Hour , Minute, Second); -+ if (what.substr(0,4)=="YEAR") -+ snprintf( label, length, "%d", Year); -+ else if (what.substr(0,5)=="MONTH") -+ snprintf( label, length, "%s", Month.c_str()); -+ else if (what.substr(0,3)=="DAY") -+ snprintf( label, length, "%d", Day); -+ else if (what.substr(0,4)=="HOUR") -+ snprintf( label, length, "%d", Hour); -+ else if (what.substr(0,6)=="MINUTE") -+ snprintf( label, length, "%d", Minute); -+ else if (what.substr(0,6)=="SECOND") -+ snprintf( label, length, "%f", Second); -+ else if (what.substr(0,4)=="TIME") -+ { -+ if(range>=366) snprintf( label, length, "%d", Year); -+ else if(range>=32) snprintf( label, length, "%s", Month.c_str()); -+ else if(range>=1.1) snprintf( label, length, "%d", Day); -+ else if(range*24>=1.1) snprintf( label, length, "%d", Hour); -+ else if(range*24*60>=1.1) snprintf( label, length, "%d", Minute); -+ else snprintf( label, length, "%04.1f",Second); -+ } -+ else snprintf( label, length, "%g", value ); -+ } -+ } -+ internalIndex++; -+ } -+ -+ void gdlSingleAxisTickFunc( PLINT axis, PLFLT value, char *label, PLINT length, PLPointer data) -+ { -+ static GDL_TICKDATA tdata; -+ struct GDL_TICKNAMEDATA *ptr = (GDL_TICKNAMEDATA* )data; -+ tdata.isLog=ptr->isLog; -+ if (ptr->counter > ptr->nTickName-1) -+ { -+ doOurOwnFormat(axis, value, label, length, &tdata); - } -- string RangeName = axis + "RANGE"; -- BaseGDL* Range = e->GetKW(e->KeywordIx(RangeName)); -- if (Range != NULL) -+ else - { -- if (Range->N_Elements() != 2) -- e->Throw("Keyword array parameter " + RangeName + -- " must have 2 elements."); -- auto_ptr guard; -- DDoubleGDL* RangeF = static_cast -- (Range->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -- guard.reset(RangeF); -- start = (*RangeF)[0]; -- end = (*RangeF)[1]; -- if (axis == "Y") ynozero = 1; -+ snprintf( label, length, "%s", ((*ptr->TickName)[ptr->counter]).c_str() ); - } -+ ptr->counter++; - } -- //current value of margin of axis 'axis' -- void get_axis_margin(string axis, DFloat &low, DFloat &high) -+ -+ bool gdlAxis(EnvT *e, GDLGStream *a, string axis, DDouble Start, DDouble End, bool Log, DLong modifierCode, DDouble NormedLength) - { -- DStructGDL* Struct=NULL; -- if(axis=="X") Struct = SysVar::X(); -- if(axis=="Y") Struct = SysVar::Y(); -- if(Struct!=NULL) -- { -- static unsigned marginTag = Struct->Desc()->TagIndex( "MARGIN"); -- low = (*static_cast( Struct->GetTag( marginTag, 0)))[0]; -- high = (*static_cast( Struct->GetTag( marginTag, 0)))[1]; -+ static GDL_TICKNAMEDATA data; -+ static GDL_MULTIAXISTICKDATA muaxdata; -+ -+ static GDL_TICKDATA tdata; -+ tdata.isLog=Log; -+ -+ data.nTickName=0; -+ muaxdata.e=e; -+ muaxdata.what=GDL_NONE; -+ muaxdata.nTickFormat=0; -+ muaxdata.nTickUnits=0; -+ muaxdata.axismin=Start; -+ muaxdata.axismax=End; -+ -+ //special values -+ PLFLT OtherAxisSizeInMm; -+ if (axis=="X") OtherAxisSizeInMm=a->mmyPageSize()*(a->boxnYSize()); -+ if (axis=="Y") OtherAxisSizeInMm=a->mmxPageSize()*(a->boxnXSize()); -+ //special for AXIS who change the requested box size! -+ if (axis=="axisX") {axis="X"; OtherAxisSizeInMm=a->mmyPageSize()*(NormedLength);} -+ if (axis=="axisY") {axis="Y"; OtherAxisSizeInMm=a->mmxPageSize()*(NormedLength);} -+ -+ DFloat Charsize; -+ gdlGetDesiredAxisCharsize(e, axis, Charsize); -+ DLong GridStyle; -+ gdlGetDesiredAxisGridStyle(e, axis, GridStyle); -+ DFloat MarginL, MarginR; -+ gdlGetDesiredAxisMargin(e, axis, MarginL, MarginR); -+ DLong Minor; -+ gdlGetDesiredAxisMinor(e, axis, Minor); -+ DLong Style; -+ gdlGetDesiredAxisStyle(e, axis, Style); -+ DFloat Thick; -+ gdlGetDesiredAxisThick(e, axis, Thick); -+ DStringGDL* TickFormat; -+ gdlGetDesiredAxisTickFormat(e, axis, TickFormat); -+ DDouble TickInterval; -+ gdlGetDesiredAxisTickInterval(e, axis, TickInterval); -+ DLong TickLayout; -+ gdlGetDesiredAxisTickLayout(e, axis, TickLayout); -+ DFloat TickLen; -+ gdlGetDesiredAxisTickLen(e, axis, TickLen); -+ DStringGDL* TickName; -+ gdlGetDesiredAxisTickName(e, axis, TickName); -+ DLong Ticks; -+ gdlGetDesiredAxisTicks(e, axis, Ticks); -+ DStringGDL* TickUnits; -+ gdlGetDesiredAxisTickUnits(e, axis, TickUnits); -+ DDoubleGDL* Tickv; -+ gdlGetDesiredAxisTickv(e, axis, Tickv); -+ DString Title; -+ gdlGetDesiredAxisTitle(e, axis, Title); -+ -+ if ( (Style&4)!=4 ) //if we write the axis... -+ { -+ if (TickInterval==0) -+ { -+ if (Ticks<=0) TickInterval=gdlComputeTickInterval(e, axis, Start, End, Log); -+ else if (Ticks>1) TickInterval=(End-Start)/Ticks; -+ else TickInterval=(End-Start); -+ } -+ string Opt; -+ //first write labels only: -+ gdlSetAxisCharsize(e, a, axis); -+ gdlSetPlotCharthick(e, a); -+ // axis legend if box style, else do not draw: -+ if (modifierCode==0 ||modifierCode==1) -+ { -+ if (axis=="X") a->mtex("b", 3.5, 0.5, 0.5, Title.c_str()); -+ else if (axis=="Y") a->mtex("l",5.0,0.5,0.5,Title.c_str()); -+ } -+ else if (modifierCode==2) -+ { -+ if (axis=="X") a->mtex("t", 3.5, 0.5, 0.5, Title.c_str()); -+ else if (axis=="Y") a->mtex("r",5.0,0.5,0.5,Title.c_str()); -+ } -+ //axis, 1st time: labels -+ Opt="tvx";// the x option is in plplot 5.9.8 but not before. It permits -+ // to avoid writing tick marks here (they will be written after) -+ // I hope old plplots were clever enough to ignore 'x' -+ // if they did not understand 'x' -+ if ( Log ) Opt+="l"; -+ if (TickName->NBytes()>0) // /TICKNAME=[array] -+ { -+ data.counter=0; -+ data.TickName=TickName; -+ data.nTickName=TickName->N_Elements(); -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( gdlSingleAxisTickFunc, &data ); -+ Opt+="o"; -+#endif -+ if (modifierCode==2) Opt+="m"; else Opt+="n"; -+ if (axis=="X") a->box(Opt.c_str(), TickInterval, Minor, "", 0.0, 0); -+ else if (axis=="Y") a->box("", 0.0 ,0.0, Opt.c_str(), TickInterval, Minor); -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( NULL, NULL ); -+#endif -+ } -+ else if (TickUnits->NBytes()>0) // /TICKUNITS=[several types of axes written below each other] -+ { -+ muaxdata.counter=0; -+ muaxdata.what=GDL_TICKUNITS; -+ if (TickFormat->NBytes()>0) // with also TICKFORMAT option.. -+ { -+ muaxdata.what=GDL_TICKFORMAT_AND_UNITS; -+ muaxdata.TickFormat=TickFormat; -+ muaxdata.nTickFormat=TickFormat->N_Elements(); -+ } -+ muaxdata.TickUnits=TickUnits; -+ muaxdata.nTickUnits=TickUnits->N_Elements(); -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( gdlMultiAxisTickFunc, &muaxdata ); -+ Opt+="o"; -+#endif -+ if (modifierCode==2) Opt+="m"; else Opt+="n"; -+ for (SizeT i=0; i< muaxdata.nTickUnits; ++i) //loop on TICKUNITS axis -+ { -+ PLFLT un,deux,trois,quatre,xun,xdeux,xtrois,xquatre; -+ a->plstream::gvpd(un,deux,trois,quatre); -+ a->plstream::gvpw(xun,xdeux,xtrois,xquatre); -+ if (axis=="X") -+ { -+ a->smaj(a->mmCharHeight(), 1.0 ); -+ a->plstream::vpor(un,deux,(PLFLT)(trois-i*3*a->nCharHeight()),quatre); -+ a->plstream::wind(xun,xdeux,xtrois,xquatre); -+ a->box(Opt.c_str(), TickInterval, Minor, "", 0.0, 0); -+ } -+ else if (axis=="Y") -+ { -+ a->smaj(a->mmCharLength(), 1.0 ); -+ a->plstream::vpor(un-i*3*a->nCharLength(),deux,trois,quatre); -+ a->plstream::wind(xun,xdeux,xtrois,xquatre); -+ a->box("", 0.0 ,0.0, Opt.c_str(), TickInterval, Minor); -+ } -+ a->plstream::vpor(un,deux,trois,quatre); -+ a->plstream::wind(xun,xdeux,xtrois,xquatre); -+ muaxdata.counter++; -+ } -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( NULL, NULL ); -+#endif -+ } -+ else if (TickFormat->NBytes()>0) //no /TICKUNITS=> only 1 value taken into account -+ { -+ muaxdata.counter=0; -+ muaxdata.what=GDL_TICKFORMAT; -+ muaxdata.TickFormat=TickFormat; -+ muaxdata.nTickFormat=1; -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( gdlMultiAxisTickFunc, &muaxdata ); -+ Opt+="o"; -+#endif -+ if (modifierCode==2) Opt+="m"; else Opt+="n"; -+ if (axis=="X") a->box(Opt.c_str(), TickInterval, Minor, "", 0.0, 0); -+ else if (axis=="Y") a->box("", 0.0 ,0.0, Opt.c_str(), TickInterval, Minor); -+ -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( NULL, NULL ); -+#endif -+ } -+ else -+ { -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( doOurOwnFormat, &tdata ); -+ Opt+="o"; -+#endif -+ if (modifierCode==2) Opt+="m"; else Opt+="n"; -+ if (axis=="X") a->box(Opt.c_str(), TickInterval, Minor, "", 0.0, 0); -+ else if (axis=="Y") a->box("", 0.0 ,0.0, Opt.c_str(), TickInterval, Minor); -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( NULL, NULL ); -+#endif -+ } -+ -+ if (TickLayout==0) -+ { -+ a->smaj((PLFLT)OtherAxisSizeInMm, 1.0); //set base ticks to default 0.02 viewport converted to mm. -+ a->smin((PLFLT)OtherAxisSizeInMm/2.0,1.0); //idem min (plplt defaults) -+ //thick for box and ticks. -+ a->wid(Thick); -+ //ticks or grid eventually with style and length: -+ if (abs(TickLen)<1e-6) Opt=""; else Opt="st"; //remove ticks if ticklen=0 -+ if (TickLen<0) {Opt+="i"; TickLen=-TickLen;} -+ switch(modifierCode) -+ { -+ case 2: -+ Opt+="c"; -+ break; -+ case 1: -+ Opt+="b"; -+ break; -+ case 0: -+ if ( (Style&8)==8 ) Opt+="b"; else Opt+="bc"; -+ } -+ bool bloatsmall=(TickLen<0.3); -+ //gridstyle applies here: -+ gdlLineStyle(a,GridStyle); -+ a->smaj (0.0, (PLFLT)TickLen); //relative value -+ if (bloatsmall) a->smin (0.0, (PLFLT)TickLen); else a->smin( 1.5, 1.0 ); -+ if ( Log ) Opt+="l"; -+ if (axis=="X") a->box(Opt.c_str(), TickInterval, Minor, "", 0.0, 0); -+ else if (axis=="Y") a->box("", 0.0, 0, Opt.c_str(), TickInterval, Minor); -+ //reset ticks to default plplot value... -+ a->smaj( 3.0, 1.0 );//back to default values -+ a->smin( 1.5, 1.0 ); -+ //reset gridstyle -+ gdlLineStyle(a,0); -+ // pass over with outer box, with thick. No style applied, only ticks -+ Opt=" "; -+ switch(modifierCode) -+ { -+ case 2: -+ Opt+="c"; -+ break; -+ case 1: -+ Opt+="b"; -+ break; -+ case 0: -+ if ( (Style&8)==8 ) Opt+="b"; else Opt+="bc"; -+ } -+ if (axis=="X") a->box(Opt.c_str(), 0.0, 0, "", 0.0, 0); -+ else if (axis=="Y") a->box("", 0.0, 0 , Opt.c_str(), 0.0, 0); -+ } -+ //reset charsize & thick -+ a->wid(1); -+ a->sizeChar(1.0); -+ } -+ return 0; -+ } -+ -+ bool gdlBox(EnvT *e, GDLGStream *a, DDouble xStart, DDouble xEnd, DDouble yStart, DDouble yEnd, bool xLog, bool yLog) -+ { -+ gdlAxis(e, a, "X", xStart, xEnd, xLog); -+ gdlAxis(e, a, "Y", yStart, yEnd, yLog); -+ // title and sub title -+ gdlWriteTitleAndSubtitle(e, a); -+ return true; -+ } -+ -+ bool gdlAxis3(EnvT *e, GDLGStream *a, string axis, DDouble Start, DDouble End, bool Log, DLong zAxisCode, DDouble NormedLength) -+ { -+ //exit if nothing to do... -+ string addCode="b"; //for X and Y, and some Z -+ if(zAxisCode==1 || zAxisCode==4) addCode="cm"; -+ if(zAxisCode==-1) return true; -+ -+ // -+ static GDL_TICKNAMEDATA data; -+ static GDL_MULTIAXISTICKDATA muaxdata; -+ data.nTickName=0; -+ muaxdata.e=e; -+ muaxdata.what=GDL_NONE; -+ muaxdata.nTickFormat=0; -+ muaxdata.nTickUnits=0; -+ muaxdata.axismin=Start; -+ muaxdata.axismax=End; -+ -+ //special values -+ PLFLT OtherAxisSizeInMm; -+ if (axis=="X") OtherAxisSizeInMm=a->mmyPageSize()*(a->boxnYSize()); -+ if (axis=="Y") OtherAxisSizeInMm=a->mmxPageSize()*(a->boxnXSize()); -+ if (axis=="Z") OtherAxisSizeInMm=a->mmxPageSize()*(a->boxnXSize()); //not always correct -+ //special for AXIS who change the requested box size! -+ if (axis=="axisX") {axis="X"; OtherAxisSizeInMm=a->mmyPageSize()*(NormedLength);} -+ if (axis=="axisY") {axis="Y"; OtherAxisSizeInMm=a->mmxPageSize()*(NormedLength);} -+ if (axis=="axisZ") {axis="Y"; OtherAxisSizeInMm=a->mmxPageSize()*(NormedLength);} //not always correct -+ -+ DFloat Charsize; -+ gdlGetDesiredAxisCharsize(e, axis, Charsize); -+ DLong GridStyle; -+ gdlGetDesiredAxisGridStyle(e, axis, GridStyle); -+ DFloat MarginL, MarginR; -+ gdlGetDesiredAxisMargin(e, axis, MarginL, MarginR); -+ DLong Minor; -+ gdlGetDesiredAxisMinor(e, axis, Minor); -+ DLong Style; -+ gdlGetDesiredAxisStyle(e, axis, Style); -+ DFloat Thick; -+ gdlGetDesiredAxisThick(e, axis, Thick); -+ DStringGDL* TickFormat; -+ gdlGetDesiredAxisTickFormat(e, axis, TickFormat); -+ DDouble TickInterval; -+ gdlGetDesiredAxisTickInterval(e, axis, TickInterval); -+ DLong TickLayout; -+ gdlGetDesiredAxisTickLayout(e, axis, TickLayout); -+ DFloat TickLen; -+ gdlGetDesiredAxisTickLen(e, axis, TickLen); -+ DStringGDL* TickName; -+ gdlGetDesiredAxisTickName(e, axis, TickName); -+ DLong Ticks; -+ gdlGetDesiredAxisTicks(e, axis, Ticks); -+ DStringGDL* TickUnits; -+ gdlGetDesiredAxisTickUnits(e, axis, TickUnits); -+ DDoubleGDL* Tickv; -+ gdlGetDesiredAxisTickv(e, axis, Tickv); -+ DString Title; -+ gdlGetDesiredAxisTitle(e, axis, Title); -+ -+ if ( (Style&4)!=4 ) //if we write the axis... -+ { -+ if (TickInterval==0) -+ { -+ if (Ticks<=0) TickInterval=gdlComputeTickInterval(e, axis, Start, End, Log); -+ else if (Ticks>1) TickInterval=(End-Start)/Ticks; -+ else TickInterval=(End-Start); -+ } -+ string Opt; -+ //first write labels only: -+ gdlSetAxisCharsize(e, a, axis); -+ gdlSetPlotCharthick(e, a); -+ // axis legend if box style, else do not draw: -+ Opt="u"; -+ -+ if (axis=="X") a->box3(Opt.c_str(), Title.c_str() , 0.0, 0, "", "", 0.0, 0, "", "", 0.0, 0); -+ else if (axis=="Y") a->box3("", "", 0.0 ,0, Opt.c_str(), Title.c_str(), 0.0, 0, "", "", 0.0, 0); -+ else if (axis=="Z") a->box3("", "", 0.0, 0, "", "", 0.0, 0, Opt.c_str(), Title.c_str(), 0.0, 0); -+ -+ -+ //axis, 1st time: labels -+ Opt=addCode+"nst"; //will write labels beside the left hand axis (u) at major ticks (n) -+ if ( Log ) Opt+="l"; -+ if (TickName->NBytes()>0) // /TICKNAME=[array] -+ { -+ data.counter=0; -+ data.TickName=TickName; -+ data.nTickName=TickName->N_Elements(); -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( gdlSingleAxisTickFunc, &data ); -+ Opt+="o"; -+#endif -+ if (axis=="X") a->box3(Opt.c_str(), "" , TickInterval, Minor, "", "", 0.0, 0, "", "", 0.0, 0); -+ else if (axis=="Y") a->box3("", "", 0.0 ,0.0, Opt.c_str(),"", TickInterval, Minor, "", "", 0.0, 0); -+ else if (axis=="Z") a->box3("", "", 0.0, 0, "", "", 0.0, 0, Opt.c_str(), "", TickInterval, Minor); -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( NULL, NULL ); -+#endif - } -+ else if (TickFormat->NBytes()>0) //no /TICKUNITS=> only 1 value taken into account -+ { -+ muaxdata.counter=0; -+ muaxdata.what=GDL_TICKFORMAT; -+ muaxdata.TickFormat=TickFormat; -+ muaxdata.nTickFormat=1; -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( gdlMultiAxisTickFunc, &muaxdata ); -+ Opt+="o"; -+#endif -+ if (axis=="X") a->box3(Opt.c_str(), "", TickInterval, Minor, "", "", 0.0, 0, "", "", 0.0, 0); -+ else if (axis=="Y") a->box3("", "", 0.0 ,0.0, Opt.c_str(),"", TickInterval, Minor, "", "", 0.0, 0); -+ else if (axis=="Z") a->box3("", "", 0.0, 0, "", "", 0.0, 0, Opt.c_str(), "", TickInterval, Minor); -+ -+#if (HAVE_PLPLOT_SLABELFUNC) -+ a->slabelfunc( NULL, NULL ); -+#endif -+ } -+ else -+ { -+ if (axis=="X") a->box3(Opt.c_str(), "", TickInterval, Minor, "", "", 0.0, 0, "", "", 0.0, 0); -+ else if (axis=="Y") a->box3("", "", 0.0 ,0.0, Opt.c_str(),"", TickInterval, Minor, "", "", 0.0, 0); -+ else if (axis=="Z") a->box3("", "", 0.0, 0, "", "", 0.0, 0, Opt.c_str(), "", TickInterval, Minor); -+ } -+ -+ if (TickLayout==0) -+ { -+ a->smaj((PLFLT)OtherAxisSizeInMm, 1.0); //set base ticks to default 0.02 viewport converted to mm. -+ a->smin((PLFLT)OtherAxisSizeInMm/2.0,1.0); //idem min (plplt defaults) -+ //thick for box and ticks. -+ a->wid(Thick); -+ //ticks or grid eventually with style and length: -+ if (abs(TickLen)<1e-6) Opt=""; else Opt="st"; //remove ticks if ticklen=0 -+ if (TickLen<0) {Opt+="i"; TickLen=-TickLen;} -+ bool bloatsmall=(TickLen<0.3); -+ //gridstyle applies here: -+ gdlLineStyle(a,GridStyle); -+ a->smaj (0.0, (PLFLT)TickLen); //relative value -+ if (bloatsmall) a->smin (0.0, (PLFLT)TickLen); else a->smin( 1.5, 1.0 ); -+ if ( Log ) Opt+="l"; -+ if (axis=="X") a->box3(Opt.c_str(), "", TickInterval, Minor, "", "", 0.0, 0, "", "", 0.0, 0); -+ else if (axis=="Y") a->box3("", "", 0.0 ,0.0, Opt.c_str(),"", TickInterval, Minor, "", "", 0.0, 0); -+ else if (axis=="Z") a->box3("", "", 0.0, 0, "", "", 0.0, 0, Opt.c_str(), "", TickInterval, Minor); -+ //reset ticks to default plplot value... -+ a->smaj( 3.0, 1.0 ); -+ a->smin( 1.5, 1.0 ); -+ //reset gridstyle -+ gdlLineStyle(a,0); -+ // pass over with outer box, with thick. No style applied, only ticks -+ Opt="b"; -+ if (axis=="X") a->box3(Opt.c_str(), "", TickInterval, Minor, "","",0,0,"","",0,0); -+ else if (axis=="Y") a->box3("","",0,0, Opt.c_str(), "", TickInterval, Minor, "","",0,0); -+ else if (axis=="Z") a->box3("","",0,0,"","",0,0, Opt.c_str(), "", TickInterval, Minor); -+ } -+ //reset charsize & thick -+ a->wid(1); -+ a->sizeChar(1.0); -+ } -+ return 0; -+ } -+ -+ bool gdlBox3(EnvT *e, GDLGStream *a, DDouble xStart, DDouble xEnd, DDouble yStart, -+ DDouble yEnd, DDouble zStart, DDouble zEnd, bool xLog, bool yLog, bool zLog, bool doSpecialZAxisPlacement) -+ { -+ DLong zAxisCode=0; -+ if (doSpecialZAxisPlacement) e->AssureLongScalarKWIfPresent("ZAXIS", zAxisCode); -+ gdlAxis3(e, a, "X", xStart, xEnd, xLog, 0); -+ gdlAxis3(e, a, "Y", yStart, yEnd, yLog, 0); -+ gdlAxis3(e, a, "Z", zStart, zEnd, zLog, zAxisCode); -+ // title and sub title -+ gdlWriteTitleAndSubtitle(e, a); -+ return true; -+ } -+ -+ bool T3Denabled(EnvT *e) -+ { -+ static DStructGDL* pStruct=SysVar::P(); -+ DLong ok4t3d=(*static_cast(pStruct->GetTag(pStruct->Desc()->TagIndex("T3D"), 0)))[0]; -+ if (ok4t3d==0) return false; else return true; - } -+ - void usersym(EnvT *e) --{ -- DFloatGDL *xyVal, *xVal, *yVal; -- auto_ptr p0_guard; -- DLong n; -- DInt do_fill; -- DFloat *x, *y; -- SizeT nParam = e->NParam(); -- -- if (nParam == 1) { -- BaseGDL* p0 = e->GetNumericArrayParDefined( 0)->Transpose( NULL); //hence [1024,2] -- -- xyVal = static_cast -- (p0->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- p0_guard.reset( p0); // delete upon exit -+ { -+ DFloatGDL *xyVal, *xVal, *yVal; -+ Guard p0_guard; -+ DLong n; -+ DInt do_fill; -+ DFloat *x, *y; -+ SizeT nParam=e->NParam(); - -- if(xyVal->Rank() != 2 || xyVal->Dim(1) != 2) -- e->Throw(e->GetParString(0)+" must be a 2-dim array of type [2,N] in this context."); -+ if ( nParam==1 ) -+ { -+ BaseGDL* p0=e->GetNumericArrayParDefined(0)->Transpose(NULL); //hence [1024,2] - -- if (xyVal->Dim(0) > 1024) -- { -- e->Throw("Max array size for USERSYM is 1024"); -- } -- n = xyVal->Dim(0); -- // array is in the good order for direct C assignement -- x=&(*xyVal)[0]; -- y=&(*xyVal)[n]; -- } else { -- xVal = e->GetParAs< DFloatGDL > (0); -- if (xVal->Rank() != 1) -- e->Throw(e->GetParString(0)+" must be a 1D array in this context: "); -- -- yVal = e->GetParAs< DFloatGDL > (1); -- if (yVal->Rank() != 1) -- e->Throw("Expression must be a 1D array in this context: " + e->GetParString(1)); -+ xyVal=static_cast -+ (p0->Convert2(GDL_FLOAT, BaseGDL::COPY)); -+ p0_guard.Reset(p0); // delete upon exit - -- if (xVal->Dim(0)!= yVal->Dim(0)) -- { -- e->Throw("Arrays must have same size "); -- } -+ if ( xyVal->Rank()!=2||xyVal->Dim(1)!=2 ) -+ e->Throw(e->GetParString(0)+" must be a 2-dim array of type [2,N] in this context."); - -- if (xVal->Dim(0) > 1024) -- { -- e->Throw("Max array size for USERSYM is 1024"); -- } -- n = xVal->Dim(0); -- x=&(*xVal)[0]; -- y=&(*yVal)[0]; -- } -- do_fill=0; -- if (e->KeywordSet("FILL")) { -- do_fill=1; -- } -- SetUsym(n,do_fill, x, y); -+ if ( xyVal->Dim(0)>1024 ) -+ { -+ e->Throw("Max array size for USERSYM is 1024"); -+ } -+ n=xyVal->Dim(0); -+ // array is in the good order for direct C assignement -+ x=&(*xyVal)[0]; -+ y=&(*xyVal)[n]; -+ } -+ else -+ { -+ xVal=e->GetParAs< DFloatGDL>(0); -+ if ( xVal->Rank()!=1 ) -+ e->Throw(e->GetParString(0)+" must be a 1D array in this context: "); -+ -+ yVal=e->GetParAs< DFloatGDL>(1); -+ if ( yVal->Rank()!=1 ) -+ e->Throw("Expression must be a 1D array in this context: "+e->GetParString(1)); -+ -+ if ( xVal->Dim(0)!=yVal->Dim(0) ) -+ { -+ e->Throw("Arrays must have same size "); -+ } -+ -+ if ( xVal->Dim(0)>1024 ) -+ { -+ e->Throw("Max array size for USERSYM is 1024"); -+ } -+ n=xVal->Dim(0); -+ x=&(*xVal)[0]; -+ y=&(*yVal)[0]; -+ } -+ do_fill=0; -+ if ( e->KeywordSet("FILL") ) -+ { -+ do_fill=1; -+ } -+ SetUsym(n, do_fill, x, y); - } -+ - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_cursor.cpp gdl/src/plotting_cursor.cpp ---- gdl-0.9.3/src/plotting_cursor.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_cursor.cpp 2013-06-03 14:22:52.000000000 -0600 -@@ -24,18 +24,101 @@ - - using namespace std; - --// get cursor from plPlot AC February 2008 --// known limitations : WAIT parameter and similar keywords not fully managed (wait, nowait ...) -+void empty(EnvT* e) -+{ -+ Graphics* actDevice = Graphics::GetDevice(); -+ if (actDevice->Name() == "X") -+ { -+ GDLGStream *plg = actDevice->GetStream(); -+ if (plg != NULL) plg->Flush(); -+ } -+} -+ -+void tvcrs( EnvT* e) -+{ -+ Graphics* actDevice = Graphics::GetDevice(); -+ -+ if (actDevice->Name() != "X") -+ { -+ e->Throw("Routine is not defined for current graphics device."); -+ } -+ SizeT nParam = e->NParam(1); -+ -+ if (nParam < 2 ) -+ { -+ e->Throw("TVCRS with 1 argument not implemented (fixme)"); -+ } -+ DDoubleGDL *x,*y; -+ -+ x = e->GetParAs< DDoubleGDL > (0); -+ y = e->GetParAs< DDoubleGDL > (1); -+ -+ GDLGStream *plg = actDevice->GetStream(); -+ if (plg == NULL) e->Throw("Unable to create window."); -+ PLINT plplot_level; -+ plg->glevel(plplot_level); -+ // when level < 2, we have to read if ![x|y].crange exist -+ // if not, we have to build a [0,1]/[0,1] window -+ if (plplot_level < 2) -+ { -+ plg->NextPlot(); -+ -+ plg->vpor(0, 1, 0, 1); -+ plg->wind(0, 1, 0, 1); - -+ } -+ -+ PLFLT ix,iy; -+ -+ if (e->KeywordSet("DATA")) // /DATA -+ { -+ DDouble tempx,tempy; -+ tempx=(*x)[0]; -+ tempy=(*y)[0]; -+#ifdef USE_LIBPROJ4 -+ bool mapSet = false; -+ get_mapset(mapSet); -+ if (mapSet) -+ { -+ PROJTYPE* ref = map_init(); -+ if (ref == NULL) e->Throw("Projection initialization failed."); -+ LPTYPE idata, idataN; -+ idataN.lam = tempx* RAD_TO_DEG; -+ idataN.phi = tempy* RAD_TO_DEG; -+ XYTYPE odata = PJ_FWD(idata, ref); -+ tempx = odata.x; -+ tempy = odata.y; -+ } -+#endif -+ bool xLog, yLog; -+ gdlGetAxisType("X", xLog); -+ gdlGetAxisType("Y", yLog); -+ if(xLog) tempx=pow(10,tempx); -+ if(yLog) tempy=pow(10,tempy); -+ plg->WorldToDevice(tempx,tempy,ix,iy); -+ } -+ else if (e->KeywordSet("NORMAL")) -+ { -+ plg->NormedDeviceToDevice((*x)[0],(*y)[0],ix,iy); -+ } -+ else // (e->KeywordSet("DEVICE")) -+ { -+ ix=(*x)[0]; -+ iy=(*y)[0]; -+ } -+ plg->WarpPointer(ix,iy); -+} -+ -+// get cursor from plPlot AC February 2008 -+// fully compatible with IDL using our own cursor routines GD Jan 2013 - void cursor(EnvT* e){ - Graphics* actDevice = Graphics::GetDevice(); -- //cout << actDevice->Name() << endl; -+ - if (actDevice->Name() != "X") - { - e->Throw("Routine is not defined for current graphics device."); - } - -- int debug = 0; - SizeT nParam = e->NParam(1); - - if (nParam < 2 || nParam > 3) -@@ -51,12 +134,8 @@ - - static PLGraphicsIn gin; - -- // content of : plGetCursor(); -- // [retval, state, keysym, button, string, pX, pY, dX, dY, wX, wY, subwin] -- - PLINT plplot_level; - plg->glevel(plplot_level); -- if (debug) cout << "Plplot_level : " << plplot_level << endl; - // when level < 2, we have to read if ![x|y].crange exist - // if not, we have to build a [0,1]/[0,1] window - if (plplot_level < 2) -@@ -66,124 +145,73 @@ - plg->vpor(0, 1, 0, 1); - plg->wind(0, 1, 0, 1); - -- /* we are not ready for the correct way (rebuilding a window following -- stored info) -- -- // we have to read them back from !x.crange and !y.crange -- PLFLT xStart, xEnd, yStart, yEnd; -- get_axis_crange("X", xStart, xEnd); -- get_axis_crange("Y", yStart, yEnd); -- if ((xStart == xEnd ) || ( xEnd ==0.0)) { -- xStart=0.0; -- xEnd=1.0; -- } -- if ((yStart == yEnd ) || ( yEnd ==0.0)) { -- yStart=0.0; -- yEnd=1.0; -- } -- AC_debug("crange", xStart, xEnd, yStart, yEnd); -- -- bool okVPWC = SetVP_WC( e, plg, NULL, NULL, 0, 0, -- xStart, xEnd, yStart, yEnd, false, false); -- if( !okVPWC) return; -- */ - } -- -+ // mimic idl logic: - DLong wait = 1; -- - if (nParam == 3) - { - e->AssureLongScalarPar(2, wait); - } -+ if (e->KeywordSet("NOWAIT")) wait=0; -+ if (e->KeywordSet("CHANGE")) wait=2; -+ if (e->KeywordSet("WAIT")) wait=1; -+ if (e->KeywordSet("DOWN")) wait=3; -+ if (e->KeywordSet("UP")) wait=4; -+ PLFLT xp, yp; -+ PLINT xleng, yleng, xoff, yoff; -+ plg->gpage(xp, yp, xleng, yleng, xoff, yoff); - -- if ((wait == 1) || (wait == 3) || (wait == 4) || -- e->KeywordSet("WAIT") || -- e->KeywordSet("DOWN") || -- e->KeywordSet("UP")) -- { -- //cout << "Sorry, this option is currently not *really* managed. Help welcome" << endl; -- // we toggle to "wait == 1" (the mouse can move but we return if mouse is pressed) -- wait = 1; -- } -- -- int mode = 0; // just a flag to manage the general case (cursor,x,y) -- -- if ((wait == 0) || e->KeywordSet("NOWAIT")) -+ if (wait == 0) - { -- gin.button = 1; -- plg->GetCursor(&gin); -- gin.button = 0; -- mode = 1; -- wait = 0; -+ if(plg->GetGin(&gin, 0)==false) return; - } -- if (wait == 1) -+ else if (wait == 2) - { -- while (1) -- { -- plg->GetCursor(&gin); -- // cout << gin.button << endl; -- if (gin.button > 0) break; -- if (sigControlC) -- return; -- } -- mode = 1; -- } -- if ((wait == 2) || e->KeywordSet("CHANGE")) -- { -- plg->GetCursor(&gin); -- long RefX, RefY; -+ if(plg->GetGin(&gin, 0)==false) return; -+ PLFLT RefX, RefY; - RefX = gin.pX; - RefY = gin.pY; -- if (gin.button == 0) -+ unsigned int refstate=gin.state; -+ while (1) - { -- while (1) -+ if(plg->GetGin(&gin, 2)==false) return; -+ if (abs(RefX - gin.pX) > 0 || abs(RefY - gin.pY) > 0) -+ { -+ RefX = gin.pX; -+ RefY = gin.pY; -+ break; -+ } -+ if (gin.state != refstate) - { -- plg->GetCursor(&gin); -- if (abs(RefX - gin.dX) > 0 || abs(RefY - gin.dY) > 0) break; -- if (gin.button > 0) break; -- if (sigControlC) -- return; -+ refstate=gin.state; -+ break; - } - } -- mode = 1; - } -- -- if (mode == 0) -+ else if (wait == 3) - { -- while (1) -- { -- plg->GetCursor(&gin); -- // TODO: When no Mouse, should be extended later to any key of the keyboard -- if (gin.keysym == PLK_Escape) break; -- if (gin.button > 0) break; -- if (sigControlC) -- return; -- } -+ if(plg->GetGin(&gin, 3)==false) return; - } -- -- if (debug) -+ else if (wait == 4) - { -- // plg->text(); -- cout << "mouse button : " << gin.button << endl; -- cout << "keysym : " << gin.keysym << endl; -- //plg->gra(); -- /* if (gin.keysym < 0xFF && isprint(gin.keysym)) -- cout << "wx = " << gin.wX << ", wy = " << gin.wY << -- ", dx = " << gin.dX << ", dy = " << gin.dY << -- ", c = '" << gin.keysym << "'" << endl; -- plg->gra(); */ -+ if(plg->GetGin(&gin, 4)==false) return; -+ } -+ else -+ { -+ if(plg->GetGin(&gin, 1)==false) return; -+ } -+ // outside window report -1 -1 at least for DEVICE values -+ if (gin.pX < 0 || gin.pX > plg->xPageSize() || gin.pY < 0 || gin.pY > plg->yPageSize()) -+ { -+ gin.pX = -1; -+ gin.pY = -1; - } -- - if (e->KeywordSet("DEVICE")) - { -- PLFLT xp, yp; -- PLINT xleng, yleng, xoff, yoff; -- plg->gpage(xp, yp, xleng, yleng, xoff, yoff); -- - DLongGDL* xLong; - DLongGDL* yLong; - xLong = new DLongGDL(gin.pX); -- yLong = new DLongGDL(yleng - gin.pY); -+ yLong = new DLongGDL(gin.pY); - - e->SetPar(0, xLong); - e->SetPar(1, yLong); -@@ -206,8 +234,7 @@ - if (!mapSet) - { - #endif -- -- getWorldCoordinatesFromPLPLOT(plg, (DDouble)gin.dX, (DDouble)gin.dY, &tempx, &tempy); -+ plg->NormToWorld((DDouble)gin.dX, (DDouble)gin.dY, tempx, tempy); - #ifdef USE_LIBPROJ4 - } - else -@@ -217,15 +244,15 @@ - XYTYPE idata, idataN; - idataN.x = gin.dX; - idataN.y = gin.dY; -- getWorldCoordinatesFromPLPLOT(plg, idataN.x, idataN.y, &idata.x, &idata.y); -+ plg->NormToWorld(idataN.x, idataN.y, idata.x, idata.y); - LPTYPE odata = PJ_INV(idata, ref); - tempx = odata.lam * RAD_TO_DEG; - tempy = odata.phi * RAD_TO_DEG; - } - #endif - bool xLog, yLog; -- get_axis_type("X", xLog); -- get_axis_type("Y", yLog); -+ gdlGetAxisType("X", xLog); -+ gdlGetAxisType("Y", yLog); - if(xLog) tempx=pow(10,tempx); - if(yLog) tempy=pow(10,tempy); - x = new DDoubleGDL(tempx); -@@ -236,6 +263,9 @@ - } - - // we update the !Mouse structure (4 fields, only 3 managed up to now) -+ // found on the web: -+ //"Information about which mouse button has been used (if) any is stored in the !err variable. A value of 1 corresponds to the left, 2 to middle and 4 to the right button." -+ //!err is obsolete but still working: - DStructGDL* Struct = SysVar::Mouse(); - if (Struct != NULL) - { -@@ -247,6 +277,8 @@ - if (gin.button == 3) gin.button = 4; // 4 values only (0,1,2,4) - (*static_cast(Struct->GetTag(ButtonMouseTag)))[0] = gin.button; - } -+ DVar *err=FindInVarList(sysVarList, "ERR"); -+ (static_cast(err->Data()))[0]= gin.button; - } - - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_device.cpp gdl/src/plotting_device.cpp ---- gdl-0.9.3/src/plotting_device.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_device.cpp 2013-03-21 14:04:04.000000000 -0600 -@@ -1,345 +1,416 @@ --/*************************************************************************** -- plotting.cpp - GDL routines for plotting -- ------------------- -- begin : July 22 2002 -- copyright : (C) 2002-2011 by Marc Schellens et al. -- email : m_schellens@users.sf.net -- ***************************************************************************/ -- --/*************************************************************************** -- * * -- * This program is free software; you can redistribute it and/or modify * -- * it under the terms of the GNU General Public License as published by * -- * the Free Software Foundation; either version 2 of the License, or * -- * (at your option) any later version. * -- * * -- ***************************************************************************/ -- --#include "includefirst.hpp" --#include "plotting.hpp" --#include // GSL_CONST_MKSA_INCH -- --namespace lib { -- -- using namespace std; -- -- void device( EnvT* e) -- { -- Graphics* actDevice = Graphics::GetDevice(); -- -- // GET_SCREEN_SIZE {{{ -- { -- static int get_screen_sizeIx = e->KeywordIx( "GET_SCREEN_SIZE"); -- if( e->KeywordPresent( get_screen_sizeIx)) -- { --#ifndef HAVE_X -- e->Throw("GDL was compiled without support for X-windows"); --#else -- // see below in Function "get_scren_size()" explanations ... -- Display* display = XOpenDisplay(NULL); -- if (display == NULL) -- e->Throw("Cannot connect to X server"); -- -- int screen_num; -- int screen_width; -- int screen_height; -- screen_num = DefaultScreen(display); -- screen_width = DisplayWidth(display, screen_num); -- screen_height = DisplayHeight(display, screen_num); -- -- DIntGDL* res; -- res = new DIntGDL(2, BaseGDL::NOZERO); -- -- (*res)[0]= screen_width; -- (*res)[1]= screen_height; -- e->SetKW( get_screen_sizeIx, res); --#endif -- } -- } -- // }}} -- -- // WINDOW_STATE kw {{{ -- { -- static int window_stateIx = e->KeywordIx( "WINDOW_STATE"); -- if (e->KeywordPresent(window_stateIx)) -- { -- // check if X (could be more elegant...) -- DStructGDL* dStruct = SysVar::D(); -- static unsigned nameTag = dStruct->Desc()->TagIndex( "NAME"); -- DString d_name = (*static_cast( dStruct->GetTag( nameTag, 0)))[0]; -- // if PS and not noErase (ie, erase) then set !p.noerase=0 -- if (d_name != "X") e->Throw("WINDOW_STATE not supported for the current device (" + d_name + "), it works for X only"); -- int maxwin = actDevice->MaxWin(); -- assert(maxwin > 0); -- DByteGDL* ret = new DByteGDL(dimension( maxwin), BaseGDL::NOZERO); -- for (int i = 0; i < maxwin; i++) (*ret)[i] = actDevice->WState(i); -- e->SetKW( window_stateIx, ret); -- } -- } -- // }}} -- -- // CLOSE_FILE {{{ -- { -- static int closeFileIx = e->KeywordIx( "CLOSE_FILE"); -- if( e->KeywordSet( closeFileIx)) -- { -- bool success = actDevice->CloseFile(); -- if( !success) -- e->Throw( "Current device does not support keyword CLOSE_FILE."); -- } -- } -- // }}} -- -- // Z_BUFFERING {{{ -- { -- static int z_bufferingIx = e->KeywordIx( "Z_BUFFERING"); -- BaseGDL* z_buffering = e->GetKW( z_bufferingIx); -- if( z_buffering != NULL) -- { -- bool success = actDevice->ZBuffering( e->KeywordSet( z_bufferingIx)); -- if( !success) -- e->Throw( "Current device does not support keyword Z_BUFFERING."); -- } -- } -- // }}} -- -- // SET_RESOLUTION {{{ -- { -- static int set_resolutionIx = e->KeywordIx( "SET_RESOLUTION"); -- BaseGDL* set_resolution = e->GetKW( set_resolutionIx); -- if( set_resolution != NULL) -- { -- DLongGDL* resolution = e->GetKWAs( set_resolutionIx); -- if( resolution->N_Elements() != 2) -- e->Throw( "Keyword array parameter SET_RESOLUTION must have 2 elements."); -- DLong x = (*resolution)[0]; -- DLong y = (*resolution)[1]; -- -- if( x<0 || y<0) -- e->Throw( "Value of Resolution is out of allowed range."); -- -- bool success = actDevice->SetResolution( x, y); -- if( !success) -- e->Throw( "Current device does not support keyword SET_RESOLUTION."); -- } -- } -- // }}} -- -- // DECOMPOSED {{{ -- { -- static int decomposedIx = e->KeywordIx( "DECOMPOSED"); -- BaseGDL* decomposed = e->GetKW( decomposedIx); -- if( decomposed != NULL) -- { -- bool success = actDevice->Decomposed( e->KeywordSet( decomposedIx)); -- if( !success) -- e->Throw( "Current device does not support keyword DECOMPOSED."); -- } -- } -- // }}} -- -- // GET_DECOMPOSED {{{ -- { -- static int get_decomposedIx = e->KeywordIx( "GET_DECOMPOSED"); -- if( e->KeywordPresent( get_decomposedIx)) -- { -- DLong value = actDevice->GetDecomposed(); -- if(value == -1) -- e->Throw( "Current device does not support keyword GET_DECOMPOSED."); -- else -- e->SetKW( get_decomposedIx, new DLongGDL( value)); -- } -- } -- // }}} -- -- // GET_VISUAL_DEPTH {{{ -- { -- static int get_visual_depthIx = e->KeywordIx( "GET_VISUAL_DEPTH"); -- if (e->KeywordPresent( get_visual_depthIx)) -- { -- { -- DStructGDL* dStruct = SysVar::D(); -- static unsigned nameTag = dStruct->Desc()->TagIndex( "NAME"); -- if ((*static_cast( dStruct->GetTag( nameTag, 0)))[0] != "X") -- e->Throw("GET_VISUAL_DEPTH is not supported by current device"); -- } --#ifndef HAVE_X -- e->Throw("GDL was compiled without support for X-windows"); --#else -- Display* display = XOpenDisplay(NULL); -- if (display == NULL) -- e->Throw("Cannot connect to X server"); -- int depth = DefaultDepth(display, DefaultScreen(display)); -- XCloseDisplay(display); -- e->SetKW( get_visual_depthIx, new DLongGDL( depth)); --#endif -- } -- } -- // }}} -- -- // FILENAME {{{ -- { -- static int fileNameIx = e->KeywordIx( "FILENAME"); -- BaseGDL* fileName = e->GetKW( fileNameIx); -- if( fileName != NULL) -- { -- DString fName; -- e->AssureStringScalarKW( fileNameIx, fName); -- if( fName == "") -- e->Throw( "Null filename not allowed."); -- WordExp(fName); -- bool success = actDevice->SetFileName( fName); -- if( !success) -- e->Throw( "Current device does not support keyword FILENAME."); -- } -- } -- // }}} -- -- // LANDSCAPE and PORTRAIT need to be executed before XSIZE, YSIZE, XOFFSET and YOFFSET! -- { -- static int portraitIx = e->KeywordIx( "PORTRAIT"); -- static int landscapeIx = e->KeywordIx( "LANDSCAPE"); -- if (e->KeywordSet(portraitIx) && e->KeywordSet(landscapeIx)) -- Warning("Warning: both PORTRAIT and LANDSCAPE specified!"); -- -- // LANDSCAPE {{{ -- { -- if (e->GetKW(landscapeIx) != NULL) -- { -- bool success = actDevice->SetLandscape(); -- if (!success) e->Throw("Current device does not support keyword LANDSCAPE"); -- } -- } -- // }}} -- -- // PORTRAIT {{{ -- { -- if (e->GetKW(portraitIx) != NULL) -- { -- bool success = actDevice->SetPortrait(); -- if (!success) e->Throw("Current device does not support keyword PORTRAIT"); -- } -- } -- // }}} -- } -- -- { -- static int inchesIx = e->KeywordIx( "INCHES"); -- // XOFFSET {{{ -- { -- static int xOffsetIx = e->KeywordIx( "XOFFSET"); -- BaseGDL* xOffsetKW = e->GetKW( xOffsetIx); -- if( xOffsetKW != NULL) -- { -- DFloat xOffsetValue; -- e->AssureFloatScalarKW( xOffsetIx, xOffsetValue); -- bool success = actDevice->SetXOffset( xOffsetValue -- * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -- ); -- if( !success) -- e->Throw( "Current device does not support keyword XOFFSET."); -- } -- } -- // }}} -- -- // YOFFSET {{{ -- { -- static int yOffsetIx = e->KeywordIx( "YOFFSET"); -- BaseGDL* yOffsetKW = e->GetKW( yOffsetIx); -- if( yOffsetKW != NULL) -- { -- DFloat yOffsetValue; -- e->AssureFloatScalarKW( yOffsetIx, yOffsetValue); -- bool success = actDevice->SetYOffset( yOffsetValue -- * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -- ); -- if( !success) -- e->Throw( "Current device does not support keyword YOFFSET."); -- } -- } -- // }}} -- -- // XSIZE {{{ -- { -- static int xSizeIx = e->KeywordIx( "XSIZE"); -- BaseGDL* xSizeKW = e->GetKW( xSizeIx); -- if( xSizeKW != NULL) -- { -- DFloat xSizeValue; -- e->AssureFloatScalarKW( xSizeIx, xSizeValue); -- bool success = actDevice->SetXPageSize( xSizeValue -- * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -- ); -- if( !success) -- e->Throw( "Current device does not support keyword XSIZE."); -- } -- } -- // }}} -- -- // YSIZE {{{ -- { -- static int ySizeIx = e->KeywordIx( "YSIZE"); -- BaseGDL* ySizeKW = e->GetKW( ySizeIx); -- if( ySizeKW != NULL) -- { -- DFloat ySizeValue; -- e->AssureFloatScalarKW( ySizeIx, ySizeValue); -- bool success = actDevice->SetYPageSize( ySizeValue -- * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -- ); -- if( !success) -- e->Throw( "Current device does not support keyword YSIZE."); -- } -- } -- // }}} -- } -- -- // SCALE_FACTOR {{{ -- { -- static int scaleIx = e->KeywordIx( "SCALE_FACTOR"); -- BaseGDL* scaleKW = e->GetKW( scaleIx); -- if( scaleKW != NULL) -- { -- DFloat scaleValue; -- e->AssureFloatScalarKW( scaleIx, scaleValue); -- bool success = actDevice->SetScale( scaleValue); -- if( !success) -- e->Throw( "Current device does not support keyword SCALE."); -- } -- } -- // }}} -- -- // COLOR {{{ -- { -- // TODO: turn off with COLOR=0? -- static int colorIx = e->KeywordIx( "COLOR"); -- BaseGDL* colorKW = e->GetKW( colorIx); -- if( colorKW != NULL) -- { -- bool success = actDevice->SetColor(); -- if( !success) e->Throw( "Current device does not support keyword COLOR."); -- } -- } -- // }}} -- -- // ENCAPSULATED {{{ -- { -- static int encapsulatedIx = e->KeywordIx( "ENCAPSULATED"); -- BaseGDL* encapsulatedKW = e->GetKW( encapsulatedIx); -- if( encapsulatedKW != NULL) -- { -- bool success; -- if ((*e->GetKWAs(encapsulatedIx))[0] == 0) -- success = actDevice->SetEncapsulated(false); -- else -- success = actDevice->SetEncapsulated(true); -- if (!success) e->Throw( "Current device does not support keyword ENCAPSULATED."); -- } -- } -- // }}} -- -- -- } -- --} // namespace -- -+/*************************************************************************** -+ plotting.cpp - GDL routines for plotting -+ ------------------- -+ begin : July 22 2002 -+ copyright : (C) 2002-2011 by Marc Schellens et al. -+ email : m_schellens@users.sf.net -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#include "includefirst.hpp" -+#include "plotting.hpp" -+#include // GSL_CONST_MKSA_INCH -+ -+namespace lib { -+ -+ using namespace std; -+ -+ void device( EnvT* e) -+ { -+ Graphics* actDevice = Graphics::GetDevice(); -+ -+ // GET_SCREEN_SIZE {{{ -+ { -+ static int get_screen_sizeIx = e->KeywordIx( "GET_SCREEN_SIZE"); -+ if( e->KeywordPresent( get_screen_sizeIx)) -+ { -+#ifndef HAVE_X -+ e->Throw("GDL was compiled without support for X-windows"); -+#else -+ // see below in Function "get_scren_size()" explanations ... -+ Display* display = XOpenDisplay(NULL); -+ if (display == NULL) -+ e->Throw("Cannot connect to X server"); -+ -+ int screen_num; -+ int screen_width; -+ int screen_height; -+ screen_num = DefaultScreen(display); -+ screen_width = DisplayWidth(display, screen_num); -+ screen_height = DisplayHeight(display, screen_num); -+ -+ DIntGDL* res; -+ res = new DIntGDL(2, BaseGDL::NOZERO); -+ -+ (*res)[0]= screen_width; -+ (*res)[1]= screen_height; -+ e->SetKW( get_screen_sizeIx, res); -+#endif -+ } -+ } -+ // }}} -+ -+ // WINDOW_STATE kw {{{ -+ { -+ static int window_stateIx = e->KeywordIx( "WINDOW_STATE"); -+ if (e->KeywordPresent(window_stateIx)) -+ { -+ // check if X (could be more elegant...) -+ DStructGDL* dStruct = SysVar::D(); -+ static unsigned nameTag = dStruct->Desc()->TagIndex( "NAME"); -+ DString d_name = (*static_cast( dStruct->GetTag( nameTag, 0)))[0]; -+ // if PS and not noErase (ie, erase) then set !p.noerase=0 -+ if (d_name != "X") e->Throw("WINDOW_STATE not supported for the current device (" + d_name + "), it works for X only"); -+ int maxwin = actDevice->MaxWin(); -+ assert(maxwin > 0); -+ DByteGDL* ret = new DByteGDL(dimension( maxwin), BaseGDL::NOZERO); -+ for (int i = 0; i < maxwin; i++) (*ret)[i] = actDevice->WState(i); -+ e->SetKW( window_stateIx, ret); -+ } -+ } -+ // }}} -+ -+ // CLOSE_FILE {{{ -+ { -+ static int closeFileIx = e->KeywordIx( "CLOSE_FILE"); -+ if( e->KeywordSet( closeFileIx)) -+ { -+ bool success = actDevice->CloseFile(); -+ if( !success) -+ e->Throw( "Current device does not support keyword CLOSE_FILE."); -+ } -+ } -+ // }}} -+ -+ // Z_BUFFERING {{{ -+ { -+ static int z_bufferingIx = e->KeywordIx( "Z_BUFFERING"); -+ BaseGDL* z_buffering = e->GetKW( z_bufferingIx); -+ if( z_buffering != NULL) -+ { -+ bool success = actDevice->ZBuffering( e->KeywordSet( z_bufferingIx)); -+ if( !success) -+ e->Throw( "Current device does not support keyword Z_BUFFERING."); -+ } -+ } -+ // }}} -+ -+ // SET_RESOLUTION {{{ -+ { -+ static int set_resolutionIx = e->KeywordIx( "SET_RESOLUTION"); -+ BaseGDL* set_resolution = e->GetKW( set_resolutionIx); -+ if( set_resolution != NULL) -+ { -+ DLongGDL* resolution = e->GetKWAs( set_resolutionIx); -+ if( resolution->N_Elements() != 2) -+ e->Throw( "Keyword array parameter SET_RESOLUTION must have 2 elements."); -+ DLong x = (*resolution)[0]; -+ DLong y = (*resolution)[1]; -+ -+ if( x<0 || y<0) -+ e->Throw( "Value of Resolution is out of allowed range."); -+ -+ bool success = actDevice->SetResolution( x, y); -+ if( !success) -+ e->Throw( "Current device does not support keyword SET_RESOLUTION."); -+ } -+ } -+ // }}} -+ -+ // DECOMPOSED {{{ -+ { -+ static int decomposedIx = e->KeywordIx( "DECOMPOSED"); -+ BaseGDL* decomposed = e->GetKW( decomposedIx); -+ if( decomposed != NULL) -+ { -+ bool success = actDevice->Decomposed( e->KeywordSet( decomposedIx)); -+ if( !success) -+ e->Throw( "Current device does not support keyword DECOMPOSED."); -+ } -+ } -+ // }}} -+ -+ // GET_DECOMPOSED {{{ -+ { -+ static int get_decomposedIx = e->KeywordIx( "GET_DECOMPOSED"); -+ if( e->KeywordPresent( get_decomposedIx)) -+ { -+ DLong value = actDevice->GetDecomposed(); -+ if(value == -1) -+ e->Throw( "Current device does not support keyword GET_DECOMPOSED."); -+ else -+ e->SetKW( get_decomposedIx, new DLongGDL( value)); -+ } -+ } -+ // }}} -+ // GET_GRAPHICS_FUNCTION -+ { -+ static int get_graphicsFunctionIx = e->KeywordIx( "GET_GRAPHICS_FUNCTION"); -+ if( e->KeywordPresent( get_graphicsFunctionIx)) -+ { -+ DLong value = actDevice->GetGraphicsFunction(); -+ if(value == -1) -+ e->Throw( "Current device does not support keyword GET_GRAPHICS_FUNCTION."); -+ else -+ e->SetKW( get_graphicsFunctionIx, new DLongGDL( value)); -+ } -+ } -+ // SET_GRAPHICS_FUNCTION -+ { -+ static int set_graphicsFunctionIx = e->KeywordIx( "SET_GRAPHICS_FUNCTION"); -+ BaseGDL* set_gfunction = e->GetKW( set_graphicsFunctionIx); -+ if( set_gfunction != NULL) -+ { -+ DLongGDL* gfunction = e->GetKWAs( set_graphicsFunctionIx); -+ bool success = actDevice->SetGraphicsFunction((*gfunction)[0]); -+ if( !success) -+ e->Throw( "Current device does not support keyword SET_GRAPHICS_FUNCTION."); -+ } -+ } -+ // CURSOR_STANDARD -+ { -+ static int cursorStandardIx = e->KeywordIx( "CURSOR_STANDARD"); -+ BaseGDL* res = e->GetKW( cursorStandardIx); -+ if( res != NULL) -+ { -+ DLongGDL* val = e->GetKWAs( cursorStandardIx); -+ bool success = actDevice->CursorStandard((*val)[0]); -+ if( !success) -+ e->Throw( "Current device does not support keyword CURSOR_STANDARD."); -+ } -+ } -+ // RETAIN -+ { -+ static int valIx = e->KeywordIx( "RETAIN"); -+ BaseGDL* res = e->GetKW( valIx); -+ if( res != NULL) -+ { -+ DLongGDL* val = e->GetKWAs( valIx); -+ bool success = actDevice->EnableBackingStore((*val)[0]); -+ if( !success) -+ e->Throw( "Current device does not support keyword RETAIN."); -+ } -+ } -+ // CURSOR_CROSSHAIR -+ { -+ static int valIx = e->KeywordIx( "CURSOR_CROSSHAIR"); -+ BaseGDL* res = e->GetKW( valIx); -+ if( res != NULL) -+ { -+ bool success = actDevice->CursorCrosshair(); -+ if( !success) -+ e->Throw( "Current device does not support keyword CURSOR_CROSSHAIR."); -+ } -+ } -+ // CURSOR_ORIGINAL (WARNING: SAME CODE AS CURSOR_CROSSHAIR!) -+ { -+ static int valIx = e->KeywordIx( "CURSOR_ORIGINAL"); -+ BaseGDL* res = e->GetKW( valIx); -+ if( res != NULL) -+ { -+ bool success = actDevice->CursorCrosshair(); -+ if( !success) -+ e->Throw( "Current device does not support keyword CURSOR_ORIGINAL."); -+ } -+ } -+ // GET_VISUAL_DEPTH {{{ -+ { -+ static int get_visual_depthIx = e->KeywordIx( "GET_VISUAL_DEPTH"); -+ if (e->KeywordPresent( get_visual_depthIx)) -+ { -+ { -+ DStructGDL* dStruct = SysVar::D(); -+ static unsigned nameTag = dStruct->Desc()->TagIndex( "NAME"); -+ if ((*static_cast( dStruct->GetTag( nameTag, 0)))[0] != "X") -+ e->Throw("GET_VISUAL_DEPTH is not supported by current device"); -+ } -+#ifndef HAVE_X -+ e->Throw("GDL was compiled without support for X-windows"); -+#else -+ Display* display = XOpenDisplay(NULL); -+ if (display == NULL) -+ e->Throw("Cannot connect to X server"); -+ int depth = DefaultDepth(display, DefaultScreen(display)); -+ XCloseDisplay(display); -+ e->SetKW( get_visual_depthIx, new DLongGDL( depth)); -+#endif -+ } -+ } -+ // }}} -+ -+ // FILENAME {{{ -+ { -+ static int fileNameIx = e->KeywordIx( "FILENAME"); -+ BaseGDL* fileName = e->GetKW( fileNameIx); -+ if( fileName != NULL) -+ { -+ DString fName; -+ e->AssureStringScalarKW( fileNameIx, fName); -+ if( fName == "") -+ e->Throw( "Null filename not allowed."); -+ WordExp(fName); -+ bool success = actDevice->SetFileName( fName); -+ if( !success) -+ e->Throw( "Current device does not support keyword FILENAME."); -+ } -+ } -+ // }}} -+ -+ // LANDSCAPE and PORTRAIT need to be executed before XSIZE, YSIZE, XOFFSET and YOFFSET! -+ { -+ static int portraitIx = e->KeywordIx( "PORTRAIT"); -+ static int landscapeIx = e->KeywordIx( "LANDSCAPE"); -+ if (e->KeywordSet(portraitIx) && e->KeywordSet(landscapeIx)) -+ Warning("Warning: both PORTRAIT and LANDSCAPE specified!"); -+ -+ // LANDSCAPE {{{ -+ { -+ if (e->GetKW(landscapeIx) != NULL) -+ { -+ bool success = actDevice->SetLandscape(); -+ if (!success) e->Throw("Current device does not support keyword LANDSCAPE"); -+ } -+ } -+ // }}} -+ -+ // PORTRAIT {{{ -+ { -+ if (e->GetKW(portraitIx) != NULL) -+ { -+ bool success = actDevice->SetPortrait(); -+ if (!success) e->Throw("Current device does not support keyword PORTRAIT"); -+ } -+ } -+ // }}} -+ } -+ -+ { -+ static int inchesIx = e->KeywordIx( "INCHES"); -+ // XOFFSET {{{ -+ { -+ static int xOffsetIx = e->KeywordIx( "XOFFSET"); -+ BaseGDL* xOffsetKW = e->GetKW( xOffsetIx); -+ if( xOffsetKW != NULL) -+ { -+ DFloat xOffsetValue; -+ e->AssureFloatScalarKW( xOffsetIx, xOffsetValue); -+ bool success = actDevice->SetXOffset( xOffsetValue -+ * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -+ ); -+ if( !success) -+ e->Throw( "Current device does not support keyword XOFFSET."); -+ } -+ } -+ // }}} -+ -+ // YOFFSET {{{ -+ { -+ static int yOffsetIx = e->KeywordIx( "YOFFSET"); -+ BaseGDL* yOffsetKW = e->GetKW( yOffsetIx); -+ if( yOffsetKW != NULL) -+ { -+ DFloat yOffsetValue; -+ e->AssureFloatScalarKW( yOffsetIx, yOffsetValue); -+ bool success = actDevice->SetYOffset( yOffsetValue -+ * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -+ ); -+ if( !success) -+ e->Throw( "Current device does not support keyword YOFFSET."); -+ } -+ } -+ // }}} -+ -+ // XSIZE {{{ -+ { -+ static int xSizeIx = e->KeywordIx( "XSIZE"); -+ BaseGDL* xSizeKW = e->GetKW( xSizeIx); -+ if( xSizeKW != NULL) -+ { -+ DFloat xSizeValue; -+ e->AssureFloatScalarKW( xSizeIx, xSizeValue); -+ bool success = actDevice->SetXPageSize( xSizeValue -+ * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -+ ); -+ if( !success) -+ e->Throw( "Current device does not support keyword XSIZE."); -+ } -+ } -+ // }}} -+ -+ // YSIZE {{{ -+ { -+ static int ySizeIx = e->KeywordIx( "YSIZE"); -+ BaseGDL* ySizeKW = e->GetKW( ySizeIx); -+ if( ySizeKW != NULL) -+ { -+ DFloat ySizeValue; -+ e->AssureFloatScalarKW( ySizeIx, ySizeValue); -+ bool success = actDevice->SetYPageSize( ySizeValue -+ * (e->KeywordPresent(inchesIx) ? 100. * GSL_CONST_MKSA_INCH : 1.) -+ ); -+ if( !success) -+ e->Throw( "Current device does not support keyword YSIZE."); -+ } -+ } -+ // }}} -+ } -+ -+ // SCALE_FACTOR {{{ -+ { -+ static int scaleIx = e->KeywordIx( "SCALE_FACTOR"); -+ BaseGDL* scaleKW = e->GetKW( scaleIx); -+ if( scaleKW != NULL) -+ { -+ DFloat scaleValue; -+ e->AssureFloatScalarKW( scaleIx, scaleValue); -+ bool success = actDevice->SetScale( scaleValue); -+ if( !success) -+ e->Throw( "Current device does not support keyword SCALE."); -+ } -+ } -+ // }}} -+ -+ // COLOR {{{ -+ { -+ // TODO: turn off with COLOR=0? -+ static int colorIx = e->KeywordIx( "COLOR"); -+ BaseGDL* colorKW = e->GetKW( colorIx); -+ if( colorKW != NULL) -+ { -+ DLong colorValue; -+ e->AssureLongScalarKW( colorIx, colorValue); -+ bool success = actDevice->SetColor(colorValue); -+ if( !success) e->Throw( "Current device does not support keyword COLOR."); -+ } -+ } -+ // }}} -+ -+ // ENCAPSULATED {{{ -+ { -+ static int encapsulatedIx = e->KeywordIx( "ENCAPSULATED"); -+ BaseGDL* encapsulatedKW = e->GetKW( encapsulatedIx); -+ if( encapsulatedKW != NULL) -+ { -+ bool success; -+ if ((*e->GetKWAs(encapsulatedIx))[0] == 0) -+ success = actDevice->SetEncapsulated(false); -+ else -+ success = actDevice->SetEncapsulated(true); -+ if (!success) e->Throw( "Current device does not support keyword ENCAPSULATED."); -+ } -+ } -+ // }}} -+ -+ -+ } -+ -+} // namespace -+ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_erase.cpp gdl/src/plotting_erase.cpp ---- gdl-0.9.3/src/plotting_erase.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_erase.cpp 2013-05-16 12:36:33.000000000 -0600 -@@ -76,13 +76,8 @@ - if (bColor < 0) bColor = 0; - } - -- // Get decomposed value -- Graphics* actDevice = Graphics::GetDevice(); -- DLong decomposed = actDevice->GetDecomposed(); -- if (decomposed != 0 && decomposed != 1) {decomposed=0;} -- -- actStream->Background( bColor, decomposed); -- actStream->Clear(); -+ actStream->Background( bColor); -+ actStream->Clear(); - } - - private: virtual void post_call(EnvT*, GDLGStream*) // {{{ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting.hpp gdl/src/plotting.hpp ---- gdl-0.9.3/src/plotting.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting.hpp 2013-07-08 12:39:22.340387850 -0600 -@@ -17,11 +17,88 @@ - - #ifndef PLOTTING_HPP_ - #define PLOTTING_HPP_ -+#define gdlPlot_Min(a, b) ((a) < (b) ? (a) : (b)) -+#define gdlPlot_Max(a, b) ((a) > (b) ? (a) : (b)) -+ -+//To debug Affine 3D homogenous projections matrices. -+//IDL define a matrix as M[ncol,mrow] and print as such. However col_major and -+//row_major refer to the math notation M[row,col] where row=dim(0) and col=dim(1). -+//Matrices are stored COL Major in IDL/Fortran and ROW Major in C,C++ etc. -+//so element at (i,j) is computed as (j*dim0 + i) for ColMajor/IDL -+//and (i*dim1 + j) for RowMajor/C -+ -+#define TRACEMATRIX_C(var__)\ -+ {int dim0__=(var__)->Dim(0), dim1__=(var__)->Dim(1);\ -+ fprintf(stderr,"c matrix[%d,%d]\n",dim0__,dim1__);\ -+ for (int row=0; row < dim0__ ; row++)\ -+ {\ -+ for (int col=0; col < dim1__-1; col++)\ -+ {\ -+ fprintf(stderr,"%g, ",(*var__)[row*dim1__ + col]);\ -+ }\ -+ fprintf(stderr,"%g\n",(*var__)[row*dim1__ + dim1__ -1]);\ -+ }\ -+ fprintf(stderr,"\n");\ -+ } -+//The following abbrevs should output the C matrix as IDL would do (ie,transposed): -+#define TRACEMATRIX_IDL(var__)\ -+ {int dim0__=(var__)->Dim(0), dim1__=(var__)->Dim(1);\ -+ fprintf(stderr,"idl matrix[%d,%d]\n[",dim0__,dim1__);\ -+ for (int col=0; col < dim1__; col++)\ -+ {\ -+ fprintf(stderr,"[");\ -+ for (int row=0; row < dim0__; row++)\ -+ {\ -+ fprintf(stderr,"%g",(*var__)[row*dim1__ + col]);\ -+ if (rowGetStream(); - if (actStream == NULL) e->Throw("Unable to create window."); -- -+ isDB = actStream->hasDoubleBuffering(); -+ if (isDB) actStream->setDoubleBuffering(); -+ DString name = (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("NAME"), 0)))[0]; -+ if (name == "X") -+ { -+ actStream->updatePageInfo(); //since window size can change -+ long xsize,ysize,xoff,yoff; -+ actStream->GetGeometry(xsize,ysize,xoff,yoff); -+ (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("X_SIZE"), 0)))[0] = xsize; -+ (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("Y_SIZE"), 0)))[0] = ysize; -+ (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("X_VSIZE"), 0)))[0] = xsize; -+ (*static_cast(SysVar::D()->GetTag(SysVar::D()->Desc()->TagIndex("Y_VSIZE"), 0)))[0] = ysize; -+ } - old_body(e, actStream); // TODO: to be removed! - call_plplot(e, actStream); - -- actStream->flush(); -- - post_call(e, actStream); -+ if (isDB) actStream->eop(); else actStream->flush(); -+ if(isDB) actStream->unSetDoubleBuffering(); - } // }}} - }; -- -+ template -+ void gdlDoRangeExtrema(T* xVal, T* yVal, DDouble &min, DDouble &max, DDouble xmin, DDouble xmax, bool doMinMax=FALSE, DDouble minVal=0, DDouble maxVal=0); - template - bool draw_polyline(EnvT *e, GDLGStream *a, T * xVal, T* yVal, - DDouble minVal, DDouble maxVal, bool doMinMax, - bool xLog, bool yLog, -- DLong psym=0, bool append=FALSE); -- -- void gkw_axis_margin(EnvT *e, string axis,DFloat &start, DFloat &end); -- -+ DLong psym=0, bool append=FALSE, DLongGDL *color=NULL); -+ DDouble gdlEpsDouble(); -+ DDouble gdlAbsoluteMinValueDouble(); -+ DDouble gdlAbsoluteMaxValueDouble(); -+ //protect from (inverted, strange) axis log values -+ void gdlHandleUnwantedAxisValue(DDouble &min, DDouble &max, bool log); - //set the background color -- void gkw_background(EnvT * e, GDLGStream * a,bool kw=true); -+ void gdlSetGraphicsBackgroundColorFromKw(EnvT * e, GDLGStream * a,bool kw=true); -+ //set The background color as foreground () -+ void gdlSetGraphicsPenColorToBackground(GDLGStream *a); - //set the foreground color -- void gkw_color(EnvT * e, GDLGStream * a); -- //set the noerase flag -- void gkw_noerase(EnvT * e, GDLGStream * a,bool noe=0); -+ void gdlSetGraphicsForegroundColorFromKw(EnvT * e, GDLGStream * a, string otherColorKw=""); -+ //advance to next plot unless the noerase flag is set -+ void gdlNextPlotHandlingNoEraseOption(EnvT * e, GDLGStream * a,bool noe=0); - //set the symbol shape -- void gkw_psym(EnvT *e, DLong &psym); -+ void gdlGetPsym(EnvT *e, DLong &psym); - //set the symbol size -- void gkw_symsize(EnvT * e, GDLGStream * a); -- //set the character size, special version authorizing 'SIZE' keyword -- void gkw_charsize_xyouts(EnvT * e, GDLGStream * a, DFloat& charsize); -- //set the character size -- void gkw_charsize(EnvT * e, GDLGStream * a, DFloat& charsize, bool kw=true); -+ void gdlSetSymsize(EnvT * e, GDLGStream * a); -+ //set the PLOT character size (including MULTI subscaling) -+ void gdlSetPlotCharsize(EnvT *e, GDLGStream *a, bool accept_sizeKw=false); -+ //set the PLOT Char Thickness -+ void gdlSetPlotCharthick(EnvT *e, GDLGStream *a); - //set the line thickness -- void gkw_thick(EnvT * e, GDLGStream * a); -+ void gdlSetPenThickness(EnvT * e, GDLGStream * a); - //set the linestyle -- void gkw_linestyle(EnvT * e, GDLGStream * a); -+ void gdlLineStyle(GDLGStream *a, DLong style); -+ void gdlSetLineStyle(EnvT * e, GDLGStream * a); -+ //set axis linewidth -+ void gdlSetAxisThickness(EnvT *e, GDLGStream *a, string axis); - //title -- void gkw_title(EnvT* e, GDLGStream *a, PLFLT ad); -+ void gdlWriteTitleAndSubtitle(EnvT* e, GDLGStream *a); - //set the !axis.crange vector -- void set_axis_crange(string axis, DDouble Start, DDouble End, bool log); -- //get the !axis.crange vector -- void get_axis_crange(string axis, DDouble &Start, DDouble &End); -- void get_axis_margin(string axis, DFloat &low, DFloat &high); -- //axis_type -- void get_axis_type(string axis, bool &log); -- void set_axis_type(string axis, bool type); -+ void gdlStoreAxisCRANGE(string axis, DDouble Start, DDouble End, bool log); -+ //set the !axis.s vector -+ void gdlStoreAxisSandWINDOW(GDLGStream* actStream, string axis, DDouble Start, DDouble End, bool log=false); - - // mapset - void get_mapset(bool &mapset); - void set_mapset(bool mapset); - -- void gkw_axis_charsize(EnvT* e, string axis, DFloat &charsize); -- -- void gkw_axis_style(EnvT *e, string axis,DLong &style); -- void gkw_axis_title(EnvT *e, string axis,DString &title); -- void gkw_axis_range(EnvT *e, string axis, -- DDouble &start, DDouble &end, DLong & ynozero); -- -- void mesh_nr(PLFLT *, PLFLT *, PLFLT **, PLINT, PLINT, PLINT); -- -- void GetSFromPlotStructs(DDouble **sx, DDouble **sy); -+ //axis_type -+ void gdlGetAxisType(string axis, bool &log); -+ //get the !axis.crange vector -+ void gdlGetCurrentAxisRange(string axis, DDouble &Start, DDouble &End); -+ void gdlGetDesiredAxisMargin(EnvT *e, string axis,DFloat &start, DFloat &end); -+ void gdlGetDesiredAxisCharsize(EnvT* e, string axis, DFloat &charsize); -+ void gdlGetDesiredAxisStyle(EnvT *e, string axis,DLong &style); -+ void gdlGetDesiredAxisTitle(EnvT *e, string axis,DString &title); -+ bool gdlGetDesiredAxisRange(EnvT *e, string axis, -+ DDouble &start, DDouble &end); -+ //set the axis 'axis' charsize (including MULTI subscaling) -+ void gdlSetAxisCharsize(EnvT *e, GDLGStream *a, string axis); -+ void gdlStoreAxisType(string axis, bool type); -+ -+ //length and height of a char in normalized coords, using trick -+ void gdlGetCharSizes(GDLGStream *a, PLFLT &nsx, PLFLT &nsy, DDouble &wsx, DDouble &wsy, DDouble &dsx, DDouble &dsy, DDouble &lsx, DDouble &lsy); -+ void GetSFromPlotStructs(DDouble **sx, DDouble **sy, DDouble **sz=NULL); - void GetWFromPlotStructs(DFloat **wx, DFloat **wy); -- void getWorldCoordinatesFromPLPLOT(GDLGStream *a, DDouble nx, DDouble ny, DDouble *wx, DDouble *wy); -+ bool startClipping(EnvT *e, GDLGStream *a, bool UsePClip); -+ void stopClipping(GDLGStream *a); -+ void gdlStoreCLIP(DLongGDL* clipBox); - void DataCoordLimits(DDouble *sx, DDouble *sy, DFloat *wx, DFloat *wy, - DDouble *xStart, DDouble *xEnd, DDouble *yStart, DDouble *yEnd, bool); - -- PLFLT AutoIntvAC(DDouble &val_min, DDouble &val_max, DLong NoZero, bool log = false); -+ PLFLT AutoIntvAC(DDouble &val_min, DDouble &val_max, bool log = false); - PLFLT AutoTick(DDouble x); -+ PLFLT gdlComputeTickInterval(EnvT *e, string axis, DDouble &min, DDouble &max, bool log); -+ bool gdlYaxisNoZero(EnvT* e); - void AdjustAxisOpts(string& xOpt, string& yOpt, - DLong xStyle, DLong yStyle, DLong xTicks, DLong yTicks, - string& xTickformat, string& yTickformat, DLong xLog, DLong yLog); -- bool SetVP_WC( EnvT* e, GDLGStream* actStream, DFloatGDL* pos, DDoubleGDL* clippingD, bool xLog, bool yLog, -- DFloat xMarginL, DFloat xMarginR, DFloat yMarginB, DFloat yMarginT, // input/output -+ bool gdlSetViewPortAndWorldCoordinates( EnvT* e, GDLGStream* actStream, DFloatGDL* boxPosition, bool xLog, bool yLog, -+ DFloat xMarginL, DFloat xMarginR, DFloat yMarginB, DFloat yMarginT, - DDouble xStart, DDouble xEnd, DDouble minVal, DDouble maxVal, DLong iso); -+; - void GetMinMaxVal( DDoubleGDL* val, double* minVal, double* maxVal); - void GetAxisData( DStructGDL* xStruct, - DLong& style, DString& title, DFloat& charSize, -@@ -168,13 +307,14 @@ - DLong& p_linestyle, - DFloat& p_symsize, DFloat& p_charsize, DFloat& p_thick, - DString& p_title, DString& p_subTitle, DFloat& p_ticklen); -+ void GetPData2 (pstruct& p); - void CheckMargin( EnvT* e, GDLGStream* actStream, - DFloat xMarginL, DFloat xMarginR, DFloat yMarginB, DFloat yMarginT, - PLFLT& xMR, PLFLT& xML, PLFLT& yMB, PLFLT& yMT); -- void Clipping( DDoubleGDL* clippingD, -- DDouble& xStart, DDouble& xEnd, DDouble& minVal, DDouble& maxVal); - void handle_pmulti_position(EnvT *e, GDLGStream *a); - void UpdateSWPlotStructs(GDLGStream* actStream, DDouble xStart, DDouble xEnd, DDouble yStart, DDouble yEnd, bool xLog, bool yLog); -+ bool gdlAxis(EnvT *e, GDLGStream *a, string axis, DDouble Start, DDouble End, bool Log, DLong modifierCode=0, DDouble length=0); -+ bool gdlBox(EnvT *e, GDLGStream *a, DDouble xStart, DDouble xEnd, DDouble yStart, DDouble yEnd, bool xLog, bool yLog); - - } // namespace - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_map_proj.cpp gdl/src/plotting_map_proj.cpp ---- gdl-0.9.3/src/plotting_map_proj.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_map_proj.cpp 2013-02-25 17:04:31.000000000 -0700 -@@ -19,26 +19,27 @@ - #include "plotting.hpp" - #include "math_utl.hpp" - --namespace lib { -+namespace lib -+{ - - using namespace std; - -- -- BaseGDL* map_proj_forward_fun( EnvT* e) -+ BaseGDL* map_proj_forward_fun(EnvT* e) - { - #ifdef USE_LIBPROJ4 - // lonlat -> xy - - SizeT nParam=e->NParam(); -- if( nParam < 1) -- e->Throw( "Incorrect number of arguments."); -+ if ( nParam<1 ) -+ e->Throw("Incorrect number of arguments."); - - LPTYPE idata; - XYTYPE odata; - -- ref = map_init(); -- if ( ref == NULL) { -- e->Throw( "Projection initialization failed."); -+ ref=map_init(); -+ if ( ref==NULL ) -+ { -+ e->Throw("Projection initialization failed."); - } - - BaseGDL* p0; -@@ -50,56 +51,67 @@ - DDoubleGDL* res; - DLong dims[2]; - -- if ( nParam == 1) { -- p0 = e->GetParDefined( 0); -- DDoubleGDL* ll = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- -- dims[0] = 2; -- if (p0->Rank() == 1) { -- dimension dim((DLong *) dims, 1); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } else { -- dims[1] = p0->Dim(1); -- dimension dim((DLong *) dims, 2); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } -- -- SizeT nEl = p0->N_Elements(); -- for( SizeT i=0; iGetParDefined(0); -+ DDoubleGDL* ll=static_cast -+ (p0->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -+ -+ dims[0]=2; -+ if ( p0->Rank()==1 ) -+ { -+ dimension dim((DLong *)dims, 1); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ else -+ { -+ dims[1]=p0->Dim(1); -+ dimension dim((DLong *)dims, 2); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ -+ SizeT nEl=p0->N_Elements(); -+ for ( SizeT i=0; iGetParDefined( 0); -- p1 = e->GetParDefined( 1); -- DDoubleGDL* lon = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- DDoubleGDL* lat = static_cast -- (p1->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- -- dims[0] = 2; -- if (p0->Rank() == 0 || p0->Rank() == 1) { -- dimension dim((DLong *) dims, 1); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } else { -- dims[1] = p0->Dim(0); -- dimension dim((DLong *) dims, 2); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } -- -- SizeT nEl = p0->N_Elements(); -- for( SizeT i=0; iGetParDefined(0); -+ p1=e->GetParDefined(1); -+ DDoubleGDL* lon=static_cast -+ (p0->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -+ DDoubleGDL* lat=static_cast -+ (p1->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -+ -+ dims[0]=2; -+ if ( p0->Rank()==0||p0->Rank()==1 ) -+ { -+ dimension dim((DLong *)dims, 1); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ else -+ { -+ dims[1]=p0->Dim(0); -+ dimension dim((DLong *)dims, 2); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ -+ SizeT nEl=p0->N_Elements(); -+ for ( SizeT i=0; i lonlat - SizeT nParam=e->NParam(); -- if( nParam < 1) -- e->Throw( "Incorrect number of arguments."); -+ if ( nParam<1 ) -+ e->Throw("Incorrect number of arguments."); - - XYTYPE idata; - LPTYPE odata; - -- ref = map_init(); -- if ( ref == NULL) { -- e->Throw( "Projection initialization failed."); -+ ref=map_init(); -+ if ( ref==NULL ) -+ { -+ e->Throw("Projection initialization failed."); - } - - BaseGDL* p0; -@@ -135,56 +147,67 @@ - DDoubleGDL* res; - DLong dims[2]; - -- if ( nParam == 1) { -- p0 = e->GetParDefined( 0); -- DDoubleGDL* xy = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- -- dims[0] = 2; -- if (p0->Rank() == 1) { -- dimension dim((DLong *) dims, 1); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } else { -- dims[1] = p0->Dim(1); -- dimension dim((DLong *) dims, 2); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } -- -- SizeT nEl = p0->N_Elements(); -- for( SizeT i=0; iGetParDefined(0); -+ DDoubleGDL* xy=static_cast -+ (p0->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -+ -+ dims[0]=2; -+ if ( p0->Rank()==1 ) -+ { -+ dimension dim((DLong *)dims, 1); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ else -+ { -+ dims[1]=p0->Dim(1); -+ dimension dim((DLong *)dims, 2); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ -+ SizeT nEl=p0->N_Elements(); -+ for ( SizeT i=0; iGetParDefined( 0); -- p1 = e->GetParDefined( 1); -- DDoubleGDL* x = static_cast -- (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- DDoubleGDL* y = static_cast -- (p1->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- -- dims[0] = 2; -- if (p0->Rank() == 0 || p0->Rank() == 1) { -- dimension dim((DLong *) dims, 1); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } else { -- dims[1] = p0->Dim(0); -- dimension dim((DLong *) dims, 2); -- res = new DDoubleGDL( dim, BaseGDL::NOZERO); -- } -- -- SizeT nEl = p0->N_Elements(); -- for( SizeT i=0; iGetParDefined(0); -+ p1=e->GetParDefined(1); -+ DDoubleGDL* x=static_cast -+ (p0->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -+ DDoubleGDL* y=static_cast -+ (p1->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -+ -+ dims[0]=2; -+ if ( p0->Rank()==0||p0->Rank()==1 ) -+ { -+ dimension dim((DLong *)dims, 1); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ else -+ { -+ dims[1]=p0->Dim(0); -+ dimension dim((DLong *)dims, 2); -+ res=new DDoubleGDL(dim, BaseGDL::NOZERO); -+ } -+ -+ SizeT nEl=p0->N_Elements(); -+ for ( SizeT i=0; iNParam(); -- if( nParam < 1) -- e->Throw( "Incorrect number of arguments."); -+ if ( nParam<1 ) -+ e->Throw("Incorrect number of arguments."); - DString device; -- e->AssureScalarPar( 0, device); -+ e->AssureScalarPar(0, device); - - // this is the device name -- device = StrUpCase( device); -- -- bool success = Graphics::SetDevice( device); -- if( !success) -- e->Throw( "Device not supported/unknown: "+device); -+ device=StrUpCase(device); - -- if (device == "PS" || device == "SVG") { -- static DStructGDL* pStruct = SysVar::P(); -+ bool success=Graphics::SetDevice(device); -+ if ( !success ) -+ e->Throw("Device not supported/unknown: "+device); -+ -+ if ( device=="PS"/*||device=="SVG"*/ ) -+ { -+ static DStructGDL* pStruct=SysVar::P(); - // SA: this does not comply with IDL behaviour, see testsuite/test_pmulti.pro - //static unsigned noEraseTag = pStruct->Desc()->TagIndex( "NOERASE"); - //(*static_cast( pStruct->GetTag( noEraseTag, 0)))[0] = 1; -- if (device == "PS") { -- static unsigned colorTag = pStruct->Desc()->TagIndex( "COLOR"); -- (*static_cast( pStruct->GetTag( colorTag, 0)))[0] = 0; -- } -- } else { -- static DStructGDL* pStruct = SysVar::P(); -- static unsigned colorTag = pStruct->Desc()->TagIndex( "COLOR"); -- (*static_cast( pStruct->GetTag( colorTag, 0)))[0] = 255; -+ if ( device=="PS" ) -+ { -+ static unsigned colorTag=pStruct->Desc()->TagIndex("COLOR"); -+ (*static_cast(pStruct->GetTag(colorTag, 0)))[0]=255; //PLEASE DO NOT CHANGE values here until a better color -+ // handling has been found. -+ static unsigned bckTag=pStruct->Desc()->TagIndex("BACKGROUND"); -+ (*static_cast(pStruct->GetTag(bckTag, 0)))[0]=0; //PLEASE DO NOT CHANGE values here. This default is OK. -+ } -+ } -+ else -+ { -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned colorTag=pStruct->Desc()->TagIndex("COLOR"); -+ (*static_cast(pStruct->GetTag(colorTag, 0)))[0]=16777215; -+ static unsigned bckTag=pStruct->Desc()->TagIndex("BACKGROUND"); -+ (*static_cast(pStruct->GetTag(bckTag, 0)))[0]=0; - } - } - -- void tvlct( EnvT* e) -+ void tvlct(EnvT* e) - { -- int nParam = e->NParam( 1); //, "TVLCT"); -+ int nParam=e->NParam(1); //, "TVLCT"); -+ -+ static int getKW=e->KeywordIx("GET"); -+ bool get=e->KeywordSet(getKW); -+ static int hlsKW=e->KeywordIx("HLS"); -+ bool hls=e->KeywordSet(hlsKW); -+ static int hsvKW=e->KeywordIx("HSV"); -+ bool hsv=e->KeywordSet(hsvKW); -+ -+ DLong start=0; -+ GDLCT* actCT=Graphics::GetCT(); -+ if ( nParam<=2 ) // TVLCT,I[,Start] -+ { -+ if ( nParam==2 ) -+ e->AssureLongScalarPar(1, start); -+ if ( start<0 ) start=0; -+ -+ if ( get ) // always RGB -+ { -+ BaseGDL*& p0=e->GetParGlobal(0); -+ -+ SizeT nCol=ctSize-start; -+ -+ DByteGDL* rgb=new DByteGDL(dimension(nCol, 3), BaseGDL::NOZERO); -+ -+ for ( SizeT i=start, ii=0; iGet(i, (*rgb)[ ii], (*rgb)[ ii+nCol], (*rgb)[ ii+2*nCol]); - -- static int getKW = e->KeywordIx( "GET"); -- bool get = e->KeywordSet( getKW); -- static int hlsKW = e->KeywordIx( "HLS"); -- bool hls = e->KeywordSet( hlsKW); -- static int hsvKW = e->KeywordIx( "HSV"); -- bool hsv = e->KeywordSet( hsvKW); -- -- DLong start = 0; -- GDLCT* actCT = Graphics::GetCT(); -- if( nParam <= 2) // TVLCT,I[,Start] -- { -- if( nParam == 2) -- e->AssureLongScalarPar( 1, start); -- if( start < 0) start = 0; -- -- if( get) // always RGB -- { -- BaseGDL*& p0 = e->GetParGlobal( 0); -- -- SizeT nCol = ctSize - start; -- -- DByteGDL* rgb = new DByteGDL( dimension( nCol, 3), BaseGDL::NOZERO); -- -- for( SizeT i=start,ii=0; iGet( i, (*rgb)[ ii], (*rgb)[ ii+nCol], (*rgb)[ ii+2*nCol]); -- -- GDLDelete(p0); -- p0 = rgb; -- } -- else -- { -- if( hls || hsv) -- { -- DFloatGDL* rgb = e->GetParAs< DFloatGDL>( 0); -- if( rgb->Dim( 1) != 3) -- e->Throw( "Array must have dimensions of (1, 3): "+ -- e->GetParString( 0)); -- -- SizeT nCol = rgb->Dim( 0); -- SizeT setCol = nCol + start; -- if( setCol > ctSize) setCol = ctSize; -- -- if( hls) -- for( SizeT i=start, ii=0; iSetHLS( i, -- (*rgb)[ ii], -- (*rgb)[ ii+nCol], -- (*rgb)[ ii+2*nCol]); -- else -- for( SizeT i=start, ii=0; iSetHSV( i, -- (*rgb)[ ii], -- (*rgb)[ ii+nCol], -- (*rgb)[ ii+2*nCol]); -- } -- else -- { -- DByteGDL* rgb = e->GetParAs< DByteGDL>( 0); -- if( rgb->Dim( 1) != 3) -- e->Throw( "Array must have dimensions of (1, 3): "+ -- e->GetParString( 0)); -- -- SizeT nCol = rgb->Dim( 0); -- SizeT setCol = nCol + start; -- if( setCol > ctSize) setCol = ctSize; -- -- for( SizeT i=start, ii=0; iSet( i, -- (*rgb)[ ii], -- (*rgb)[ ii+nCol], -- (*rgb)[ ii+2*nCol]); -- } -- } -+ GDLDelete(p0); -+ p0=rgb; - } -+ else -+ { -+ if ( hls||hsv ) -+ { -+ DFloatGDL* rgb=e->GetParAs< DFloatGDL>(0); -+ if ( rgb->Dim(1)!=3 ) -+ e->Throw("Array must have dimensions of (1, 3): "+ -+ e->GetParString(0)); -+ -+ SizeT nCol=rgb->Dim(0); -+ SizeT setCol=nCol+start; -+ if ( setCol>ctSize ) setCol=ctSize; -+ -+ if ( hls ) -+ for ( SizeT i=start, ii=0; iSetHLS(i, -+ (*rgb)[ ii], -+ (*rgb)[ ii+nCol], -+ (*rgb)[ ii+2*nCol]); -+ else -+ for ( SizeT i=start, ii=0; iSetHSV(i, -+ (*rgb)[ ii], -+ (*rgb)[ ii+nCol], -+ (*rgb)[ ii+2*nCol]); -+ } -+ else -+ { -+ DByteGDL* rgb=e->GetParAs< DByteGDL>(0); -+ if ( rgb->Dim(1)!=3 ) -+ e->Throw("Array must have dimensions of (1, 3): "+ -+ e->GetParString(0)); -+ -+ SizeT nCol=rgb->Dim(0); -+ SizeT setCol=nCol+start; -+ if ( setCol>ctSize ) setCol=ctSize; -+ -+ for ( SizeT i=start, ii=0; iSet(i, -+ (*rgb)[ ii], -+ (*rgb)[ ii+nCol], -+ (*rgb)[ ii+2*nCol]); -+ } -+ } -+ } - else // TVLCT,I1,I2,I3[,Start] -+ { -+ if ( nParam==4 ) -+ e->AssureLongScalarPar(3, start); -+ if ( start<0 ) start=0; -+ -+ if ( get ) // always RGB - { -- if( nParam == 4) -- e->AssureLongScalarPar( 3, start); -- if( start < 0) start = 0; -- -- if( get) // always RGB -- { -- BaseGDL*& p0 = e->GetParGlobal( 0); -- BaseGDL*& p1 = e->GetParGlobal( 1); -- BaseGDL*& p2 = e->GetParGlobal( 2); -- -- SizeT nCol = ctSize - start; -- -- DByteGDL* r = new DByteGDL( dimension( nCol), BaseGDL::NOZERO); -- DByteGDL* g = new DByteGDL( dimension( nCol), BaseGDL::NOZERO); -- DByteGDL* b = new DByteGDL( dimension( nCol), BaseGDL::NOZERO); -- -- for( SizeT i=start,ii=0; iGet( i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -- -- GDLDelete(p0); p0 = r; -- GDLDelete(p1); p1 = g; -- GDLDelete(p2); p2 = b; -- } -- else -- { -- if( hls || hsv) -- { -- DFloatGDL* r = e->GetParAs< DFloatGDL>( 0); -- DFloatGDL* g = e->GetParAs< DFloatGDL>( 1); -- DFloatGDL* b = e->GetParAs< DFloatGDL>( 2); -- SizeT rCol = r->N_Elements(); -- SizeT gCol = g->N_Elements(); -- SizeT bCol = b->N_Elements(); -- SizeT nCol = rCol; -- if( gCol < nCol) nCol = gCol; -- if( bCol < nCol) nCol = bCol; -- -- SizeT setCol = nCol + start; -- if( setCol > ctSize) setCol = ctSize; -- -- if( hls) -- for( SizeT i=start, ii=0; iSetHLS( i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -- else -- for( SizeT i=start, ii=0; iSetHSV( i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -- } -- else -- { -- DByteGDL* r = e->GetParAs< DByteGDL>( 0); -- DByteGDL* g = e->GetParAs< DByteGDL>( 1); -- DByteGDL* b = e->GetParAs< DByteGDL>( 2); -- SizeT rCol = r->N_Elements(); -- SizeT gCol = g->N_Elements(); -- SizeT bCol = b->N_Elements(); -- SizeT nCol = rCol; -- if( gCol < nCol) nCol = gCol; -- if( bCol < nCol) nCol = bCol; -- -- SizeT setCol = nCol + start; -- if( setCol > ctSize) setCol = ctSize; -- -- for( SizeT i=start, ii=0; iSet( i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -- } -- } -+ BaseGDL*& p0=e->GetParGlobal(0); -+ BaseGDL*& p1=e->GetParGlobal(1); -+ BaseGDL*& p2=e->GetParGlobal(2); -+ -+ SizeT nCol=ctSize-start; -+ -+ DByteGDL* r=new DByteGDL(dimension(nCol), BaseGDL::NOZERO); -+ DByteGDL* g=new DByteGDL(dimension(nCol), BaseGDL::NOZERO); -+ DByteGDL* b=new DByteGDL(dimension(nCol), BaseGDL::NOZERO); -+ -+ for ( SizeT i=start, ii=0; iGet(i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -+ -+ GDLDelete(p0); -+ p0=r; -+ GDLDelete(p1); -+ p1=g; -+ GDLDelete(p2); -+ p2=b; - } -+ else -+ { -+ if ( hls||hsv ) -+ { -+ DFloatGDL* r=e->GetParAs< DFloatGDL>(0); -+ DFloatGDL* g=e->GetParAs< DFloatGDL>(1); -+ DFloatGDL* b=e->GetParAs< DFloatGDL>(2); -+ SizeT rCol=r->N_Elements(); -+ SizeT gCol=g->N_Elements(); -+ SizeT bCol=b->N_Elements(); -+ SizeT nCol=rCol; -+ if ( gColctSize ) setCol=ctSize; -+ -+ if ( hls ) -+ for ( SizeT i=start, ii=0; iSetHLS(i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -+ else -+ for ( SizeT i=start, ii=0; iSetHSV(i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -+ } -+ else -+ { -+ DByteGDL* r=e->GetParAs< DByteGDL>(0); -+ DByteGDL* g=e->GetParAs< DByteGDL>(1); -+ DByteGDL* b=e->GetParAs< DByteGDL>(2); -+ SizeT rCol=r->N_Elements(); -+ SizeT gCol=g->N_Elements(); -+ SizeT bCol=b->N_Elements(); -+ SizeT nCol=rCol; -+ if ( gColctSize ) setCol=ctSize; -+ -+ for ( SizeT i=start, ii=0; iSet(i, (*r)[ ii], (*g)[ ii], (*b)[ ii]); -+ } -+ } -+ } - - // AC, 07/02/2012, please report any unexpected side effect (see test_tvlct.pro) -- if (~get) { -- GDLGStream* actStream = Graphics::GetDevice()->GetStream(false); -- if (actStream != NULL) { -- PLINT red[ctSize], green[ctSize], blue[ctSize]; -- actCT->Get( red, green, blue); -- actStream->scmap1( red, green, blue, ctSize); -+ if ( ~get ) -+ { -+ GDLGStream* actStream=Graphics::GetDevice()->GetStream(false); -+ if ( actStream!=NULL ) -+ { -+ PLINT red[ctSize], green[ctSize], blue[ctSize]; -+ actCT->Get(red, green, blue); -+ actStream->scmap1(red, green, blue, ctSize); - } - } - } -- -+ - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_oplot.cpp gdl/src/plotting_oplot.cpp ---- gdl-0.9.3/src/plotting_oplot.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_oplot.cpp 2013-07-08 12:39:22.344387803 -0600 -@@ -24,23 +24,31 @@ - - class oplot_call : public plotting_routine_call - { -- DDoubleGDL *yVal, *xVal, *xTemp, *yTemp; -- SizeT xEl, yEl; -- auto_ptr xval_guard,yval_guard,xtempval_guard; -+ DDoubleGDL *yVal, *xVal, *zVal, *xTemp, *yTemp; -+ SizeT xEl, yEl, zEl; -+ Guard xval_guard,yval_guard, zval_guard, xtempval_guard; -+ bool doT3d; -+ DDouble zValue; - - private: bool handle_args( EnvT* e) // {{{ - { -+ //T3D? -+ static int t3dIx = e->KeywordIx( "T3D"); -+ doT3d=(e->KeywordSet(t3dIx)|| T3Denabled(e)); -+ -+ //note: Z (VALUE) will be used uniquely if Z is not effectively defined. -+ zValue=0.0; -+ static int zvIx = e->KeywordIx( "ZVALUE"); -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ - bool polar=FALSE; - DLong nsum=1; - e->AssureLongScalarKWIfPresent( "NSUM", nsum); - if ( e->KeywordSet( "POLAR")) - { - polar=TRUE; -- // e->Throw( "Sorry, POLAR keyword not ready"); - } - -- DDoubleGDL *yValBis, *xValBis; -- auto_ptr xvalBis_guard, yvalBis_guard; - //test and transform eventually if POLAR and/or NSUM! - if( nParam() == 1) - { -@@ -50,7 +58,7 @@ - yEl=yTemp->N_Elements(); - xEl=yEl; - xTemp = new DDoubleGDL( dimension( xEl), BaseGDL::INDGEN); -- xtempval_guard.reset( xTemp); // delete upon exit -+ xtempval_guard.Reset( xTemp); // delete upon exit - } - else - { -@@ -80,15 +88,15 @@ - if (polar) - { - xVal = new DDoubleGDL(dimension(xEl), BaseGDL::NOZERO); -- xval_guard.reset(xVal); // delete upon exit -+ xval_guard.Reset(xVal); // delete upon exit - yVal = new DDoubleGDL(dimension(yEl), BaseGDL::NOZERO); -- yval_guard.reset(yVal); // delete upon exit -+ yval_guard.Reset(yVal); // delete upon exit - for (int i = 0; i < xEl; i++) (*xVal)[i] = (*xTemp)[i] * cos((*yTemp)[i]); - for (int i = 0; i < yEl; i++) (*yVal)[i] = (*xTemp)[i] * sin((*yTemp)[i]); - } - else - { //careful about previously set autopointers! -- if (nParam() == 1) xval_guard = xtempval_guard; -+ if (nParam() == 1) xval_guard.Init( xtempval_guard.release()); - xVal = xTemp; - yVal = yTemp; - } -@@ -98,9 +106,9 @@ - int i, j, k; - DLong size = xEl / nsum; - xVal = new DDoubleGDL(size, BaseGDL::ZERO); //SHOULD BE ZERO, IS NOT! -- xval_guard.reset(xVal); // delete upon exit -+ xval_guard.Reset(xVal); // delete upon exit - yVal = new DDoubleGDL(size, BaseGDL::ZERO); //IDEM -- yval_guard.reset(yVal); // delete upon exit -+ yval_guard.Reset(yVal); // delete upon exit - for (i = 0, k = 0; i < size; i++) - { - (*xVal)[i] = 0.0; -@@ -126,25 +134,32 @@ - } - } - } -+ if (doT3d) -+ { -+ //make zVal -+ zEl=xVal->N_Elements(); -+ zVal=new DDoubleGDL(dimension(zEl), BaseGDL::NOZERO); -+ zval_guard.Reset(zVal); // delete upon exit -+ for (SizeT i=0; i< zEl ; ++i) (*zVal)[i]=zValue; -+ } -+ return 0; - } - -- private: void old_body( EnvT* e, GDLGStream* actStream) // {{{ -+ private: void old_body( EnvT* e, GDLGStream* actStream) - { -- bool valid; -- valid=true; - DLong psym; - - // get ![XY].CRANGE - DDouble xStart, xEnd, yStart, yEnd; -- get_axis_crange("X", xStart, xEnd); -- get_axis_crange("Y", yStart, yEnd); -+ gdlGetCurrentAxisRange("X", xStart, xEnd); -+ gdlGetCurrentAxisRange("Y", yStart, yEnd); - DDouble minVal, maxVal; - bool doMinMax; - - bool xLog; - bool yLog; -- get_axis_type("X", xLog); -- get_axis_type("Y", yLog); -+ gdlGetAxisType("X", xLog); -+ gdlGetAxisType("Y", yLog); - - if ((yStart == yEnd) || (xStart == xEnd)) - { -@@ -157,9 +172,6 @@ - Message("OPLOT: !X.CRANGE ERROR, setting to [0,1]"); - xStart = 0; //xVal->min(); - xEnd = 1; //xVal->max(); -- -- set_axis_crange("X", xStart, xEnd, xLog); -- set_axis_crange("Y", yStart, yEnd, yLog); - } - - //now we can setup minVal and maxVal to defaults: Start-End and overload if KW present -@@ -172,45 +184,104 @@ - e->AssureDoubleScalarKWIfPresent( "MIN_VALUE", minVal); - e->AssureDoubleScalarKWIfPresent( "MAX_VALUE", maxVal); - -- // CLIPPING -- DDoubleGDL* clippingD=NULL; -- DLong noclip=0; -- e->AssureLongScalarKWIfPresent( "NOCLIP", noclip); -- if(noclip == 0) -+ int noclipvalue=0; -+ e->AssureLongScalarKWIfPresent( "NOCLIP", noclipvalue); -+ // Clipping is enabled by default for OPLOT. -+ // make all clipping computations BEFORE setting graphic properties (color, size) -+ bool doClip=(e->KeywordSet("CLIP")||noclipvalue==1); -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, false)==TRUE ) stopClip=true; -+ -+ // start drawing. Graphic Keywords accepted:CLIP(YES), COLOR(YES), LINESTYLE(YES), NOCLIP(YES), -+ // PSYM(YES), SYMSIZE(YES), T3D(YES), ZVALUE(YES) -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); -+ gdlGetPsym(e, psym); -+ gdlSetPenThickness(e, actStream); -+ gdlSetSymsize(e, actStream); -+ gdlSetLineStyle(e, actStream); -+ -+ static DDouble x0,y0,xs,ys; //conversion to normalized coords -+ x0=(xLog)?-log10(xStart):-xStart; -+ y0=(yLog)?-log10(yStart):-yStart; -+ xs=(xLog)?(log10(xEnd)-log10(xStart)):xEnd-xStart;xs=1.0/xs; -+ ys=(yLog)?(log10(yEnd)-log10(yStart)):yEnd-yStart;ys=1.0/ys; -+ -+ if ( doT3d ) //convert X,Y,Z in X',Y' as per T3D perspective. -+ { -+ DDoubleGDL* plplot3d; -+ DDouble az, alt, ay, scale; -+ ORIENTATION3D axisExchangeCode; -+ -+ plplot3d = gdlConvertT3DMatrixToPlplotRotationMatrix( zValue, az, alt, ay, scale, axisExchangeCode); -+ if (plplot3d == NULL) - { -- static int clippingix = e->KeywordIx( "CLIP"); -- clippingD = e->IfDefGetKWAs( clippingix); -+ e->Throw("Illegal 3D transformation. (FIXME)"); - } -- -- // start drawing. Graphic Keywords accepted:CLIP(NO), COLOR(YES), LINESTYLE(YES), NOCLIP(YES), -- // PSYM(YES), SYMSIZE(YES), T3D(NO), ZVALUE(NO) -- gkw_background(e, actStream, false); -- gkw_color(e, actStream); -- // gkw_noerase(e, actStream, true); -- gkw_psym(e, psym); -- DFloat charsize; -- gkw_charsize(e,actStream, charsize, false); //set !P.CHARSIZE -- gkw_thick(e, actStream); -- gkw_symsize(e, actStream); -- gkw_linestyle(e, actStream); -- -- // plot the data -- if(valid) //invalid is not yet possible. Could be done by a severe clipping for example. -- valid=draw_polyline(e, actStream, -- xVal, yVal, minVal, maxVal, doMinMax, xLog, yLog, -- psym, FALSE); -+ Data3d.zValue = zValue; -+ Data3d.Matrix = plplot3d; //try to change for !P.T in future? -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code012; -+ break; -+ case XY: // X->Y Y->X plane XY -+ Data3d.x0=0; -+ Data3d.y0=x0; -+ Data3d.xs=ys; -+ Data3d.ys=xs; -+ Data3d.code = code102; -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code210; -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code021; -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code120; -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code201; -+ break; -+ } - -+ actStream->stransform(gdl3dTo2dTransform, &Data3d); -+ } - -- actStream->lsty(1);//reset linestyle -- } // }}} -+ // TODO: handle "valid"! -+ bool valid=draw_polyline(e, actStream, xVal, yVal, minVal, maxVal, doMinMax, xLog, yLog, psym, FALSE); -+ if (stopClip) stopClipping(actStream); -+ } - -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -+ private: void call_plplot(EnvT* e, GDLGStream* actStream) - { -- } // }}} -+ } - -- private: void post_call(EnvT* e, GDLGStream* actStream) // {{{ -+ private: void post_call(EnvT* e, GDLGStream* actStream) - { -- } // }}} -+ if (doT3d) actStream->stransform(NULL,NULL); -+ actStream->lsty(1);//reset linestyle -+ actStream->sizeChar(1.0); -+ } - - }; // oplot_call class - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_plot.cpp gdl/src/plotting_plot.cpp ---- gdl-0.9.3/src/plotting_plot.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_plot.cpp 2013-07-31 09:41:44.181244855 -0600 -@@ -25,32 +25,45 @@ - namespace lib { - - using namespace std; -+// using std::isinf; -+ using std::isnan; - - class plot_call : public plotting_routine_call - { -- DDoubleGDL *yVal, *xVal, *xTemp, *yTemp; -- SizeT xEl, yEl; -- DDouble minVal, maxVal, xStart, xEnd, yStart, yEnd; -+ DDoubleGDL *yVal, *xVal, *zVal, *xTemp, *yTemp; -+ SizeT xEl, yEl, zEl; -+ DDouble minVal, maxVal, xStart, xEnd, yStart, yEnd, -+ zValue; - bool doMinMax; - bool xLog, yLog, wasBadxLog, wasBadyLog; -- DLong psym; -- auto_ptr xval_guard,yval_guard,xtemp_guard; -+ Guard xval_guard, yval_guard, zval_guard, xtemp_guard; -+ DLong iso; -+ bool doT3d; - - private: - -- bool handle_args(EnvT* e) // {{{ -+ bool handle_args(EnvT* e) - { -- bool polar = FALSE; -- DLong nsum = 1; -+ -+ //T3D ? -+ static int t3dIx = e->KeywordIx( "T3D"); -+ doT3d=(e->KeywordSet(t3dIx)|| T3Denabled(e)); -+ -+ //note: Z (VALUE) will be used uniquely if Z is not effectively defined. -+ static int zvIx = e->KeywordIx( "ZVALUE"); -+ zValue=0.0; -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ zValue=min(zValue,0.999999); //to avoid problems with plplot -+ zValue=max(zValue,0.0); -+ -+ // system variable !P.NSUM first -+ DLong nsum=(*static_cast(SysVar::P()-> GetTag(SysVar::P()->Desc()->TagIndex("NSUM"), 0)))[0]; - e->AssureLongScalarKWIfPresent("NSUM", nsum); -- if (e->KeywordSet("POLAR")) -- { -- polar = TRUE; -- // e->Throw( "Sorry, POLAR keyword not ready"); -- } -+ -+ bool polar = (e->KeywordSet("POLAR")); - - DDoubleGDL *yValBis, *xValBis; -- auto_ptr xvalBis_guard, yvalBis_guard; -+ Guard xvalBis_guard, yvalBis_guard; - //test and transform eventually if POLAR and/or NSUM! - if (nParam() == 1) - { -@@ -60,7 +73,7 @@ - yEl=yTemp->N_Elements(); - xEl=yEl; - xTemp = new DDoubleGDL(dimension(xEl), BaseGDL::INDGEN); -- xtemp_guard.reset(xTemp); // delete upon exit -+ xtemp_guard.Reset(xTemp); // delete upon exit - } - else - { -@@ -90,15 +103,15 @@ - if (polar) - { - xVal = new DDoubleGDL(dimension(xEl), BaseGDL::NOZERO); -- xval_guard.reset(xVal); // delete upon exit -+ xval_guard.Reset(xVal); // delete upon exit - yVal = new DDoubleGDL(dimension(yEl), BaseGDL::NOZERO); -- yval_guard.reset(yVal); // delete upon exit -+ yval_guard.Reset(yVal); // delete upon exit - for (int i = 0; i < xEl; i++) (*xVal)[i] = (*xTemp)[i] * cos((*yTemp)[i]); - for (int i = 0; i < yEl; i++) (*yVal)[i] = (*xTemp)[i] * sin((*yTemp)[i]); - } - else - { //careful about previously set autopointers! -- if (nParam() == 1) xval_guard = xtemp_guard; -+ if (nParam() == 1) xval_guard.Init( xtemp_guard.release()); - xVal = xTemp; - yVal = yTemp; - } -@@ -108,9 +121,9 @@ - int i, j, k; - DLong size = (DLong)xEl / nsum; - xVal = new DDoubleGDL(size, BaseGDL::ZERO); //SHOULD BE ZERO, IS NOT! -- xval_guard.reset(xVal); // delete upon exit -+ xval_guard.Reset(xVal); // delete upon exit - yVal = new DDoubleGDL(size, BaseGDL::ZERO); //IDEM -- yval_guard.reset(yVal); // delete upon exit -+ yval_guard.Reset(yVal); // delete upon exit - for (i = 0, k = 0; i < size; i++) - { - (*xVal)[i] = 0.0; -@@ -136,9 +149,9 @@ - } - } - } -- // keyword overrides -- static int xLogIx = e->KeywordIx("XLOG"); -- static int yLogIx = e->KeywordIx("YLOG"); -+ // handle Log options -+ int xLogIx = e->KeywordIx("XLOG"); -+ int yLogIx = e->KeywordIx("YLOG"); - xLog = e->KeywordSet(xLogIx); - yLog = e->KeywordSet(yLogIx); - // compute adequate values for log scale, warn adequately... -@@ -150,7 +163,7 @@ - xVal->MinMax(&minEl, &maxEl, NULL, NULL, true); - if ((*xVal)[minEl] <= 0.0) wasBadxLog = TRUE; - xValBis = new DDoubleGDL(dimension(xEl), BaseGDL::NOZERO); -- xvalBis_guard.reset(xValBis); // delete upon exit -+ xvalBis_guard.Reset(xValBis); // delete upon exit - for (int i = 0; i < xEl; i++) (*xValBis)[i] = log10((*xVal)[i]); - } - else xValBis = xVal; -@@ -160,279 +173,326 @@ - yVal->MinMax(&minEl, &maxEl, NULL, NULL, true); - if ((*yVal)[minEl] <= 0.0) wasBadyLog = TRUE; - yValBis = new DDoubleGDL(dimension(yEl), BaseGDL::NOZERO); -- yvalBis_guard.reset(yValBis); // delete upon exit -+ yvalBis_guard.Reset(yValBis); // delete upon exit - for (int i = 0; i < yEl; i++) (*yValBis)[i] = log10((*yVal)[i]); - } - else yValBis = yVal; -- // BaseGDL *x, *y; -- { -- DLong minEl, maxEl, debug=0; - -+#define UNDEF_RANGE_VALUE 1E-12 -+ { -+ DLong minEl, maxEl; - xValBis->MinMax(&minEl, &maxEl, NULL, NULL, true); - xStart = (*xVal)[minEl]; -- if (isnan(xStart)) xStart = 1e-12; -- if (wasBadxLog) xStart = 1e-12; - xEnd = (*xVal)[maxEl]; -+ if (isnan(xStart)) xStart = UNDEF_RANGE_VALUE; - if (isnan(xEnd)) xEnd = 1.0; -- if (wasBadxLog) { -- xStart = 1e-20; -- xEnd = 1.; -- } -- -- if (debug) cout << "X Min/Max : " << xStart << " " << xEnd << endl; -- if (debug) cout << "xLog mode : " << xLog << endl; -+ if (xStart==xEnd) xStart=xEnd-UNDEF_RANGE_VALUE; - - yValBis->MinMax(&minEl, &maxEl, NULL, NULL, true); - yStart = (*yVal)[minEl]; -- if (wasBadyLog) yStart = 1e-12; -- if (isnan(yStart)) yStart = 1e-12; - yEnd = (*yVal)[maxEl]; -+ if (isnan(yStart)) yStart = UNDEF_RANGE_VALUE; - if (isnan(yEnd)) yEnd = 1.0; -- if (wasBadyLog) { -- yStart = 1e-20; -- yEnd = 1.; -+ if (yStart==yEnd) yStart=yEnd-UNDEF_RANGE_VALUE; -+ } -+ //MIN_VALUE and MAX_VALUE overwrite yStart/yEnd eventually (note: the points will not be "seen" at all in plots) -+ minVal = yStart; //to give a reasonable value... -+ maxVal = yEnd; //idem -+ doMinMax = false; //although we will not use it... -+ if( e->KeywordSet( "MIN_VALUE") || e->KeywordSet( "MAX_VALUE")) -+ doMinMax = true; //...unless explicitely required -+ e->AssureDoubleScalarKWIfPresent( "MIN_VALUE", minVal); -+ e->AssureDoubleScalarKWIfPresent( "MAX_VALUE", maxVal); -+ yStart=gdlPlot_Max(yStart,minVal); -+ yEnd=gdlPlot_Min(yEnd,maxVal); -+ //XRANGE and YRANGE overrides all that, but Start/End should be recomputed accordingly -+ DDouble xAxisStart, xAxisEnd, yAxisStart, yAxisEnd; -+ bool setx=gdlGetDesiredAxisRange(e, "X", xAxisStart, xAxisEnd); -+ bool sety=gdlGetDesiredAxisRange(e, "Y", yAxisStart, yAxisEnd); -+ if(setx && sety) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+ } -+ else if (sety) -+ { -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+// wrong behaviour: x axis limits do not depend from Y values -+// //must compute min-max for other axis! -+// { -+// gdlDoRangeExtrema(yVal,xVal,xStart,xEnd,yStart,yEnd); -+// } -+ } -+ else if (setx) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ //must compute min-max for other axis! -+ { -+ gdlDoRangeExtrema(xVal,yVal,yStart,yEnd,xStart,xEnd,doMinMax,minVal,maxVal); - } -+ } -+ //handle Nozero option after all that! -+ if(!gdlYaxisNoZero(e) && yStart >0 && !yLog ) yStart=0.0; -+#undef UNDEF_RANGE_VALUE - -+ //ISOTROPIC -+ iso=0; -+ e->AssureLongScalarKWIfPresent( "ISOTROPIC", iso); - -- if (debug) cout << "Y Min/Max : " << yStart << " " << yEnd << endl; -- if (debug) cout << "yLog mode : " << yLog << endl; -- -+ if (doT3d) -+ { -+ //make zVal -+ zEl=xVal->N_Elements(); -+ zVal=new DDoubleGDL(dimension(zEl), BaseGDL::NOZERO); -+ zval_guard.Reset(zVal); // delete upon exit -+ for (SizeT i=0; i< zEl ; ++i) (*zVal)[i]=zValue; - } -+ - return false; -- } // }}} -+ } - -- private: void old_body( EnvT* e, GDLGStream* actStream) // {{{ -+ private: void old_body( EnvT* e, GDLGStream* actStream) - { -- //ISOTROPIC -- DLong iso=0; -- e->AssureLongScalarKWIfPresent( "ISOTROPIC", iso); -+ // background BEFORE next plot since it is the only place plplot may redraw the background... -+ gdlSetGraphicsBackgroundColorFromKw(e, actStream); -+ //start a plot -+ gdlNextPlotHandlingNoEraseOption(e, actStream); //NOERASE - -- // [XY]STYLE -- DLong xStyle=0, yStyle=0; -- gkw_axis_style(e, "X", xStyle); -- gkw_axis_style(e, "Y", yStyle); -- -- e->AssureLongScalarKWIfPresent( "XSTYLE", xStyle); -- e->AssureLongScalarKWIfPresent( "YSTYLE", yStyle); -- -- // AXIS TITLE -- DString xTitle, yTitle; -- gkw_axis_title(e, "X", xTitle); -- gkw_axis_title(e, "Y", yTitle); - -- // MARGIN -- DFloat xMarginL, xMarginR, yMarginB, yMarginT; -- gkw_axis_margin(e, "X", xMarginL, xMarginR); -- gkw_axis_margin(e, "Y", yMarginB, yMarginT); -- -- DLong xnozero=1, ynozero=0; -- if ( e->KeywordSet( "YNOZERO")) ynozero = 1; -- -- // Please remember the {X|Y}range overwrite the data range -- //[x|y]range keyword -- gkw_axis_range(e, "X", xStart, xEnd, xnozero); -- gkw_axis_range(e, "Y", yStart, yEnd, ynozero); -- -- if ((xLog && xStart <= 0.0) || wasBadxLog) Warning( "PLOT: Infinite x plot range."); -- if ((yLog && yStart <= 0.0) || wasBadyLog) Warning( "PLOT: Infinite y plot range."); -- //xStyle and yStyle apply on range values -+ // [XY]STYLE -+ DLong xStyle=0, yStyle=0; -+ gdlGetDesiredAxisStyle(e, "X", xStyle); -+ gdlGetDesiredAxisStyle(e, "Y", yStyle); - --// // style applies on the final values -+ //xStyle and yStyle apply on range values - if ((xStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(xStart, xEnd, xnozero, xLog); -+ PLFLT intv = AutoIntvAC(xStart, xEnd, xLog); - } - if ((yStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(yStart, yEnd, ynozero, yLog); -+ PLFLT intv = AutoIntvAC(yStart, yEnd, yLog); - } - -- DLong xTicks=0, yTicks=0; -- e->AssureLongScalarKWIfPresent( "XTICKS", xTicks); -- e->AssureLongScalarKWIfPresent( "YTICKS", yTicks); -- -- DLong xMinor=0, yMinor=0; -- e->AssureLongScalarKWIfPresent( "XMINOR", xMinor); -- e->AssureLongScalarKWIfPresent( "YMINOR", yMinor); -- -- DString xTickformat, yTickformat; -- e->AssureStringScalarKWIfPresent( "XTICKFORMAT", xTickformat); -- e->AssureStringScalarKWIfPresent( "YTICKFORMAT", yTickformat); -- -- DDouble ticklen = 0.02; -- e->AssureDoubleScalarKWIfPresent( "TICKLEN", ticklen); -- -- DFloat xTicklen, yTicklen; -- e->AssureFloatScalarKWIfPresent( "XTICKLEN", xTicklen); -- e->AssureFloatScalarKWIfPresent( "YTICKLEN", yTicklen); -- // plsmin (def, scale); -- -- // POSITION -- static int positionIx = e->KeywordIx( "POSITION"); -- DFloatGDL* pos = e->IfDefGetKWAs( positionIx); -- if (pos == NULL) pos = (DFloatGDL*) 0xF; -- -- // *** start drawing. Graphic Keywords accepted: BACKGROUND, CHARSIZE, CHARTHICK, CLIP, COLOR, DATA, DEVICE, FONT, LINESTYLE, NOCLIP, NODATA, NOERASE, NORMAL, POSITION, PSYM, SUBTITLE, SYMSIZE, T3D, THICK, TICKLEN, TITLE, [XYZ]CHARSIZE, [XYZ]GRIDSTYLE, [XYZ]MARGIN(OK), [XYZ]MINOR, [XYZ]RANGE, [XYZ]STYLE, [XYZ]THICK, [XYZ]TICKFORMAT, [XYZ]TICKINTERVAL, [XYZ]TICKLAYOUT, [XYZ]TICKLEN, [XYZ]TICKNAME, [XYZ]TICKS, [XYZ]TICKUNITS, [XYZ]TICKV, [XYZ]TICK_GET, [XYZ]TITLE, ZVALUE -- gkw_background(e, actStream); //BACKGROUND -- gkw_color(e, actStream); //COLOR -- -- gkw_psym(e, psym);//PSYM -- -- DFloat charsize, xCharSize, yCharSize; -- gkw_charsize(e, actStream, charsize); //CHARSIZE -- gkw_axis_charsize(e, "X", xCharSize); //XCHARSIZE -- gkw_axis_charsize(e, "Y", yCharSize); //YCHARSIZE -- -- // Turn off map projection processing -- set_mapset(0); -- -- gkw_noerase(e, actStream); //NOERASE -- -- DLong noErase = 0; -- if( e->KeywordSet( "NOERASE")) noErase = 1; -- if( !noErase) actStream->Clear(); -- -- // Get device name -- DStructGDL* dStruct = SysVar::D(); -- static unsigned nameTag = dStruct->Desc()->TagIndex( "NAME"); -- DString d_name = -- (*static_cast( dStruct->GetTag( nameTag, 0)))[0]; -- // if PS and not noErase (ie, erase) then set !p.noerase=0 -- if ((d_name == "PS" || d_name == "SVG") && !noErase) { -- static DStructGDL* pStruct = SysVar::P(); -- static unsigned noEraseTag = pStruct->Desc()->TagIndex( "NOERASE"); -- (*static_cast( pStruct->GetTag( noEraseTag, 0)))[0] = 0; -- } -- -- // plplot stuff -- // set the charsize (scale factor) -- DDouble charScale = 1.0; -- DLongGDL* pMulti = SysVar::GetPMulti(); -- if( (*pMulti)[1] > 2 || (*pMulti)[2] > 2) charScale = 0.5; -- actStream->schr( 0.0, charsize * charScale); -- -- // get char size in mm (default, actual) -- PLFLT defH, actH; -- actStream->gchr( defH, actH); -- -- // CLIPPING -- DDoubleGDL* clippingD=NULL; -- DLong noclip=0; -- e->AssureLongScalarKWIfPresent( "NOCLIP", noclip); -- if(noclip == 0) -- { -- static int clippingix = e->KeywordIx( "CLIP"); -- clippingD = e->IfDefGetKWAs( clippingix); -- } -- -+ // MARGIN -+ DFloat xMarginL, xMarginR, yMarginB, yMarginT; -+ gdlGetDesiredAxisMargin(e, "X", xMarginL, xMarginR); -+ gdlGetDesiredAxisMargin(e, "Y", yMarginB, yMarginT); -+ - // viewport and world coordinates -- bool okVPWC = SetVP_WC( e, actStream, pos, clippingD, -- xLog, yLog, -- xMarginL, xMarginR, yMarginB, yMarginT, -- xStart, xEnd, yStart, yEnd, iso); -- if( !okVPWC) return; -+ // use POSITION -+ int positionIx = e->KeywordIx( "POSITION"); -+ DFloatGDL* boxPosition = e->IfDefGetKWAs( positionIx); -+ if (boxPosition == NULL) boxPosition = (DFloatGDL*) 0xF; -+ // set the PLOT charsize before setting viewport (margin depend on charsize) -+ gdlSetPlotCharsize(e, actStream); -+ -+ static DDouble x0,y0,xs,ys; //conversion to normalized coords -+ x0=(xLog)?-log10(xStart):-xStart; -+ y0=(yLog)?-log10(yStart):-yStart; -+ xs=(xLog)?(log10(xEnd)-log10(xStart)):xEnd-xStart;xs=1.0/xs; -+ ys=(yLog)?(log10(yEnd)-log10(yStart)):yEnd-yStart;ys=1.0/ys; -+ -+ if (doT3d) -+ { -+ DDoubleGDL* plplot3d; -+ DDouble az, alt, ay, scale; -+ ORIENTATION3D axisExchangeCode; - -+ plplot3d = gdlConvertT3DMatrixToPlplotRotationMatrix( zValue, az, alt, ay, scale, axisExchangeCode); -+ if (plplot3d == NULL) -+ { -+ e->Throw("Illegal 3D transformation. (FIXME)"); -+ } - -- //now we can setup minVal and maxVal to defaults: Start-End and overload if KW present -+ if (gdlSet3DViewPortAndWorldCoordinates(e, actStream, plplot3d, xLog, yLog, -+ xStart, xEnd, yStart, yEnd) == FALSE) return; -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); -+ gdlSetPlotCharthick(e, actStream); -+ -+ DDouble t3xStart, t3xEnd, t3yStart, t3yEnd, t3zStart, t3zEnd; -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ t3xStart=(xLog)?log10(xStart):xStart, -+ t3xEnd=(xLog)?log10(xEnd):xEnd, -+ t3yStart=(yLog)?log10(yStart):yStart, -+ t3yEnd=(yLog)?log10(yEnd):yEnd, -+ t3zStart=0; -+ t3zEnd=1.0; -+ actStream->w3d(scale, scale, scale*(1.0 - zValue), -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "X", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "Y", yStart, yEnd, yLog); -+ break; -+ case XY: // X->Y Y->X plane XY -+ t3yStart=(xLog)?log10(xStart):xStart, -+ t3yEnd=(xLog)?log10(xEnd):xEnd, -+ t3xStart=(yLog)?log10(yStart):yStart, -+ t3xEnd=(yLog)?log10(yEnd):yEnd, -+ t3zStart=0; -+ t3zEnd=1.0; -+ actStream->w3d(scale, scale, scale*(1.0 - zValue), -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Y", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "X", yStart, yEnd, yLog); -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ t3zStart=(xLog)?log10(xStart):xStart, -+ t3zEnd=(xLog)?log10(xEnd):xEnd, -+ t3yStart=(yLog)?log10(yStart):yStart, -+ t3yEnd=(yLog)?log10(yEnd):yEnd, -+ t3xStart=0; -+ t3xEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Z", xStart, xEnd, xLog, 0); -+ gdlAxis3(e, actStream, "Y", yStart, yEnd, yLog); -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ t3xStart=(xLog)?log10(xStart):xStart, -+ t3xEnd=(xLog)?log10(xEnd):xEnd, -+ t3zStart=(yLog)?log10(yStart):yStart, -+ t3zEnd=(yLog)?log10(yEnd):yEnd, -+ t3yStart=0; -+ t3yEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "X", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "Z", yStart, yEnd, yLog,1); -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ t3yStart=(xLog)?log10(xStart):xStart, -+ t3yEnd=(xLog)?log10(xEnd):xEnd, -+ t3zStart=(yLog)?log10(yStart):yStart, -+ t3zEnd=(yLog)?log10(yEnd):yEnd, -+ t3xStart=0; -+ t3xEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Y", xStart, xEnd, xLog); -+ gdlAxis3(e, actStream, "Z", yStart, yEnd, yLog); -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ t3zStart=(xLog)?log10(xStart):xStart, -+ t3zEnd=(xLog)?log10(xEnd):xEnd, -+ t3xStart=(yLog)?log10(yStart):yStart, -+ t3xEnd=(yLog)?log10(yEnd):yEnd, -+ t3yStart=0; -+ t3yEnd=1.0; -+ actStream->w3d(scale, scale, scale, -+ t3xStart,t3xEnd,t3yStart,t3yEnd,t3zStart,t3zEnd, -+ alt, az); -+ gdlAxis3(e, actStream, "Z", xStart, xEnd, xLog,1); -+ gdlAxis3(e, actStream, "X", yStart, yEnd, yLog); -+ break; -+ } -+ // title and sub title -+ gdlWriteTitleAndSubtitle(e, actStream); - -- minVal = yStart; //to give a reasonable value... -- maxVal = yEnd; //idem -- doMinMax = false; //although we will not use it... -- if( e->KeywordSet( "MIN_VALUE") || e->KeywordSet( "MAX_VALUE")) -- doMinMax = true; //...unless explicitely required -- e->AssureDoubleScalarKWIfPresent( "MIN_VALUE", minVal); -- e->AssureDoubleScalarKWIfPresent( "MAX_VALUE", maxVal); -+ //data: will plot using coordinates transform. -+ //TODO: unless PSYM=0 (optimize) - -- //AXES: -- // pen thickness for axis -- actStream->wid( 0); -- -- // axis -- string xOpt="bc", yOpt="bc"; -- AdjustAxisOpts(xOpt, yOpt, xStyle, yStyle, xTicks, yTicks, xTickformat, yTickformat, xLog, yLog); -- -- DLong charthick=0; -- e->AssureLongScalarKWIfPresent("CHARTHICK",charthick); -- actStream->wid(charthick); -- --//X -- // axis titles -- actStream->schr( 0.0, actH/defH * xCharSize); -- actStream->mtex("b",3.5,0.5,0.5,xTitle.c_str()); -- -- DLong xthick=0; -- e->AssureLongScalarKWIfPresent("XTHICK",xthick); -- actStream->wid(xthick); -- // the axis (separate for x and y axis because of charsize) -- PLFLT xintv; -- if (xTicks == 0) { -- xintv = AutoTick(xEnd-xStart); -- } else { -- xintv = (xEnd - xStart) / xTicks; -- // changing "xintv" has no effects in plplot in Log Mode ... -- // http://sourceforge.net/tracker/index.php?func=detail&aid=3095515&group_id=2915&atid=202915 -- if (yLog) Warning("PLOT: XTICKS keyword not active in plplot in Log mode"); -- } -- actStream->box( xOpt.c_str(), xintv, xMinor, "", 0.0, 0); --//Y -- actStream->wid(charthick); -- actStream->schr( 0.0, actH/defH * yCharSize); -- actStream->mtex("l",5.0,0.5,0.5,yTitle.c_str()); -- -- DLong ythick=0; -- e->AssureLongScalarKWIfPresent("YTHICK",ythick); -- actStream->wid(ythick); -- // the axis (separate for x and y axis because of charsize) -- PLFLT yintv; -- if (yTicks == 0) { -- yintv = AutoTick(yEnd-yStart); -- } else { -- yintv = (yEnd - yStart) / yTicks; -- if (yLog) Warning("PLOT: YTICKS keyword not active in plplot in Log mode"); -- } -- -- int debug=0; -- if (debug) cout << xOpt.c_str() << endl; -- if (debug) cout << yOpt.c_str() << endl; -- if (debug) cout << xintv << " "<< yintv<< endl; -- -- actStream->box( "", 0.0, 0, yOpt.c_str(), yintv, yMinor); -- // reset pen thickness -- actStream->wid( 0); -- -- // title and sub title -- gkw_title(e, actStream, actH/defH); -- -- // pen thickness for plot -- gkw_thick(e, actStream); -- gkw_symsize(e, actStream); -- gkw_linestyle(e, actStream); -+ Data3d.zValue = zValue; -+ Data3d.Matrix = plplot3d; //try to change for !P.T in future? -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code012; -+ break; -+ case XY: // X->Y Y->X plane XY -+ Data3d.x0=0; -+ Data3d.y0=x0; -+ Data3d.xs=ys; -+ Data3d.ys=xs; -+ Data3d.code = code102; -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code210; -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code021; -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code120; -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code201; -+ break; -+ } -+ -+ actStream->stransform(gdl3dTo2dTransform, &Data3d); - -- UpdateSWPlotStructs(actStream, xStart, xEnd, yStart, yEnd, xLog, yLog); -+ } else -+ { -+ //fix viewport and coordinates for box -+ if (gdlSetViewPortAndWorldCoordinates(e, actStream, boxPosition, -+ xLog, yLog, -+ xMarginL, xMarginR, yMarginB, yMarginT, -+ xStart, xEnd, yStart, yEnd, iso)==FALSE) return; //no good: should catch an exception to get out of this mess. -+ //current pen color... -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); -+ gdlSetPlotCharthick(e, actStream); - -- } // }}} -+ gdlBox(e, actStream, xStart, xEnd, yStart, yEnd, xLog, yLog); -+ } -+ } - -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -+ private: void call_plplot(EnvT* e, GDLGStream* actStream) - { -+ DLong psym; - // plot the data -- static int nodataIx = e->KeywordIx( "NODATA"); -- if (!e->KeywordSet(nodataIx)) -+ int nodataIx = e->KeywordIx( "NODATA"); -+ if ( !e->KeywordSet(nodataIx) ) - { -- bool valid = draw_polyline(e, actStream, xVal, yVal, minVal, maxVal, doMinMax, xLog, yLog, psym, FALSE); -- // TODO: handle valid? -+ //get psym -+ gdlGetPsym(e, psym); //PSYM -+ //handle clipping -+ bool doClip=(e->KeywordSet("CLIP")||e->KeywordSet("NOCLIP")); -+ // make all clipping computations BEFORE setting graphic properties (color, size) -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, false)==TRUE ) stopClip=true; -+ // here graphic properties -+ gdlSetPenThickness(e, actStream); -+ gdlSetSymsize(e, actStream); -+ gdlSetLineStyle(e, actStream); -+ // TODO: handle "valid"! -+ bool valid=draw_polyline(e, actStream, xVal, yVal, minVal, maxVal, doMinMax, xLog, yLog, psym, FALSE); -+ if (stopClip) stopClipping(actStream); - } -- } // }}} -+ } - -- private: void post_call(EnvT* e, GDLGStream* actStream) // {{{ -+ private: void post_call(EnvT* e, GDLGStream* actStream) - { -+ if (doT3d) actStream->stransform(NULL,NULL); - actStream->lsty(1);//reset linestyle -- -- // set ![XY].CRANGE -- set_axis_crange("X", xStart, xEnd, xLog); -- set_axis_crange("Y", yStart, yEnd, yLog); -- -- //set ![x|y].type -- set_axis_type("X",xLog); -- set_axis_type("Y",yLog); -- } // }}} -+ actStream->sizeChar(1.0); -+ } - - }; - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_plots.cpp gdl/src/plotting_plots.cpp ---- gdl-0.9.3/src/plotting_plots.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_plots.cpp 2013-07-08 12:39:22.346387779 -0600 -@@ -19,269 +19,426 @@ - #include "plotting.hpp" - #include "math_utl.hpp" - --namespace lib { -+namespace lib -+{ - - using namespace std; - -- class plots_call : public plotting_routine_call -+ class plots_call: public plotting_routine_call - { - - DDoubleGDL *xVal, *yVal, *zVal; -- auto_ptr xval_guard, yval_guard; -+ Guard xval_guard, yval_guard, zval_guard; -+ DDouble xStart, xEnd, yStart, yEnd, zStart, zEnd; - DLong psym; -- PLFLT xStart, xEnd, yStart, yEnd, zStart, zEnd; -- PLFLT xMarginL, xMarginR, yMarginB, yMarginT; -- bool xLog, yLog, xLogOrig, yLogOrig; -+ bool xLog, yLog, zLog; - SizeT xEl, yEl, zEl; - bool append; -+ bool doClip; -+ bool restoreClipBox; -+ PLFLT savebox[4]; -+ bool doT3d, real3d; -+ DDouble zValue; -+ DDoubleGDL* plplot3d; -+ Guard plplot3d_guard; -+ DLongGDL *color; - -- private: bool handle_args(EnvT* e) // {{{ -+ private: -+ -+ bool handle_args(EnvT* e) // {{{ - { -+ real3d=false; -+ //T3D -+ static int t3dIx = e->KeywordIx( "T3D"); -+ doT3d=(e->KeywordSet(t3dIx) || T3Denabled(e)); -+ //note: Z (VALUE) will be used uniquely if Z is not effectively defined. -+ // Then Z is useful only if (doT3d). -+ static int zvIx = e->KeywordIx( "Z"); -+ zValue=0.0; -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ - append=e->KeywordSet("CONTINUE"); -- if( nParam() == 1) -+ if ( nParam()==1 ) - { - BaseGDL* p0; -- p0 = e->GetParDefined( 0); -- if (p0->Dim(0) != 2) -- e->Throw( "When only 1 param, dims must be (2,n)"); -- -- if (e->KeywordSet("T3D")) e->Throw("Only 3-argument case supported for T3D - FIXME!"); -- // TODO: the (3,n) case -- -- DDoubleGDL *val = e->GetParAs< DDoubleGDL>( 0); -+ p0=e->GetParDefined(0); -+ SizeT dim0=p0->Dim(0); -+ if ( dim0<2 || dim0>3 ) -+ e->Throw("When only 1 param, dims must be (2,n) or (3,n)"); -+ -+ DDoubleGDL *val=e->GetParAs< DDoubleGDL>(0); -+ xEl=p0->N_Elements()/dim0; -+ xVal=new DDoubleGDL(dimension(xEl), BaseGDL::NOZERO); -+ xval_guard.Reset(xVal); // delete upon exit -+ -+ yEl=p0->N_Elements()/dim0; -+ yVal=new DDoubleGDL(dimension(yEl), BaseGDL::NOZERO); -+ yval_guard.Reset(yVal); // delete upon exit - -- xEl = p0->N_Elements() / p0->Dim(0); -- xVal = new DDoubleGDL( dimension( xEl), BaseGDL::NOZERO); -- xval_guard.reset( xVal); // delete upon exit -- -- yEl = p0->N_Elements() / p0->Dim(0); -- yVal = new DDoubleGDL( dimension( yEl), BaseGDL::NOZERO); -- yval_guard.reset( yVal); // delete upon exit -- -- for( SizeT i = 0; i < xEl; i++) -+ for ( SizeT i=0; iN_Elements()/dim0; -+ zVal=new DDoubleGDL(dimension(zEl), BaseGDL::NOZERO); -+ zval_guard.Reset(zVal); // delete upon exit -+ if (dim0==3) for ( SizeT i=0; iKeywordSet("T3D")) e->Throw("Only 3-argument case supported for T3D - FIXME!"); // TODO -- -- xVal = e->GetParAs< DDoubleGDL>( 0); -- xEl = xVal->N_Elements(); -+ xVal=e->GetParAs< DDoubleGDL>(0); -+ xEl=xVal->N_Elements(); - -- yVal = e->GetParAs< DDoubleGDL>( 1); -- yEl = yVal->N_Elements(); -+ yVal=e->GetParAs< DDoubleGDL>(1); -+ yEl=yVal->N_Elements(); - //silently drop unmatched values -- if (yEl!=xEl) -+ if ( yEl!=xEl ) - { - SizeT size; -- size=min(xEl,yEl); -+ size=min(xEl, yEl); - xEl=size; - yEl=size; - } -+ //z will be set at Zero unless Z=value is given -+ zEl=xEl; -+ zVal=new DDoubleGDL(dimension(zEl)); -+ zval_guard.Reset(zVal); // delete upon exit -+ for (SizeT i=0; i< zEl ; ++i) (*zVal)[i]=zValue; - } -- else if(nParam() == 3) -+ else if ( nParam()==3 ) - { -- zVal = e->GetParAs< DDoubleGDL>( 2); -- zEl = zVal->N_Elements(); -- -- //if ((*zVal)[0] == 0 && zEl == 1) { -- xVal = e->GetParAs< DDoubleGDL>( 0); -- xEl = xVal->N_Elements(); -- -- yVal = e->GetParAs< DDoubleGDL>( 1); -- yEl = yVal->N_Elements(); -- if (!(xEl==yEl && yEl==zEl)) -+ real3d=true; -+ zVal=e->GetParAs< DDoubleGDL>(2); -+ zEl=zVal->N_Elements(); -+ -+ xVal=e->GetParAs< DDoubleGDL>(0); -+ xEl=xVal->N_Elements(); -+ -+ yVal=e->GetParAs< DDoubleGDL>(1); -+ yEl=yVal->N_Elements(); -+ if ( !(xEl==yEl) ) - { - SizeT size; -- size=min(xEl,yEl); -- size=min(size,zEl); -+ size=min(xEl, yEl); - xEl=size; - yEl=size; -- zEl=size; -+ } -+ //if Z is passed and is 1 value, fill the array Z with this value -+ if ( !(xEl==zEl) ) -+ { -+ DDouble ztemp=(*zVal)[0]; -+ zEl=xEl; -+ zVal=new DDoubleGDL(dimension(xEl)); -+ zval_guard.Reset(zVal); // delete upon exit -+ for (SizeT i=0; i< zEl ; ++i) (*zVal)[i]=ztemp; - } - } - return false; -- } -+ } - -- private: void old_body( EnvT* e, GDLGStream* actStream) // {{{ -- { -- DDoubleGDL* clippingD=NULL; -+ private: - -- actStream->gvpd(xMarginL,xMarginR,yMarginB,yMarginT); -- if((xMarginL==0.0&&xMarginR==0.0)||(yMarginB==0.0&&yMarginT==0.0)) //if not initialized, set normalized mode -+ void old_body(EnvT* e, GDLGStream* actStream) - { -- actStream->NoSub(); -- actStream->vpor(0, 1, 0, 1); -- actStream->gvpd(xMarginL,xMarginR,yMarginB,yMarginT); -- actStream->wind(0.0,1.0,0.0,1.0); -- } -- // get current viewport limit in world coords --// get_axis_crange("X",xStart,xEnd); --// get_axis_crange("Y",yStart,yEnd); -- actStream->gvpw(xStart,xEnd,yStart,yEnd); -- // get_axis_type -- get_axis_type("X", xLogOrig); xLog=xLogOrig; -- get_axis_type("Y", yLogOrig); yLog=yLogOrig; -- -- /* DLong background = p_background; -- static int cix=e->KeywordIx("COLOR"); -- BaseGDL* color_arr=e->GetKW(cix); -- DLongGDL* l_color_arr; -- -- if(color_arr != NULL) -- { -- l_color_arr=static_cast -- (color_arr->Convert2(GDL_LONG, BaseGDL::COPY)); -- if(color_arr->N_Elements() < minEl && color_arr->N_Elements() > 1) -- e->Throw( "Array "+e->GetParString(cix)+ -- " does not have enough elements for COLOR keyword."); -- } -- DLong color = p_color; -- -- if(color_arr != NULL) -- if(color_arr->N_Elements() >= 1) -- color=(*l_color_arr)[0]; -- */ -- -- bool mapSet=false; -+ int clippingix=e->KeywordIx("CLIP"); -+ DFloatGDL* clipBox=NULL; -+ -+ enum -+ { -+ DATA=0, -+ NORMAL, -+ DEVICE -+ } coordinateSystem=DATA; -+ //check presence of DATA,DEVICE and NORMAL options -+ if ( e->KeywordSet("DATA") ) coordinateSystem=DATA; -+ if ( e->KeywordSet("DEVICE") ) coordinateSystem=DEVICE; -+ if ( e->KeywordSet("NORMAL") ) coordinateSystem=NORMAL; -+ -+ // get_axis_type -+ gdlGetAxisType("X", xLog); -+ gdlGetAxisType("Y", yLog); -+ gdlGetAxisType("Z", zLog); -+ // get ![XY].CRANGE -+ gdlGetCurrentAxisRange("X", xStart, xEnd); -+ gdlGetCurrentAxisRange("Y", yStart, yEnd); -+ gdlGetCurrentAxisRange("Z", zStart, zEnd); -+ -+ if ((yStart == yEnd) || (xStart == xEnd) || (zStart == zEnd)) -+ { -+ if (zStart != 0.0 && zStart == zEnd) -+ Message("PLOTS: !Z.CRANGE ERROR, setting to [0,1]"); -+ zStart = 0; -+ zEnd = 1; -+ -+ if (yStart != 0.0 && yStart == yEnd) -+ Message("PLOTS: !Y.CRANGE ERROR, setting to [0,1]"); -+ yStart = 0; -+ yEnd = 1; -+ -+ if (xStart != 0.0 && xStart == xEnd) -+ Message("PLOTS: !X.CRANGE ERROR, setting to [0,1]"); -+ xStart = 0; -+ xEnd = 1; -+ } -+ -+ bool mapSet=false; - #ifdef USE_LIBPROJ4 -- // Map Stuff (xtype = 3) -- LPTYPE idata; -- XYTYPE odata; -- -- get_mapset(mapSet); -- -- if ( mapSet) { -- ref = map_init(); -- if ( ref == NULL) { -- e->Throw( "Projection initialization failed."); -+ // Map Stuff (xtype = 3) -+ -+ get_mapset(mapSet); -+ -+ if ( mapSet ) -+ { -+ ref=map_init(); -+ if ( ref==NULL ) -+ { -+ e->Throw("Projection initialization failed."); -+ } - } -- } - #endif -- //CLIPPING -- DLong noclip = 1; //PLOTS: default is not to clip, even when clip= is present. Only with noclip=0 a clip is done. -- e->AssureLongScalarKWIfPresent( "NOCLIP", noclip); -- if( noclip == 0) -- { -- static int clippingix = e->KeywordIx( "CLIP"); -- clippingD = e->IfDefGetKWAs( clippingix); -- } -+ restoreClipBox=false; -+ int noclipvalue=1; -+ e->AssureLongScalarKWIfPresent( "NOCLIP", noclipvalue); -+ doClip=(noclipvalue==0); //PLOTS by default does not clip, even if clip is defined by CLIP= or !P.CLIP -+ clipBox=e->IfDefGetKWAs(clippingix); -+ if (doClip && clipBox!=NULL && clipBox->N_Elements()>=4 ) //clipbox exist, will be used: convert to device coords -+ //and save in !P.CLIP... -+ { -+ restoreClipBox=true; //restore later -+ // save current !P.CLIP box, replace by our current clipbox in whatever coordinates, will -+ // give back the !P.CLIP box at end... -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned clipTag=pStruct->Desc()->TagIndex("CLIP"); //must be in device coordinates -+ static PLFLT tempbox[4]; -+ for ( int i=0; i<4; ++i ) savebox[i]=(*static_cast(pStruct->GetTag(clipTag, 0)))[i]; -+ if ( coordinateSystem==DEVICE ) -+ { -+ for ( int i=0; i<4; ++i ) tempbox[i]=(*clipBox)[i]; -+ } -+ else if ( coordinateSystem==DATA ) -+ { -+ //handle log: if existing box is already in log, use log of clipbox values. -+ PLFLT worldbox[4]; -+ for ( int i=0; i<4; ++i ) worldbox[i]=(*clipBox)[i]; -+ if (xLog) {worldbox[0]=log10(worldbox[0]); worldbox[2]=log10(worldbox[2]);} -+ if (yLog) {worldbox[1]=log10(worldbox[1]); worldbox[3]=log10(worldbox[3]);} -+ bool okClipBox=true; -+ for ( int i=0; i<4; ++i ) -+ { -+ if (!(worldbox[i]==worldbox[i])) //NaN -+ { -+ okClipBox=false;restoreClipBox=false;doClip=false; -+ } -+ } -+ if (okClipBox) -+ { -+ actStream->WorldToDevice(worldbox[0], worldbox[1], tempbox[0], tempbox[1]); -+ actStream->WorldToDevice(worldbox[2], worldbox[3], tempbox[2], tempbox[3]); -+ } -+ } -+ else -+ { -+ actStream->NormedDeviceToDevice((*clipBox)[0],(*clipBox)[1], tempbox[0], tempbox[1]); -+ actStream->NormedDeviceToDevice((*clipBox)[2],(*clipBox)[3], tempbox[2], tempbox[3]); -+ } -+ //place in !P.CLIP -+ for ( int i=0; i<4; ++i ) (*static_cast(pStruct->GetTag(clipTag, 0)))[i]=tempbox[i]; -+ } - -- if (!e->KeywordSet("T3D")) -- { -- actStream->NoSub(); -- if (e->KeywordSet("DEVICE")) -+ PLFLT wun, wdeux, wtrois, wquatre; -+ if ( coordinateSystem==DATA) //with PLOTS, we can plot *outside* the box(e)s in DATA coordinates. -+ // convert to device coords in this case - { -- actStream->vpor(0, 1, 0, 1); -- PLFLT xpix, ypix; -- PLFLT un,deux,trois,quatre; -- PLINT xleng, yleng, xoff, yoff; -- actStream->gpage(xpix, ypix, xleng, yleng, xoff, yoff); -- un=0.0; deux=xleng; trois=0.0; quatre=yleng; --// if( clippingD != NULL) Clipping( clippingD, un, deux, trois, quatre); -- actStream->wind(un, deux, trois, quatre); -- xLog = false; -- yLog = false; -- } -- else if (e->KeywordSet("NORMAL")) -- { -- PLFLT un,deux,trois,quatre; -- actStream->vpor(0, 1, 0, 1); -- un=0.0; deux=1.0; trois=0.0; quatre=1.0; -- // if( clippingD != NULL) Clipping( clippingD, un, deux, trois, quatre); -- actStream->wind(un, deux, trois, quatre); -- xLog = false; -- yLog = false; -- } --// else if( clippingD != NULL) --// { --// PLFLT un,deux,trois,quatre; --// un=xStart; deux=xEnd; trois=yStart; quatre=yEnd; --// Clipping( clippingD, un, deux, trois, quatre); --// actStream->wind(un, deux, trois, quatre); --// } -+ actStream->pageWorldCoordinates(wun, wdeux, wtrois, wquatre); -+ } -+ -+ actStream->OnePageSaveLayout(); // one page -+ -+ actStream->vpor(0, 1, 0, 1); -+ if ( coordinateSystem==DEVICE ) -+ { -+ actStream->wind(0.0, actStream->xPageSize(), 0.0, actStream->yPageSize()); -+ xLog=false; -+ yLog=false; -+ } -+ else if ( coordinateSystem==NORMAL ) -+ { -+ actStream->wind(0, 1, 0, 1); -+ xLog=false; -+ yLog=false; -+ } - else //with PLOTS, we can plot *outside* the box(e)s in DATA coordinates. - { -- DDouble un, deux, trois, quatre; -- getWorldCoordinatesFromPLPLOT(actStream, 0.0, 0.0, &un, &trois); -- getWorldCoordinatesFromPLPLOT(actStream, 1.0, 1.0, &deux, &quatre); -- -- actStream->vpor(0, 1, 0, 1); -- actStream->wind((PLFLT)un, (PLFLT)deux, (PLFLT)trois, (PLFLT)quatre); -- } -- } -- // start drawing. Graphic Keywords accepted: CLIP(YES), COLOR(OK), DATA(YES), DEVICE(YES), -- //LINESTYLE(OK), NOCLIP(YES), NORMAL(YES), PSYM(OK), SYMSIZE(OK), T3D(NO), THICK(OK), Z(NO) -- gkw_color(e, actStream); //COLOR -- gkw_psym(e, psym); //PSYM -- gkw_linestyle(e, actStream); //LINESTYLE -- gkw_symsize(e, actStream); //SYMSIZE -- gkw_thick(e, actStream); //THICK -+ actStream->wind(wun, wdeux, wtrois, wquatre); -+ } -+ } - -- } -+ private: - -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -+ void call_plplot(EnvT* e, GDLGStream* actStream) - { -- if (e->KeywordSet("T3D")) // TODO: check !P.T3D -+ // start drawing. Graphic Keywords accepted: CLIP(YES), COLOR(OK), DATA(YES), DEVICE(YES), -+ //LINESTYLE(OK), NOCLIP(YES), NORMAL(YES), PSYM(OK), SYMSIZE(OK), T3D(NO), THICK(OK), Z(NO) -+ int colorIx=e->KeywordIx ( "COLOR" ); bool doColor=false; -+ if ( e->GetKW ( colorIx )!=NULL ) - { -- Warning("PLOTS: 3D plotting does not really work yet (!P.T and !P.T3D are ignored for the moment)"); -- /* actStream->w3d(1.2, 1.2, 2.2, // TODO! -- xStart, xEnd, yStart, yEnd, xStart, zEnd, -- 30, 30 // TODO! -- ); --*/ -- PLINT n = xVal->N_Elements(); -- if (yEl > 1 && yEl < n) n = yEl; -- if (zEl > 1 && zEl < n) n = zEl; -+ color=e->GetKWAs( colorIx ); doColor=true; -+ } -+ static DDouble x0,y0,xs,ys; //conversion to normalized coords -+ x0=(xLog)?-log10(xStart):-xStart; -+ y0=(yLog)?-log10(yStart):-yStart; -+ xs=(xLog)?(log10(xEnd)-log10(xStart)):xEnd-xStart;xs=1.0/xs; -+ ys=(yLog)?(log10(yEnd)-log10(yStart)):yEnd-yStart;ys=1.0/ys; -+ -+ if ( doT3d && !real3d) { //if X,Y and Z are passed, we will use !P.T and not our plplot "interpretation" of !P.T -+ //if the x and y scaling is OK, using !P.T directly permits to use other projections -+ //than those used implicitly by plplot. See @showhaus example for *DL -+ // case where we project 2D data on 3D: use plplot-like matrix. -+ DDouble az, alt, ay, scale; -+ ORIENTATION3D axisExchangeCode; - -- PLFLT *x = new PLFLT[n]; -+ plplot3d = gdlConvertT3DMatrixToPlplotRotationMatrix( zValue, az, alt, ay, scale, axisExchangeCode); -+ if (plplot3d == NULL) - { -- int a = (xEl != 1); -- for (PLINT i = 0; i < n; ++i) x[i] = (*xVal)[a * i]; -+ e->Throw("Illegal 3D transformation. (FIXME)"); - } - -- PLFLT *y = new PLFLT[n]; -- { -- int a = (yEl != 1); -- for (PLINT i = 0; i < n; ++i) y[i] = (*yVal)[a * i]; -+ Data3d.zValue = zValue; -+ Data3d.Matrix = plplot3d; //try to change for !P.T in future? -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code012; -+ break; -+ case XY: // X->Y Y->X plane XY -+ Data3d.x0=0; -+ Data3d.y0=x0; -+ Data3d.xs=ys; -+ Data3d.ys=xs; -+ Data3d.code = code102; -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code210; -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code021; -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code120; -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code201; -+ break; - } -+ actStream->stransform(gdl3dTo2dTransform, &Data3d); -+ } -+ // make all clipping computations BEFORE setting graphic properties (color, size) -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, true)==TRUE ) stopClip=true; -+ //properties -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); //COLOR -+ gdlGetPsym(e, psym); //PSYM -+ if (psym==10) e->Throw("PSYM (plotting symbol) out of range"); //not allowed for PLOTS! -+ gdlSetLineStyle(e, actStream); //LINESTYLE -+ gdlSetSymsize(e, actStream); //SYMSIZE -+ gdlSetPenThickness(e, actStream); //THICK - -- PLFLT *z = new PLFLT[n]; -+ if (real3d) -+ { -+ //try first if the matrix is a plplot-compatible one -+ DDouble az, alt, ay, scale; -+ ORIENTATION3D axisExchangeCode; -+ plplot3d = gdlConvertT3DMatrixToPlplotRotationMatrix( zValue, az, alt, ay, scale, axisExchangeCode); -+ -+ if (plplot3d == NULL) //use the original !P.T matrix (better than nothing) -+ { -+ Warning("Using Illegal 3D transformation, continuing. (FIXME)"); -+ plplot3d=gdlGetT3DMatrix(); //the original one -+ plplot3d_guard.Reset(plplot3d); -+ Data3d.code = code012; -+ } else - { -- int a = (zEl != 1); -- for (PLINT i = 0; i < n; ++i) z[i] = (*zVal)[a * i]; -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ Data3d.code = code012; -+ break; -+ case XY: // X->Y Y->X plane XY -+ Data3d.code = code102; -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ Data3d.code = code210; -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ Data3d.code = code021; -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ Data3d.code = code120; -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ Data3d.code = code201; -+ break; -+ } - } -+ DDoubleGDL *xValou=new DDoubleGDL(dimension(xEl)); -+ DDoubleGDL *yValou=new DDoubleGDL(dimension(yEl)); -+ Guard xval_guard, yval_guard; -+ xval_guard.reset(xValou); -+ yval_guard.reset(yValou); -+ //rescale to normalized box before conversions --- works for both matrices. -+ gdl3dto2dProjectDDouble(gdlGetScaledNormalizedT3DMatrix(plplot3d),xVal,yVal,zVal,xValou,yValou,Data3d.code); -+ draw_polyline(e, actStream, xValou, yValou, 0.0, 0.0, false, xLog, yLog, psym, append, doColor?color:NULL); -+ } -+ else bool valid=draw_polyline(e, actStream, xVal, yVal, 0.0, 0.0, false, xLog, yLog, psym, append, doColor?color:NULL); -+ if (stopClip) stopClipping(actStream); -+ } - -- actStream->line3(n, x, y, z); -+ private: - -- delete[] x; -- delete[] y; -- delete[] z; -+ virtual void post_call(EnvT*, GDLGStream* actStream) -+ { -+ if (doT3d && !real3d) -+ { -+ plplot3d_guard.Reset(plplot3d); -+ actStream->stransform(NULL,NULL); - } -- else -+ actStream->RestoreLayout(); -+ actStream->lsty(1); //reset linestyle -+ if (restoreClipBox) - { -- // there is no 'minmax' option for plots. -- bool valid = draw_polyline(e, actStream, xVal, yVal, 0.0, 0.0, false, xLog, yLog, psym, append); -- // TODO: handle valid? -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned clipTag=pStruct->Desc()->TagIndex("CLIP"); //must be in device coordinates -+ for ( int i=0; i<4; ++i ) (*static_cast(pStruct->GetTag(clipTag, 0)))[i]=savebox[i]; - } -- } -- -- private: virtual void post_call(EnvT*, GDLGStream* actStream) -- { -- actStream->lsty(1);//reset linestyle -- actStream->vpor(xMarginL, xMarginR, yMarginB, yMarginT); -- actStream->wind(xStart, xEnd, yStart, yEnd); -- } -+ } - -- }; // oplot_call class -+ }; - - void plots(EnvT* e) - { - plots_call plots; - plots.call(e, 1); -- } -+ } - - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_polyfill.cpp gdl/src/plotting_polyfill.cpp ---- gdl-0.9.3/src/plotting_polyfill.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_polyfill.cpp 2013-07-08 12:39:22.378387400 -0600 -@@ -19,195 +19,391 @@ - #include "plotting.hpp" - #include "math_utl.hpp" - --#ifdef _MSC_VER --#define isnan _isnan --#endif -- --namespace lib { -+namespace lib -+{ - - using namespace std; - -- class polyfill_call : public plotting_routine_call -+ class polyfill_call: public plotting_routine_call - { - -- private: DDoubleGDL* yVal, *xVal; -- private: SizeT xEl, yEl; -+ private: -+ DDoubleGDL *xVal, *yVal, *zVal; -+ Guard xval_guard, yval_guard, zval_guard; -+ DDouble xStart, xEnd, yStart, yEnd, zStart, zEnd; -+ DLong psym; -+ bool xLog, yLog, zLog; -+ SizeT xEl, yEl, zEl; -+ bool append; -+ bool doClip; -+ bool restoreClipBox; -+ PLFLT savebox[4]; -+ bool doT3d, real3d; -+ DDouble zValue; -+ DDoubleGDL* plplot3d; -+ Guard plplot3d_guard; -+// DLongGDL *color; - -- private: bool handle_args(EnvT* e) // {{{ -+ private: -+ -+ bool handle_args(EnvT* e) // {{{ - { -- return true; -+ real3d=false; -+ //T3D -+ static int t3dIx = e->KeywordIx( "T3D"); -+ doT3d=(e->KeywordSet(t3dIx)|| T3Denabled(e)); -+ -+ //note: Z (VALUE) will be used uniquely if Z is not effectively defined. -+ static int zvIx = e->KeywordIx( "Z"); -+ zValue=0.0; -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ -+ if ( nParam()==1 ) -+ { -+ BaseGDL* p0; -+ p0=e->GetParDefined(0); -+ SizeT dim0=p0->Dim(0); -+ if ( dim0<2 || dim0>3 ) -+ e->Throw("When only 1 param, dims must be (2,n) or (3,n)"); -+ if (p0->Dim(1) < 3 ) e->Throw("Not enough valid and unique points specified."); -+ -+ DDoubleGDL *val=e->GetParAs< DDoubleGDL>(0); -+ xEl=p0->N_Elements()/dim0; -+ xVal=new DDoubleGDL(dimension(xEl), BaseGDL::NOZERO); -+ xval_guard.Reset(xVal); // delete upon exit -+ -+ yEl=p0->N_Elements()/dim0; -+ yVal=new DDoubleGDL(dimension(yEl), BaseGDL::NOZERO); -+ yval_guard.Reset(yVal); // delete upon exit -+ -+ for ( SizeT i=0; iN_Elements()/dim0; -+ zVal=new DDoubleGDL(dimension(zEl), BaseGDL::NOZERO); -+ zval_guard.Reset(zVal); // delete upon exit -+ if (dim0==3) for ( SizeT i=0; iGetParAs< DDoubleGDL>(0); -+ xEl=xVal->N_Elements(); -+ -+ yVal=e->GetParAs< DDoubleGDL>(1); -+ yEl=yVal->N_Elements(); -+ -+ if ( xEl < 3 || yEl < 3 ) e->Throw("Not enough valid and unique points specified."); -+ -+ //silently drop unmatched values -+ if ( yEl!=xEl ) -+ { -+ SizeT size; -+ size=min(xEl, yEl); -+ xEl=size; -+ yEl=size; -+ } -+ //z will be set at Zero unless Z=value is given -+ zEl=xEl; -+ zVal=new DDoubleGDL(dimension(zEl)); -+ zval_guard.Reset(zVal); // delete upon exit -+ for (SizeT i=0; i< zEl ; ++i) (*zVal)[i]=zValue; -+ } -+ else if ( nParam()==3 ) -+ { -+ if (doT3d) real3d=true; -+ zVal=e->GetParAs< DDoubleGDL>(2); -+ zEl=zVal->N_Elements(); -+ -+ xVal=e->GetParAs< DDoubleGDL>(0); -+ xEl=xVal->N_Elements(); -+ -+ yVal=e->GetParAs< DDoubleGDL>(1); -+ yEl=yVal->N_Elements(); -+ -+ if ( xEl < 3 || yEl < 3 || zEl < 3) e->Throw("Not enough valid and unique points specified."); -+ -+ if ( !(xEl==yEl&&yEl==zEl) ) -+ { -+ SizeT size; -+ size=min(xEl, yEl); -+ size=min(size, zEl); -+ xEl=size; -+ yEl=size; -+ zEl=size; -+ } -+ } -+ return false; -+// return true; - } // }}} - -- void old_body( EnvT* e, GDLGStream* actStream) // {{{ -- { -+ void old_body(EnvT* e, GDLGStream* actStream) // {{{ -+ { -+ enum -+ { -+ DATA=0, -+ NORMAL, -+ DEVICE -+ } coordinateSystem=DATA; -+ //check presence of DATA,DEVICE and NORMAL options -+ if ( e->KeywordSet("DATA") ) coordinateSystem=DATA; -+ if ( e->KeywordSet("DEVICE") ) coordinateSystem=DEVICE; -+ if ( e->KeywordSet("NORMAL") ) coordinateSystem=NORMAL; -+ -+ // get_axis_type -+ gdlGetAxisType("X", xLog); -+ gdlGetAxisType("Y", yLog); -+ gdlGetAxisType("Z", zLog); -+ // get ![XY].CRANGE -+ gdlGetCurrentAxisRange("X", xStart, xEnd); -+ gdlGetCurrentAxisRange("Y", yStart, yEnd); -+ gdlGetCurrentAxisRange("Z", zStart, zEnd); - -- bool mapSet=false; -+ if ((yStart == yEnd) || (xStart == xEnd) || (zStart == zEnd)) -+ { -+ if (zStart != 0.0 && zStart == zEnd) -+ Message("POLYFILL: !Z.CRANGE ERROR, setting to [0,1]"); -+ zStart = 0; -+ zEnd = 1; -+ -+ if (yStart != 0.0 && yStart == yEnd) -+ Message("POLYFILL: !Y.CRANGE ERROR, setting to [0,1]"); -+ yStart = 0; -+ yEnd = 1; -+ -+ if (xStart != 0.0 && xStart == xEnd) -+ Message("POLYFILL: !X.CRANGE ERROR, setting to [0,1]"); -+ xStart = 0; -+ xEnd = 1; -+ } -+ -+ bool mapSet=false; - #ifdef USE_LIBPROJ4 -- LPTYPE idata; -- XYTYPE odata; -- get_mapset(mapSet); -- if (mapSet) -- { -- ref = map_init(); -- if (ref == NULL) e->Throw( "Projection initialization failed."); -- } --#endif -+ // Map Stuff (xtype = 3) - -- if(nParam() == 1 || nParam() == 3) -- { -- e->Throw("1- and 3-argument case not implemented yet"); -- } -- else -- { -- xVal = !mapSet -- ? e->GetParAs< DDoubleGDL>(0) -- : static_cast( -- e->GetNumericArrayParDefined(0)->Convert2(GDL_DOUBLE, BaseGDL::COPY) -- ); -- yVal = !mapSet -- ? e->GetParAs< DDoubleGDL>(1) -- : static_cast( -- e->GetNumericArrayParDefined(1)->Convert2(GDL_DOUBLE, BaseGDL::COPY) -- ); -+ get_mapset(mapSet); - -- xEl = xVal->N_Elements(); -- yEl = yVal->N_Elements(); -- } -+ if ( mapSet ) -+ { -+ ref=map_init(); -+ if ( ref==NULL ) -+ { -+ e->Throw("Projection initialization failed."); -+ } -+ } -+#endif - -- if (xEl != yEl) -- e->Throw("xEl != yEl"); // TODO - -- if (xEl < 3) -- e->Throw("Input arrays must define at least three points"); -+ PLFLT wun, wdeux, wtrois, wquatre; -+ if ( coordinateSystem==DATA) //with POLYFILL, we can plot *outside* the box(e)s in DATA coordinates. -+ // convert to device coords in this case -+ { -+ actStream->pageWorldCoordinates(wun, wdeux, wtrois, wquatre); -+ } -+ -+ actStream->OnePageSaveLayout(); // one page - -- DFloat xMarginL, xMarginR,yMarginB, yMarginT; -- get_axis_margin("X", xMarginL, xMarginR); -- get_axis_margin("Y", yMarginB, yMarginT); -- -- DDouble xStart, xEnd, yStart, yEnd; -- bool xLog, yLog; -- -- get_axis_crange("X", xStart, xEnd); -- get_axis_crange("Y", yStart, yEnd); -- get_axis_type("X", xLog); -- get_axis_type("Y", yLog); -- -- gkw_color(e, actStream); -- -- PLFLT xMR, xML, yMB, yMT; -- CheckMargin( e, actStream, xMarginL, xMarginR, yMarginB, yMarginT, xMR, xML, yMB, yMT); -- -- DDouble *sx, *sy; -- DFloat *wx, *wy; -- GetSFromPlotStructs(&sx, &sy); -- GetWFromPlotStructs(&wx, &wy); -- -- int toto=0; -- -- if(e->KeywordSet("DEVICE")) { -- PLFLT xpix, ypix; -- PLINT xleng, yleng, xoff, yoff; -- actStream->gpage(xpix, ypix,xleng, yleng, xoff, yoff); -- xStart=0; xEnd=xleng; -- yStart=0; yEnd=yleng; -- xLog = false; yLog = false; -- actStream->NoSub(); -- actStream->vpor(0, 1, 0, 1); -- } else if(e->KeywordSet("NORMAL")) { -- xStart = 0; -- xEnd = 1; -- yStart = 0; -- yEnd = 1; -- actStream->NoSub(); - actStream->vpor(0, 1, 0, 1); -- xLog = false; yLog = false; -- } else { -- toto=1; -- actStream->NoSub(); -- if (xLog || yLog) actStream->vpor(wx[0], wx[1], wy[0], wy[1]); -- else actStream->vpor(0, 1, 0, 1); // (to be merged with the condition on DataCoordLimits...) -- } -+ if ( coordinateSystem==DEVICE ) -+ { -+ actStream->wind(0.0, actStream->xPageSize(), 0.0, actStream->yPageSize()); -+ xLog=false; -+ yLog=false; -+ } -+ else if ( coordinateSystem==NORMAL ) -+ { -+ actStream->wind(0, 1, 0, 1); -+ xLog=false; -+ yLog=false; -+ } -+ else //with POLYFILL, we can plot *outside* the box(e)s in DATA coordinates. -+ { -+ actStream->wind(wun, wdeux, wtrois, wquatre); -+ } - -- // Determine data coordinate limits -- // These are computed from window and scaling axis system -- // variables because map routines change these directly. -- //if (e->KeywordSet("NORMAL") || e->KeywordSet("DATA")) { -- if (e->KeywordSet("DATA") || (toto == 1)) { -- DataCoordLimits(sx, sy, wx, wy, &xStart, &xEnd, &yStart, &yEnd, false); -- } -- DDouble minVal = yStart, maxVal = yEnd; -+ } // }}} - -- //CLIPPING --// DLong noclip = 1; --// e->AssureLongScalarKWIfPresent( "NOCLIP", noclip); --// if (noclip == 0) --// { --// static int clippingix = e->KeywordIx( "CLIP"); --// DDoubleGDL* clippingD = e->IfDefGetKWAs( clippingix); --// if (clippingD != NULL) Clipping( clippingD, xStart, xEnd, minVal, maxVal); --// } -- -- // SA: following a patch from Joanna (3029409) TODO: this is repeated in PLOTS POLYFILL and XYOUTS -- if ( xEnd - xStart == 0 || yEnd - yStart == 0 || isnan(xStart) || isnan(yStart) ) { -- actStream->wind( 0, 1, 0, 1 ); -- } else { -- actStream->wind( xStart, xEnd, yStart, yEnd); -- } -+ private: - -- // LINE_FILL, SPACING, LINESTYLE, ORIENTATION, THICK (thanks to JW) -- static int line_fillIx = e->KeywordIx("LINE_FILL"); -- if (e->KeywordSet(line_fillIx)) -+ void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ - { -- PLINT inc = 0, del = 1500; -- -- static int orientationIx = e->KeywordIx("ORIENTATION"); -- if (e->KeywordSet(orientationIx)) inc = PLINT(1e1 * (*e->GetKWAs(orientationIx))[0]); -+ static DDouble x0,y0,xs,ys; //conversion to normalized coords -+ x0=(xLog)?-log10(xStart):-xStart; -+ y0=(yLog)?-log10(yStart):-yStart; -+ xs=(xLog)?(log10(xEnd)-log10(xStart)):xEnd-xStart;xs=1.0/xs; -+ ys=(yLog)?(log10(yEnd)-log10(yStart)):yEnd-yStart;ys=1.0/ys; -+ -+ if ( doT3d && !real3d) { //if X,Y and Z are passed, we will use !P.T and not our plplot "interpretation" of !P.T -+ //if the x and y scaling is OK, using !P.T directly permits to use other projections -+ //than those used implicitly by plplot. See @showhaus example for *DL -+ // case where we project 2D data on 3D: use plplot-like matrix. -+ DDouble az, alt, ay, scale; -+ ORIENTATION3D axisExchangeCode; -+ -+ plplot3d = gdlConvertT3DMatrixToPlplotRotationMatrix( zValue, az, alt, ay, scale, axisExchangeCode); -+ if (plplot3d == NULL) -+ { -+ e->Throw("Illegal 3D transformation. (FIXME)"); -+ } -+ -+ Data3d.zValue = zValue; -+ Data3d.Matrix = plplot3d; //try to change for !P.T in future? -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code012; -+ break; -+ case XY: // X->Y Y->X plane XY -+ Data3d.x0=0; -+ Data3d.y0=x0; -+ Data3d.xs=ys; -+ Data3d.ys=xs; -+ Data3d.code = code102; -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code210; -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code021; -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code120; -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ Data3d.x0=x0; -+ Data3d.y0=y0; -+ Data3d.xs=xs; -+ Data3d.ys=ys; -+ Data3d.code = code201; -+ break; -+ } -+ actStream->stransform(gdl3dTo2dTransform, &Data3d); -+ } -+ //handle clipping -+ bool doClip=(e->KeywordSet("CLIP")||e->KeywordSet("NOCLIP")); -+ // make all clipping computations BEFORE setting graphic properties (color, size) -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, false)==TRUE ) stopClip=true; -+ //properties -+// int colorIx=e->KeywordIx ( "COLOR" ); bool doColor=false; -+// if ( e->GetKW ( colorIx )!=NULL ) -+// { -+// color=e->GetKWAs( colorIx ); doColor=true; -+// } -+ -+ // LINE_FILL, SPACING, LINESTYLE, ORIENTATION, THICK (thanks to JW) -+ static int line_fillIx=e->KeywordIx("LINE_FILL"); -+ if ( e->KeywordSet(line_fillIx) ) -+ { -+ PLINT ori=0, spa=1500; - -- static int spacingIx = e->KeywordIx("SPACING"); -- if (e->KeywordSet(spacingIx)) del = PLINT(1e4 * (*e->GetKWAs(spacingIx))[0]); -- -- gkw_thick(e, actStream); -- gkw_linestyle(e, actStream); -+ static int orientationIx=e->KeywordIx("ORIENTATION"); -+ if ( e->KeywordSet(orientationIx) ) ori=PLINT(1e1*(*e->GetKWAs(orientationIx))[0]); -+ static int spacingIx=e->KeywordIx("SPACING"); -+ if ( e->KeywordSet(spacingIx) ) spa=PLINT(1e4*(*e->GetKWAs(spacingIx))[0]); - -- actStream->psty(8); -- actStream->pat(1, &inc, &del); -- } -- else -- { -- actStream->psty(0); -- } -+ gdlSetPenThickness(e, actStream); -+ gdlSetLineStyle(e, actStream); - --#ifdef USE_LIBPROJ4 -- if (mapSet) -- { -- for (SizeT i = 0; i < xEl; ++i) -+ actStream->psty(8); -+ actStream->pat(1, &ori, &spa); -+ } -+ else - { -- idata.lam = (*xVal)[i] * DEG_TO_RAD; -- idata.phi = (*yVal)[i] * DEG_TO_RAD; -- odata = PJ_FWD(idata, ref); -- (*xVal)[i] = odata.x; -- (*yVal)[i] = odata.y; -+ actStream->psty(0); - } -- } --#endif -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); //COLOR -+ gdlSetLineStyle(e, actStream); //LINESTYLE -+ gdlSetPenThickness(e, actStream); //THICK - -- } // }}} -+ if (real3d) -+ { -+ //try first if the matrix is a plplot-compatible one -+ DDouble az, alt, ay, scale; -+ ORIENTATION3D axisExchangeCode; -+ plplot3d = gdlConvertT3DMatrixToPlplotRotationMatrix( zValue, az, alt, ay, scale, axisExchangeCode); -+ -+ if (plplot3d == NULL) //use the original !P.T matrix (better than nothing) -+ { -+ Warning("Using Illegal 3D transformation, continuing. (FIXME)"); -+ plplot3d=gdlGetT3DMatrix(); //the original one -+ plplot3d_guard.Reset(plplot3d); -+ Data3d.code = code012; -+ } else -+ { -+ switch (axisExchangeCode) { -+ case NORMAL: //X->X Y->Y plane XY -+ Data3d.code = code012; -+ break; -+ case XY: // X->Y Y->X plane XY -+ Data3d.code = code102; -+ break; -+ case XZ: // Y->Y X->Z plane YZ -+ Data3d.code = code210; -+ break; -+ case YZ: // X->X Y->Z plane XZ -+ Data3d.code = code021; -+ break; -+ case XZXY: //X->Y Y->Z plane YZ -+ Data3d.code = code120; -+ break; -+ case XZYZ: //X->Z Y->X plane XZ -+ Data3d.code = code201; -+ break; -+ } -+ } -+ DDoubleGDL *xValou=new DDoubleGDL(dimension(xEl)); -+ DDoubleGDL *yValou=new DDoubleGDL(dimension(yEl)); -+ Guard xval_guard, yval_guard; -+ xval_guard.reset(xValou); -+ yval_guard.reset(yValou); -+ //rescale to normalized box before conversions --- works for both matrices. -+ gdl3dto2dProjectDDouble(gdlGetScaledNormalizedT3DMatrix(plplot3d),xVal,yVal,zVal,xValou,yValou,Data3d.code); - -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -- { -- actStream->fill(xEl, static_cast(&(*xVal)[0]), static_cast(&(*yVal)[0])); -- } // }}} -+ actStream->fill(xEl, static_cast(&(*xValou)[0]), static_cast(&(*yValou)[0])); - -- private: virtual void post_call(EnvT*, GDLGStream*) // {{{ -- { -+ } -+ else actStream->fill(xEl, static_cast(&(*xVal)[0]), static_cast(&(*yVal)[0])); -+ if (stopClip) stopClipping(actStream); - } // }}} - -+ private: -+ -+ virtual void post_call(EnvT*, GDLGStream *actStream) // {{{ -+ { -+ if (doT3d && !real3d) -+ { -+ plplot3d_guard.Reset(plplot3d); -+ actStream->stransform(NULL,NULL); -+ } -+ actStream->RestoreLayout(); -+ actStream->lsty(1); //reset linestyle -+ actStream->psty(0); //reset fill -+ } - }; - - void polyfill(EnvT* e) - { - polyfill_call polyfill; -- polyfill.call(e, 1); -+ polyfill.call(e, 1); - } - - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_shade_surf.cpp gdl/src/plotting_shade_surf.cpp ---- gdl-0.9.3/src/plotting_shade_surf.cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/plotting_shade_surf.cpp 2013-07-31 09:41:44.188244830 -0600 -@@ -0,0 +1,401 @@ -+/*************************************************************************** -+ plotting_shade_surf.cpp - GDL routines for plotting -+ ------------------- -+ begin : May 07 2013 -+ copyright : (C) 2002-2011 by Marc Schellens et al. -+ email : m_schellens@users.sf.net -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -+ -+#include "includefirst.hpp" -+#include "plotting.hpp" -+#include "math_utl.hpp" -+ -+namespace lib -+{ -+ using namespace std; -+ -+// shared parameter -+ static PLFLT lightSourcePos[3]={1.0E6,0.0,1.0}; -+ -+ class shade_surf_call: public plotting_routine_call -+ { -+ DDoubleGDL *zVal, *yVal, *xVal; -+ Guard xval_guard, yval_guard, p0_guard; -+ SizeT xEl, yEl, zEl; -+ DDouble xStart, xEnd, yStart, yEnd, zStart, zEnd, datamax, datamin; -+ bool nodata; -+ bool setZrange; -+ bool xLog; -+ bool yLog; -+ bool zLog; -+ ORIENTATION3D axisExchangeCode; -+ private: -+ bool handle_args (EnvT* e) -+ { -+ xLog=e->KeywordSet ( "XLOG" ); -+ yLog=e->KeywordSet ( "YLOG" ); -+ zLog=e->KeywordSet ( "ZLOG" ); -+ if ( nParam ( )==1 ) -+ { -+ if ( (e->GetNumericArrayParDefined ( 0 ))->Rank ( )!=2 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ -+ BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL ); -+ zVal=static_cast -+ ( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) ); -+ p0_guard.reset ( p0 ); // delete upon exit -+ -+ if ( zVal->Rank ( )!=2 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ -+ xEl=zVal->Dim ( 1 ); -+ yEl=zVal->Dim ( 0 ); -+ -+ xVal=new DDoubleGDL ( dimension ( xEl ), BaseGDL::INDGEN ); -+ xval_guard.reset ( xVal ); // delete upon exit -+ if (xLog) xVal->Inc(); -+ yVal=new DDoubleGDL ( dimension ( yEl ), BaseGDL::INDGEN ); -+ yval_guard.reset ( yVal ); // delete upon exit -+ if (yLog) yVal->Inc(); -+ } -+ else if ( nParam ( )==2||nParam ( )>3 ) -+ { -+ e->Throw ( "Incorrect number of arguments." ); -+ } -+ else -+ { -+ BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL ); -+ zVal=static_cast -+ ( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) ); -+ p0_guard.reset ( p0 ); // delete upon exit -+ -+ if ( zVal->Rank ( )!=2 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ xVal=e->GetParAs< DDoubleGDL>( 1 ); -+ yVal=e->GetParAs< DDoubleGDL>( 2 ); -+ -+ if ( xVal->Rank ( )!=1 ) -+ e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" ); -+ -+ if ( yVal->Rank ( )!=1 ) -+ e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" ); -+ -+ if ( xVal->Rank ( )==1 ) -+ { -+ xEl=xVal->Dim ( 0 ); -+ -+ if ( xEl!=zVal->Dim ( 1 ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ } -+ -+ if ( yVal->Rank ( )==1 ) -+ { -+ yEl=yVal->Dim ( 0 ); -+ -+ if ( yEl!=zVal->Dim ( 0 ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); -+ } -+ -+ } -+ -+ GetMinMaxVal ( xVal, &xStart, &xEnd ); -+ GetMinMaxVal ( yVal, &yStart, &yEnd ); -+ //XRANGE and YRANGE overrides all that, but Start/End should be recomputed accordingly -+ DDouble xAxisStart, xAxisEnd, yAxisStart, yAxisEnd; -+ bool setx=gdlGetDesiredAxisRange(e, "X", xAxisStart, xAxisEnd); -+ bool sety=gdlGetDesiredAxisRange(e, "Y", yAxisStart, yAxisEnd); -+ if(setx && sety) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+ } -+ else if (sety) -+ { -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+ } -+ else if (setx) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ //must compute min-max for other axis! -+ { -+ gdlDoRangeExtrema(xVal,yVal,yStart,yEnd,xStart,xEnd); -+ } -+ } -+ #undef UNDEF_RANGE_VALUE -+ // z range -+ datamax=0.0; -+ datamin=0.0; -+ GetMinMaxVal ( zVal, &datamin, &datamax ); -+ zStart=datamin; -+ zEnd=datamax; -+ setZrange = gdlGetDesiredAxisRange(e, "Z", zStart, zEnd); -+ -+ return false; -+ } -+ -+ private: -+ void old_body (EnvT* e, GDLGStream* actStream) // {{{ -+ { -+ //T3D -+ static int t3dIx = e->KeywordIx( "T3D"); -+ bool doT3d=(e->KeywordSet(t3dIx)|| T3Denabled(e)); -+ //ZVALUE -+ static int zvIx = e->KeywordIx( "ZVALUE"); -+ DDouble zValue=0.0; -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ zValue=min(zValue,0.999999); //to avoid problems with plplot -+ //SAVE -+ static int savet3dIx = e->KeywordIx( "SAVE"); -+ bool saveT3d=e->KeywordSet(savet3dIx); -+ //NODATA -+ static int nodataIx = e->KeywordIx( "NODATA"); -+ nodata=e->KeywordSet(nodataIx); -+ //SHADES -+ static int shadesIx = e->KeywordIx( "SHADES"); -+ BaseGDL* shadevalues=e->GetKW ( shadesIx ); -+ bool doShade=(shadevalues != NULL); //... But 3d mesh will be colorized anyway! -+ if (doShade) Warning ( "SHADE_SURF: Using Fixed (Z linear) Shade Values Only (FIXME)." ); -+ // [XYZ]STYLE -+ DLong xStyle=0, yStyle=0, zStyle=0; ; -+ gdlGetDesiredAxisStyle(e, "X", xStyle); -+ gdlGetDesiredAxisStyle(e, "Y", yStyle); -+ gdlGetDesiredAxisStyle(e, "Z", zStyle); -+ -+ //check here since after AutoIntvAC values will be good but arrays passed -+ //to plplot will be bad... -+ if ( xLog && xStart<=0.0 ) -+ { -+ Warning ( "SHADE_SURF: Infinite x plot range." ); -+ nodata=true; -+ } -+ if ( yLog && yStart<=0.0 ) -+ { -+ Warning ( "SHADE_SURF: Infinite y plot range." ); -+ nodata=true; -+ } -+ if ( zLog && zStart<=0.0 ) Warning ( "SHADE_SURF: Infinite z plot range." ); -+ -+ -+ if ( ( xStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( xStart, xEnd, xLog ); -+ } -+ -+ if ( ( yStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( yStart, yEnd, yLog ); -+ } -+ -+ bool hasMinVal=e->KeywordPresent("MIN_VALUE"); -+ bool hasMaxVal=e->KeywordPresent("MAX_VALUE"); -+ DDouble minVal=datamin; -+ DDouble maxVal=datamax; -+ e->AssureDoubleScalarKWIfPresent ( "MIN_VALUE", minVal ); -+ e->AssureDoubleScalarKWIfPresent ( "MAX_VALUE", maxVal ); -+ -+ if (!setZrange) { -+ zStart=max(minVal,zStart); -+ zEnd=min(zEnd,maxVal); -+ } -+ -+ // then only apply expansion of axes: -+ if ( ( zStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( zStart, zEnd, zLog ); -+ } -+ -+ // background BEFORE next plot since it is the only place plplot may redraw the background... -+ gdlSetGraphicsBackgroundColorFromKw ( e, actStream ); //BACKGROUND -+ gdlNextPlotHandlingNoEraseOption(e, actStream); //NOERASE -+ -+ gdlSetPlotCharsize(e, actStream); -+ -+ // Deal with T3D options -- either present and we have to deduce az and alt contained in it, -+ // or absent and we have to compute !P.T from az and alt. -+ -+ PLFLT alt=30.0; -+ PLFLT az=30.0; -+ //set az and ax (alt) -+ DFloat alt_change=alt; -+ e->AssureFloatScalarKWIfPresent("AX", alt_change); -+ alt=alt_change; -+ -+ alt=fmod(alt,360.0); //restrict between 0 and 90 for plplot! -+ if (alt > 90.0 || alt < 0.0) -+ { -+ e->Throw ( "SHADE_SURF: AX restricted to [0-90] range by plplot (fix plplot!)" ); -+ } -+ DFloat az_change=az; -+ e->AssureFloatScalarKWIfPresent("AZ", az_change); -+ az=az_change; -+ -+ //now we are in plplot different kind of 3d -+ DDoubleGDL* plplot3d; -+ DDouble ay, scale; //not useful at this time -+ if (doT3d) //convert to this world... -+ { -+ -+ plplot3d=gdlConvertT3DMatrixToPlplotRotationMatrix(zValue, az, alt, ay, scale, axisExchangeCode); -+ if (plplot3d == NULL) -+ { -+ e->Throw ( "SHADE_SURF: Illegal 3D transformation." ); -+ } -+ } -+ else //make the transformation ourselves -+ { -+ scale=1/sqrt(3); -+ //Compute transformation matrix with plplot conventions: -+ plplot3d=gdlComputePlplotRotationMatrix( az, alt, zValue,scale); -+ // save !P.T if asked to... -+ if (saveT3d) //will use ax and az values... -+ { -+ DDoubleGDL* t3dMatrix=plplot3d->Dup(); -+ SelfTranspose3d(t3dMatrix); -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned tTag=pStruct->Desc()->TagIndex("T"); -+ for (int i=0; iN_Elements(); ++i )(*static_cast(pStruct->GetTag(tTag, 0)))[i]=(*t3dMatrix)[i]; -+ GDLDelete(t3dMatrix); -+ } -+ } -+ -+ if ( gdlSet3DViewPortAndWorldCoordinates(e, actStream, plplot3d, xLog, yLog, -+ xStart, xEnd, yStart, yEnd, zStart, zEnd, zLog)==FALSE ) return; -+ -+ gdlSetPlotCharthick(e,actStream); -+ -+ -+ if (xLog) xStart=log10(xStart); -+ if (yLog) yStart=log10(yStart); -+ if (zLog) zStart=log10(zStart); -+ if (xLog) xEnd=log10(xEnd); -+ if (yLog) yEnd=log10(yEnd); -+ if (zLog) zEnd=log10(zEnd); -+ -+ actStream->w3d(scale,scale,scale*(1.0-zValue), -+ xStart, xEnd, yStart, yEnd, zStart, zEnd, -+ alt, az); -+ -+ -+ //Draw 3d mesh before axes -+ // PLOT ONLY IF NODATA=0 -+ if (!nodata) -+ { -+ //use of intermediate map for correct handling of blanking values and nans. -+ PLFLT ** map; -+ actStream->Alloc2dGrid( &map, xEl, yEl); -+ for ( SizeT i=0, k=0; i mav) v=mav; -+ } -+ else -+ { -+ if ( !isfinite(v) ) v=minVal; -+ if ( hasMinVal && v < minVal) v=minVal; -+ if ( hasMaxVal && v > maxVal) v=maxVal; -+ } -+ map[i][j] = v; -+ } -+ } -+ // 1 types of grid only: 1D X and Y. -+ PLcGrid cgrid1; // X and Y independent deformation -+ PLFLT* xg1; -+ PLFLT* yg1; -+ xg1 = new PLFLT[xEl]; -+ yg1 = new PLFLT[yEl]; -+ cgrid1.xg = xg1; -+ cgrid1.yg = yg1; -+ cgrid1.nx = xEl; -+ cgrid1.ny = yEl; -+ for ( SizeT i=0; i0?log10(cgrid1.xg[i]):1E-12; // #define EXTENDED_DEFAULT_LOGRANGE 12 -+ if (yLog) for ( SizeT i=0; i0?log10(cgrid1.yg[i]):1E-12; -+ -+ // Important: make all clipping computations BEFORE setting graphic properties (color, size) -+ bool doClip=(e->KeywordSet("CLIP")||e->KeywordSet("NOCLIP")); -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, false)==TRUE ) stopClip=true; -+ -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ //mesh option -+ PLINT meshOpt; -+ actStream->lightsource(lightSourcePos[0]*scale*(xEnd-xStart),lightSourcePos[1]*scale*(yEnd-yStart), -+ lightSourcePos[2]*scale*(1.0-zValue)*(zEnd-zStart)); -+ meshOpt=(doShade)?MAG_COLOR:0; -+ if (e->KeywordSet ( "SKIRT" )) meshOpt+=DRAW_SIDES; -+ actStream->surf3d(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt,NULL,0); -+ -+ if (stopClip) stopClipping(actStream); -+//Clean alllocated data struct -+ delete[] xg1; -+ delete[] yg1; -+ actStream->Free2dGrid(map, xEl, yEl); -+ } -+ //Draw axes with normal color! -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); //COLOR -+ gdlBox3(e, actStream, xStart, xEnd, yStart, yEnd, zStart, zEnd, xLog, yLog, zLog, true); -+ } -+ -+ private: -+ -+ void call_plplot (EnvT* e, GDLGStream* actStream) -+ { -+ } -+ -+ private: -+ -+ virtual void post_call (EnvT*, GDLGStream* actStream) -+ { -+ actStream->lsty(1);//reset linestyle -+ actStream->sizeChar(1.0); -+ } -+ -+ }; // SHADE_SURF_call class -+ -+ void shade_surf(EnvT* e) -+ { -+ shade_surf_call shade_surf; -+ shade_surf.call(e, 1); -+ } -+ -+ void set_shading(EnvT* e) -+ { -+ DDoubleGDL *light; -+ int lightIx=e->KeywordIx ( "LIGHT" ); -+ if ( e->GetKW ( lightIx )!=NULL ) -+ { -+ light=e->GetKWAs( lightIx ); -+ if (light->N_Elements()>3) e->Throw("Keyword array parameter LIGHT must have from 1 to 3 elements."); -+ for (SizeT i=0; i< light->N_Elements(); ++i) lightSourcePos[i]=(*light)[i]; -+ } -+ } -+} // namespace -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_surface.cpp gdl/src/plotting_surface.cpp ---- gdl-0.9.3/src/plotting_surface.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_surface.cpp 2013-07-31 09:41:44.202244781 -0600 -@@ -17,511 +17,437 @@ - - #include "includefirst.hpp" - #include "plotting.hpp" -+#include "math_utl.hpp" - --namespace lib { -+namespace lib -+{ -+ -+ //XRANGE etc behaviour not as IDL (in some ways, better!) -+ //TBD: LEGO - - using namespace std; - -- class surface_call : public plotting_routine_call -+// shared parameter -+ class surface_call: public plotting_routine_call - { -- DDouble xStart, xEnd, yStart, yEnd, zStart, zEnd; -- bool xLog, yLog, zLog; - DDoubleGDL *zVal, *yVal, *xVal; -- auto_ptr xval_guard, yval_guard; -+ Guard xval_guard, yval_guard, p0_guard; - SizeT xEl, yEl, zEl; -- -- private: bool handle_args(EnvT* e) // {{{ -+ DDouble xStart, xEnd, yStart, yEnd, zStart, zEnd, datamax, datamin; -+ bool nodata; -+ bool setZrange; -+ bool xLog; -+ bool yLog; -+ bool zLog; -+ ORIENTATION3D axisExchangeCode; -+ private: -+ bool handle_args (EnvT* e) - { -+ xLog=e->KeywordSet ( "XLOG" ); -+ yLog=e->KeywordSet ( "YLOG" ); -+ zLog=e->KeywordSet ( "ZLOG" ); -+ if ( nParam ( )==1 ) -+ { -+ if ( (e->GetNumericArrayParDefined ( 0 ))->Rank ( )!=2 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ -+ BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL ); -+ zVal=static_cast -+ ( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) ); -+ p0_guard.reset ( p0 ); // delete upon exit -+ -+ if ( zVal->Rank ( )!=2 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ -+ xEl=zVal->Dim ( 1 ); -+ yEl=zVal->Dim ( 0 ); -+ -+ xVal=new DDoubleGDL ( dimension ( xEl ), BaseGDL::INDGEN ); -+ xval_guard.reset ( xVal ); // delete upon exit -+ if (xLog) xVal->Inc(); -+ yVal=new DDoubleGDL ( dimension ( yEl ), BaseGDL::INDGEN ); -+ yval_guard.reset ( yVal ); // delete upon exit -+ if (yLog) yVal->Inc(); -+ } -+ else if ( nParam ( )==2||nParam ( )>3 ) -+ { -+ e->Throw ( "Incorrect number of arguments." ); -+ } -+ else -+ { -+ BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL ); -+ zVal=static_cast -+ ( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) ); -+ p0_guard.reset ( p0 ); // delete upon exit -+ -+ if ( zVal->Rank ( )!=2 ) -+ e->Throw ( "Array must have 2 dimensions: " -+ +e->GetParString ( 0 ) ); -+ xVal=e->GetParAs< DDoubleGDL>( 1 ); -+ yVal=e->GetParAs< DDoubleGDL>( 2 ); - -- if (nParam() == 2 || nParam() > 3) -- e->Throw( "Incorrect number of arguments."); -- -- BaseGDL* p0 = e->GetNumericArrayParDefined( 0)->Transpose( NULL); -- auto_ptr p0_guard; -- zVal = static_cast (p0->Convert2( GDL_DOUBLE, BaseGDL::COPY)); -- p0_guard.reset( p0); // delete upon exit -- -- if(zVal->Dim(0) == 1) -- e->Throw( "Array must have 2 dimensions:" +e->GetParString(0)); -- -- xEl = zVal->Dim(1); -- yEl = zVal->Dim(0); -- if (nParam() == 1) -- { -- xVal = new DDoubleGDL( dimension( xEl), BaseGDL::INDGEN); -- xval_guard.reset( xVal); // delete upon exit -- yVal = new DDoubleGDL( dimension( yEl), BaseGDL::INDGEN); -- yval_guard.reset( yVal); // delete upon exit -- } -- -- if (nParam() == 3) -- { -- -- xVal = e->GetParAs< DDoubleGDL>( 1); -- yVal = e->GetParAs< DDoubleGDL>( 2); -- -- if (xVal->Rank() > 2) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- -- if (yVal->Rank() > 2) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- -- if (xVal->Rank() == 1) { -- if (xEl != xVal->Dim(0)) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- } -- -- if (yVal->Rank() == 1) { -- if (yEl != yVal->Dim(0)) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -- } -+ if ( xVal->Rank ( )!=1 ) -+ e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" ); -+ -+ if ( yVal->Rank ( )!=1 ) -+ e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" ); -+ -+ if ( xVal->Rank ( )==1 ) -+ { -+ xEl=xVal->Dim ( 0 ); - -- if (xVal->Rank() == 2) { -- if((xVal->Dim(0) != xEl) && (xVal->Dim(1) != yEl)) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -+ if ( xEl!=zVal->Dim ( 1 ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); - } -- -- if (yVal->Rank() == 2) -+ -+ if ( yVal->Rank ( )==1 ) - { -- if((yVal->Dim(0) != xEl) && (yVal->Dim(1) != yEl)) -- e->Throw( "X, Y, or Z array dimensions are incompatible."); -+ yEl=yVal->Dim ( 0 ); -+ -+ if ( yEl!=zVal->Dim ( 0 ) ) -+ e->Throw ( "X, Y, or Z array dimensions are incompatible." ); - } -+ - } -- return false; -- } // }}} - -- private: void old_body( EnvT* e, GDLGStream* actStream) // {{{ -- { -+ GetMinMaxVal ( xVal, &xStart, &xEnd ); -+ GetMinMaxVal ( yVal, &yStart, &yEnd ); -+ //XRANGE and YRANGE overrides all that, but Start/End should be recomputed accordingly -+ DDouble xAxisStart, xAxisEnd, yAxisStart, yAxisEnd; -+ bool setx=gdlGetDesiredAxisRange(e, "X", xAxisStart, xAxisEnd); -+ bool sety=gdlGetDesiredAxisRange(e, "Y", yAxisStart, yAxisEnd); -+ if(setx && sety) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+ } -+ else if (sety) -+ { -+ yStart=yAxisStart; -+ yEnd=yAxisEnd; -+ } -+ else if (setx) -+ { -+ xStart=xAxisStart; -+ xEnd=xAxisEnd; -+ //must compute min-max for other axis! -+ { -+ gdlDoRangeExtrema(xVal,yVal,yStart,yEnd,xStart,xEnd); -+ } -+ } -+ #undef UNDEF_RANGE_VALUE -+ // z range -+ datamax=0.0; -+ datamin=0.0; -+ GetMinMaxVal ( zVal, &datamin, &datamax ); -+ zStart=datamin; -+ zEnd=datamax; -+ setZrange = gdlGetDesiredAxisRange(e, "Z", zStart, zEnd); - -- // !P -- DLong p_background, p_noErase, p_color, p_psym, p_linestyle; -- DFloat p_symsize, p_charsize, p_thick, p_ticklen; -- DString p_title, p_subTitle; -- -- GetPData( p_background, -- p_noErase, p_color, p_psym, p_linestyle, -- p_symsize, p_charsize, p_thick, -- p_title, p_subTitle, p_ticklen); -- -- // !X, !Y, !Z (also used below) -- static DStructGDL* xStruct = SysVar::X(); -- static DStructGDL* yStruct = SysVar::Y(); -- static DStructGDL* zStruct = SysVar::Z(); -- -- DLong xStyle, yStyle, zStyle; -- DString xTitle, yTitle, zTitle; -- DFloat x_CharSize, y_CharSize, z_CharSize; -- DFloat xMarginL, xMarginR, yMarginB, yMarginF, zMarginB, zMarginT; -- DFloat xTicklen, yTicklen, zTicklen; -- -- GetAxisData( xStruct, xStyle, xTitle, x_CharSize, xMarginL, xMarginR, xTicklen); -- GetAxisData( yStruct, yStyle, yTitle, y_CharSize, yMarginB, yMarginF, yTicklen); -- GetAxisData( zStruct, zStyle, zTitle, z_CharSize, zMarginB, zMarginT, zTicklen); -- -- // [XY]STYLE -- e->AssureLongScalarKWIfPresent( "XSTYLE", xStyle); -- e->AssureLongScalarKWIfPresent( "YSTYLE", yStyle); -- e->AssureLongScalarKWIfPresent( "ZSTYLE", zStyle); -- -- // TITLE -- DString title = p_title; -- DString subTitle = p_subTitle; -- e->AssureStringScalarKWIfPresent( "TITLE", title); -- e->AssureStringScalarKWIfPresent( "SUBTITLE", subTitle); -- -- // AXIS TITLE -- e->AssureStringScalarKWIfPresent( "XTITLE", xTitle); -- e->AssureStringScalarKWIfPresent( "YTITLE", yTitle); -- e->AssureStringScalarKWIfPresent( "ZTITLE", zTitle); -- -- // MARGIN (in characters) -- static int xMarginEnvIx = e->KeywordIx( "XMARGIN"); -- static int yMarginEnvIx = e->KeywordIx( "YMARGIN"); -- static int zMarginEnvIx = e->KeywordIx( "ZMARGIN"); -- BaseGDL* xMargin = e->GetKW( xMarginEnvIx); -- BaseGDL* yMargin = e->GetKW( yMarginEnvIx); -- BaseGDL* zMargin = e->GetKW( zMarginEnvIx); -- if( xMargin != NULL) -- { -- if( xMargin->N_Elements() > 2) -- e->Throw( "Keyword array parameter XMARGIN" -- " must have from 1 to 2 elements."); -- auto_ptr guard; -- DFloatGDL* xMarginFl = static_cast -- ( xMargin->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( xMarginFl); -- xMarginL = (*xMarginFl)[0]; -- if( xMarginFl->N_Elements() > 1) -- xMarginR = (*xMarginFl)[1]; -- } -- if( yMargin != NULL) -- { -- if( yMargin->N_Elements() > 2) -- e->Throw( "Keyword array parameter YMARGIN" -- " must have from 1 to 2 elements."); -- auto_ptr guard; -- DFloatGDL* yMarginFl = static_cast -- ( yMargin->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( yMarginFl); -- yMarginB = (*yMarginFl)[0]; -- if( yMarginFl->N_Elements() > 1) -- yMarginF = (*yMarginFl)[1]; -- } -- if( zMargin != NULL) -- { -- if( zMargin->N_Elements() > 2) -- e->Throw( "Keyword array parameter ZMARGIN" -- " must have from 1 to 2 elements."); -- auto_ptr guard; -- DFloatGDL* zMarginFl = static_cast -- ( zMargin->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( zMarginFl); -- zMarginB = (*zMarginFl)[0]; -- if( zMarginFl->N_Elements() > 1) -- zMarginT = (*zMarginFl)[1]; -- } -- -- // x and y and z range -- GetMinMaxVal( xVal, &xStart, &xEnd); -- GetMinMaxVal( yVal, &yStart, &yEnd); -- GetMinMaxVal( zVal, &zStart, &zEnd); -- -- xLog = e->KeywordSet( "XLOG"); -- yLog = e->KeywordSet( "YLOG"); -- zLog = e->KeywordSet( "ZLOG"); -- -- if ((xStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(xStart, xEnd, false, xLog ); -- } -- -- if ((yStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(yStart, yEnd, false, yLog ); -- } -- -- if ((zStyle & 1) != 1) { -- PLFLT intv = AutoIntvAC(zStart, zEnd, false, zLog ); -+ return false; - } - -- //[x|y|z]range keyword -- static int zRangeEnvIx = e->KeywordIx("ZRANGE"); -- static int yRangeEnvIx = e->KeywordIx("YRANGE"); -- static int xRangeEnvIx = e->KeywordIx("XRANGE"); -- BaseGDL* xRange = e->GetKW( xRangeEnvIx); -- BaseGDL* yRange = e->GetKW( yRangeEnvIx); -- BaseGDL* zRange = e->GetKW( zRangeEnvIx); -- -- if(xRange != NULL) -- { -- if(xRange->N_Elements() != 2) -- e->Throw("Keyword array parameter XRANGE" -- " must have 2 elements."); -- auto_ptr guard; -- DFloatGDL* xRangeF = static_cast -- ( xRange->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( xRangeF); -- xStart = (*xRangeF)[0]; -- xEnd = (*xRangeF)[1]; -- } -- -- if(yRange != NULL) -- { -- if(yRange->N_Elements() != 2) -- e->Throw("Keyword array parameter YRANGE" -- " must have 2 elements."); -- auto_ptr guard; -- DFloatGDL* yRangeF = static_cast -- ( yRange->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( yRangeF); -- yStart = (*yRangeF)[0]; -- yEnd = (*yRangeF)[1]; -- } -- if(zRange != NULL) -- { -- if(zRange->N_Elements() != 2) -- e->Throw("Keyword array parameter ZRANGE" -- " must have 2 elements."); -- auto_ptr guard; -- DFloatGDL* zRangeF = static_cast -- ( zRange->Convert2( GDL_FLOAT, BaseGDL::COPY)); -- guard.reset( zRangeF); -- zStart = (*zRangeF)[0]; -- zEnd = (*zRangeF)[1]; -- } -- -- // AC is it useful ? Why not for Y ? -- //if(xEnd == xStart) xEnd=xStart+1; -- -- DDouble minVal = zStart; -- DDouble maxVal = zEnd; -- e->AssureDoubleScalarKWIfPresent( "MIN_VALUE", minVal); -- e->AssureDoubleScalarKWIfPresent( "MAX_VALUE", maxVal); -- -- if( xLog && xStart <= 0.0) -- Warning( "SURFACE: Infinite x plot range."); -- if( yLog && yStart <= 0.0) -- Warning( "SURFACE: Infinite y plot range."); -- if( zLog && zStart <= 0.0) -- Warning( "SURFACE: Infinite z plot range."); -- -- DLong noErase = p_noErase; -- if( e->KeywordSet( "NOERASE")) noErase = 1; -- -- DDouble ticklen = p_ticklen; -- e->AssureDoubleScalarKWIfPresent( "TICKLEN", ticklen); -- -- // POSITION -- PLFLT xScale = 1.0; -- PLFLT yScale = 1.0; -- // PLFLT scale = 1.0; -- static int positionIx = e->KeywordIx( "POSITION"); -- DFloatGDL* pos = e->IfDefGetKWAs( positionIx); -- /* -- PLFLT position[ 4] = { 0.0, 0.0, 1.0, 1.0}; -- if( pos != NULL) -- { -- for( SizeT i=0; i<4 && iN_Elements(); ++i) -- position[ i] = (*pos)[ i]; -- -- xScale = position[2]-position[0]; -- yScale = position[3]-position[1]; -- // scale = sqrt( pow( xScale,2) + pow( yScale,2)); -- } -- */ -- -- // CHARSIZE -- DDouble charsize = p_charsize; -- e->AssureDoubleScalarKWIfPresent( "CHARSIZE", charsize); -- if( charsize <= 0.0) charsize = 1.0; -- // charsize *= scale; -- -- // AXIS CHARSIZE -- DDouble xCharSize = x_CharSize; -- e->AssureDoubleScalarKWIfPresent( "XCHARSIZE", xCharSize); -- if( xCharSize <= 0.0) xCharSize = 1.0; -- -- DDouble yCharSize = y_CharSize; -- e->AssureDoubleScalarKWIfPresent( "YCHARSIZE", yCharSize); -- if( yCharSize <= 0.0) yCharSize = 1.0; -- // yCharSize *= scale; -- -- DDouble zCharSize = z_CharSize; -- e->AssureDoubleScalarKWIfPresent( "ZCHARSIZE", zCharSize); -- if( zCharSize <= 0.0) zCharSize = 1.0; -- -- -- // THICK -- DFloat thick = p_thick; -- e->AssureFloatScalarKWIfPresent( "THICK", thick); -- -- // *** start drawing -- gkw_background(e, actStream); //BACKGROUND -- gkw_color(e, actStream); //COLOR -- -- actStream->NextPlot( !noErase); -- if( !noErase) actStream->Clear(); -- -- // plplot stuff -- // set the charsize (scale factor) -- DDouble charScale = 1.0; -- DLongGDL* pMulti = SysVar::GetPMulti(); -- if( (*pMulti)[1] > 2 || (*pMulti)[2] > 2) charScale = 0.5; -- actStream->schr( 0.0, charsize * charScale); -- --#if 0 -- // get subpage in mm -- PLFLT scrXL, scrXR, scrYB, scrYF; -- actStream->gspa( scrXL, scrXR, scrYB, scrYF); -- PLFLT scrX = scrXR-scrXL; -- PLFLT scrY = scrYF-scrYB; --#endif -+ private: -+#define DPI (double)(4*atan(1.0)) -+#define DEGTORAD DPI/180.0 - -- // get char size in mm (default, actual) -- PLFLT defH, actH; -- actStream->gchr( defH, actH); -- -- // CLIPPING -- DDoubleGDL* clippingD=NULL; -- DLong noclip=0; -- e->AssureLongScalarKWIfPresent( "NOCLIP", noclip); -- if(noclip == 0) -- { -- static int clippingix = e->KeywordIx( "CLIP"); -- clippingD = e->IfDefGetKWAs( clippingix); -- } -- -- --#if 0 -- // viewport and world coordinates -- bool okVPWC = SetVP_WC( e, actStream, pos, clippingD, -- xLog, yLog, -- xMarginL, xMarginR, yMarginB, yMarginT, -- xStart, xEnd, minVal, maxVal,(DLong)0); -- if( !okVPWC) return; -+ void old_body (EnvT* e, GDLGStream* actStream) // {{{ -+ { -+ //projection: would work only with 2D X and Y. Not supported here -+ bool mapSet=false; -+#ifdef USE_LIBPROJ4 -+ static LPTYPE idata; -+ static XYTYPE odata; -+ static PROJTYPE* ref; -+ get_mapset ( mapSet ); -+ if ( mapSet ) -+ { // do nothing -+// ref=map_init ( ); -+// if ( ref==NULL ) e->Throw ( "Projection initialization failed." ); -+ // but warn that projection is not taken into account -+ Warning ( "SURFACE: Projection is set, but not taken into account (ony 1d X and Y) (FIX plplot first!)." ); -+ } - #endif -- -+ //T3D -+ static int t3dIx = e->KeywordIx( "T3D"); -+ bool doT3d=(e->KeywordSet(t3dIx)|| T3Denabled(e)); -+ //ZVALUE -+ static int zvIx = e->KeywordIx( "ZVALUE"); -+ DDouble zValue=0.0; -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ zValue=min(zValue,0.999999); //to avoid problems with plplot -+ //SAVE -+ static int savet3dIx = e->KeywordIx( "SAVE"); -+ bool saveT3d=e->KeywordSet(savet3dIx); -+ //NODATA -+ static int nodataIx = e->KeywordIx( "NODATA"); -+ nodata=e->KeywordSet(nodataIx); -+ //SHADES -+ static int shadesIx = e->KeywordIx( "SHADES"); -+ BaseGDL* shadevalues=e->GetKW ( shadesIx ); -+ bool doShade=(shadevalues != NULL); //... But 3d mesh will be colorized anyway! -+ if (doShade) Warning ( "SHADE_SURF: Using Fixed (Z linear) Shade Values Only (FIXME)." ); -+ -+ // [XYZ]STYLE -+ DLong xStyle=0, yStyle=0, zStyle=0; ; -+ gdlGetDesiredAxisStyle(e, "X", xStyle); -+ gdlGetDesiredAxisStyle(e, "Y", yStyle); -+ gdlGetDesiredAxisStyle(e, "Z", zStyle); -+ -+ //check here since after AutoIntvAC values will be good but arrays passed -+ //to plplot will be bad... -+ if ( xLog && xStart<=0.0 ) -+ { -+ Warning ( "SURFACE: Infinite x plot range." ); -+ nodata=true; -+ } -+ if ( yLog && yStart<=0.0 ) -+ { -+ Warning ( "SURFACE: Infinite y plot range." ); -+ nodata=true; -+ } -+ if ( zLog && zStart<=0.0 ) Warning ( "SURFACE: Infinite z plot range." ); - -- //linestyle -- DLong linestyle = p_linestyle ; -- DLong temp_linestyle=0; -- e->AssureLongScalarKWIfPresent( "LINESTYLE", temp_linestyle); -- -- /* -- if((temp_linestyle > 0) && (temp_linestyle < 9) ) -- linestyle=temp_linestyle; -- else if((linestyle > 0) && (linestyle < 9) ) -- linestyle=linestyle+1; -- else -- linestyle=1; -- */ -- -- linestyle=temp_linestyle+1; -- -- // pen thickness for axis -- actStream->wid( 0); -- -- // axis -- string xOpt = "bcnst"; -- string yOpt = "bcnstv"; -- -- if( xLog) xOpt += "l"; -- if( yLog) yOpt += "l"; -- --#if 0 -- // axis titles -- actStream->schr( 0.0, actH/defH * xCharSize); -- actStream->mtex("b",3.5,0.5,0.5,xTitle.c_str()); -- // the axis (separate for x and y axis because of charsize) -- actStream->box( xOpt.c_str(), 0.0, 0, "", 0.0, 0); -- -- actStream->schr( 0.0, actH/defH * yCharSize); -- actStream->mtex("l",5.0,0.5,0.5,yTitle.c_str()); -- // the axis (separate for x and y axis because of charsize) -- actStream->box( "", 0.0, 0, yOpt.c_str(), 0.0, 0); --#endif - -- // pen thickness for plot -- actStream->wid( static_cast(floor( thick-0.5))); -+ if ( ( xStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( xStart, xEnd, xLog ); -+ } -+ -+ if ( ( yStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( yStart, yEnd, yLog ); -+ } - -+ bool hasMinVal=e->KeywordPresent("MIN_VALUE"); -+ bool hasMaxVal=e->KeywordPresent("MAX_VALUE"); -+ DDouble minVal=datamin; -+ DDouble maxVal=datamax; -+ e->AssureDoubleScalarKWIfPresent ( "MIN_VALUE", minVal ); -+ e->AssureDoubleScalarKWIfPresent ( "MAX_VALUE", maxVal ); -+ -+ if (!setZrange) { -+ zStart=max(minVal,zStart); -+ zEnd=min(zEnd,maxVal); -+ } -+ -+ // then only apply expansion of axes: -+ if ( ( zStyle&1 )!=1 ) -+ { -+ PLFLT intv=AutoIntvAC ( zStart, zEnd, zLog ); -+ } - -- // plot the data -- actStream->lsty(linestyle); -+ // background BEFORE next plot since it is the only place plplot may redraw the background... -+ gdlSetGraphicsBackgroundColorFromKw ( e, actStream ); //BACKGROUND -+ gdlNextPlotHandlingNoEraseOption(e, actStream); //NOERASE - -- actStream->vpor(0.0, 1.0, 0.0, .9); -- // actStream->wind(-0.8, 0.8, -0.8, .8); -- actStream->wind( -1.0, 1.0, -0.9, 2.0 ); -- // actStream->wind(-1.0, 1.0, -1.0, 1.5); -- -- PLFLT alt = 30.0; -- DFloat alt_change = alt; -- e->AssureFloatScalarKWIfPresent( "AX", alt_change); -- alt=alt_change; -- -- PLFLT az = 30.0; -- DFloat az_change = az; -- e->AssureFloatScalarKWIfPresent( "AZ", az_change); -- az=az_change; -- -- actStream->w3d( 1.2, 1.2, 2.2, // TODO! -- xStart, xEnd, yStart, yEnd, minVal, maxVal, -- alt, az); -- -- actStream->box3( "bnstu", xTitle.c_str(), 0.0, 0, -- "bnstu", yTitle.c_str(), 0.0, 0, -- "bcdmnstuv", zTitle.c_str(), 0.0, 4 ); -- -- -- // 1 DIM X & Y -- if (xVal->Rank() == 1 && yVal->Rank() == 1) { -- -- PLFLT** z; -- actStream->Alloc2dGrid(&z,xEl,yEl); -- for( SizeT ii=0; iimesh(static_cast (&(*xVal)[0]), -- static_cast (&(*yVal)[0]), -- z, (long int) xEl, (long int) yEl, 3); -- //delete[] z; -- if (z != NULL) { free((void *) z); z = NULL; } -- } -- -- // 2 DIM X & Y -- if (xVal->Rank() == 2 && yVal->Rank() == 2) { -- -- PLFLT** z1 = new PLFLT*[xEl]; -- PLFLT* xVec1 = new PLFLT[xEl]; -- PLFLT* yVec1 = new PLFLT[xEl]; -- -- for( SizeT j=0; jmesh(xVec1, yVec1, z1, (long int) xEl, 1,1); -- } -- delete[] z1; -- delete[] xVec1; -- delete[] yVec1; -- -- // -- PLFLT** z2 = new PLFLT*[yEl]; -- PLFLT* xVec2 = new PLFLT[yEl]; -- PLFLT* yVec2 = new PLFLT[yEl]; -- -- for( SizeT j=0; jmesh(xVec2, yVec2, z2, 1, (long int) yEl, 2); -- } -- delete[] z2; -- delete[] xVec2; -- delete[] yVec2; -- } -- -- // TODO: not sure if this is also valid for 3D? -- UpdateSWPlotStructs(actStream, xStart, xEnd, yStart, yEnd, xLog, yLog); -- -- // title and sub title -- actStream->schr( 0.0, 1.25*actH/defH); -- actStream->mtex("t",1.25,0.5,0.5,title.c_str()); -- actStream->schr( 0.0, actH/defH); // charsize is reset here -- actStream->mtex("b",5.4,0.5,0.5,subTitle.c_str()); -- -- } // }}} -- -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -- { -- } // }}} -+ gdlSetPlotCharsize(e, actStream); - -- private: virtual void post_call(EnvT*, GDLGStream* actStream) // {{{ -+ // Deal with T3D options -- either present and we have to deduce az and alt contained in it, -+ // or absent and we have to compute !P.T from az and alt. -+ -+ PLFLT alt=30.0; -+ PLFLT az=30.0; -+ //set az and ax (alt) -+ DFloat alt_change=alt; -+ e->AssureFloatScalarKWIfPresent("AX", alt_change); -+ alt=alt_change; -+ -+ alt=fmod(alt,360.0); //restrict between 0 and 90 for plplot! -+ if (alt > 90.0 || alt < 0.0) -+ { -+ e->Throw ( "SURFACE: AX restricted to [0-90] range by plplot (fix plplot!)" ); -+ } -+ DFloat az_change=az; -+ e->AssureFloatScalarKWIfPresent("AZ", az_change); -+ az=az_change; -+ -+ //now we are in plplot different kind of 3d -+ DDoubleGDL* plplot3d; -+ DDouble ay, scale; //not useful at this time -+ if (doT3d) //convert to this world... -+ { -+ -+ plplot3d=gdlConvertT3DMatrixToPlplotRotationMatrix(zValue, az, alt, ay, scale, axisExchangeCode); -+ if (plplot3d == NULL) -+ { -+ e->Throw ( "SURFACE: Illegal 3D transformation." ); -+ } -+ } -+ else //make the transformation ourselves -+ { -+ scale=1/sqrt(3); -+ //Compute transformation matrix with plplot conventions: -+ plplot3d=gdlComputePlplotRotationMatrix( az, alt, zValue,scale); -+ // save !P.T if asked to... -+ if (saveT3d) //will use ax and az values... -+ { -+ DDoubleGDL* t3dMatrix=plplot3d->Dup(); -+ SelfTranspose3d(t3dMatrix); -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned tTag=pStruct->Desc()->TagIndex("T"); -+ for (int i=0; iN_Elements(); ++i )(*static_cast(pStruct->GetTag(tTag, 0)))[i]=(*t3dMatrix)[i]; -+ GDLDelete(t3dMatrix); -+ } -+ } -+ -+ if ( gdlSet3DViewPortAndWorldCoordinates(e, actStream, plplot3d, xLog, yLog, -+ xStart, xEnd, yStart, yEnd, zStart, zEnd, zLog)==FALSE ) return; -+ -+ gdlSetPlotCharthick(e,actStream); -+ -+ -+ if (xLog) xStart=log10(xStart); -+ if (yLog) yStart=log10(yStart); -+ if (zLog) zStart=log10(zStart); -+ if (xLog) xEnd=log10(xEnd); -+ if (yLog) yEnd=log10(yEnd); -+ if (zLog) zEnd=log10(zEnd); -+ -+ actStream->w3d(scale,scale,scale*(1.0-zValue), -+ xStart, xEnd, yStart, yEnd, zStart, zEnd, -+ alt, az); -+ -+ -+ bool up=e->KeywordSet ( "UPPER_ONLY" ); -+ bool low=e->KeywordSet ( "LOWER_ONLY" ); -+ if (up && low) nodata=true; //IDL behaviour -+ -+ DLong bottomColorIndex=-1; -+ e->AssureLongScalarKWIfPresent("BOTTOM", bottomColorIndex); -+ -+ //Draw 3d mesh before axes -+ // PLOT ONLY IF NODATA=0 -+ if (!nodata) -+ { -+ //use of intermediate map for correct handling of blanking values and nans. -+ PLFLT ** map; -+ actStream->Alloc2dGrid( &map, xEl, yEl); -+ for ( SizeT i=0, k=0; i mav) v=mav; -+ } -+ else -+ { -+ if ( !isfinite(v) ) v=minVal; -+ if ( hasMinVal && v < minVal) v=minVal; -+ if ( hasMaxVal && v > maxVal) v=maxVal; -+ } -+ map[i][j] = v; -+ } -+ } -+ // 1 types of grid only: 1D X and Y. -+ PLcGrid cgrid1; // X and Y independent deformation -+ PLFLT* xg1; -+ PLFLT* yg1; -+ xg1 = new PLFLT[xEl]; -+ yg1 = new PLFLT[yEl]; -+ cgrid1.xg = xg1; -+ cgrid1.yg = yg1; -+ cgrid1.nx = xEl; -+ cgrid1.ny = yEl; -+ for ( SizeT i=0; i0?log10(cgrid1.xg[i]):1E-12; // #define EXTENDED_DEFAULT_LOGRANGE 12 -+ if (yLog) for ( SizeT i=0; i0?log10(cgrid1.yg[i]):1E-12; -+ -+ // Important: make all clipping computations BEFORE setting graphic properties (color, size) -+ bool doClip=(e->KeywordSet("CLIP")||e->KeywordSet("NOCLIP")); -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, false)==TRUE ) stopClip=true; -+ -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ //mesh option -+ PLINT meshOpt; -+ meshOpt=DRAW_LINEXY; -+ if (e->KeywordSet ( "HORIZONTAL" )) meshOpt=DRAW_LINEX; -+ if (e->KeywordSet ( "SKIRT" )) meshOpt+=DRAW_SIDES; -+ //mesh plots both sides, so use it when UPPER_ONLY is not set. -+ //if UPPER_ONLY is set, use plot3d/plot3dc -+ //if LOWER_ONLY is set, use mesh/meshc and remove by plot3d! -+ //in not up not low: mesh since mesh plots both sides -+ if (up) -+ { -+ if (doShade) -+ actStream->plot3dc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt+MAG_COLOR,NULL,0); -+ else -+ actStream->plot3dc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt,NULL,0); -+ } -+ else //mesh (both sides) but contains 'low' (remove top) and/or bottom -+ { -+ if (bottomColorIndex!=-1) -+ { -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream, "BOTTOM" ); -+ actStream->meshc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt,NULL,0); -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ if (!low) //redraw top with top color -+ { -+ if (doShade) actStream->plot3dc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt+MAG_COLOR,NULL,0); -+ else actStream->plot3dc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt,NULL,0); -+ } -+ } -+ else -+ { -+ if (doShade) actStream->meshc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt+MAG_COLOR,NULL,0); -+ else actStream->meshc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt,NULL,0); -+ } -+ //redraw upper part with background color to remove it... Not 100% satisfying though. -+ if (low) -+ { -+ if (e->KeywordSet ( "SKIRT" )) meshOpt-=DRAW_SIDES; -+ gdlSetGraphicsPenColorToBackground(actStream); -+ actStream->plot3dc(xg1,yg1,map,cgrid1.nx,cgrid1.ny,meshOpt,NULL,0); -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); -+ } -+ } -+ -+ if (stopClip) stopClipping(actStream); -+//Clean alllocated data struct -+ delete[] xg1; -+ delete[] yg1; -+ actStream->Free2dGrid(map, xEl, yEl); -+ } -+ //Draw axes with normal color! -+ gdlSetGraphicsForegroundColorFromKw ( e, actStream ); //COLOR -+ gdlBox3(e, actStream, xStart, xEnd, yStart, yEnd, zStart, zEnd, xLog, yLog, zLog, true); -+ } -+ -+ private: -+ -+ void call_plplot (EnvT* e, GDLGStream* actStream) - { -- actStream->lsty(1);//reset linestyle -+ } - -- // set ![XY].CRANGE -- set_axis_crange("X", xStart, xEnd, xLog); -- set_axis_crange("Y", yStart, yEnd, yLog); -- set_axis_crange("Z", zStart, zEnd, zLog); -- -- //set ![x|y].type -- set_axis_type("X", xLog); -- set_axis_type("Y", yLog); -- set_axis_type("Z", zLog); -- } // }}} -+ private: - -- }; // surface_call class -+ virtual void post_call (EnvT*, GDLGStream* actStream) -+ { -+ actStream->lsty(1);//reset linestyle -+ actStream->sizeChar(1.0); -+ } -+ -+ }; // surface_call class - - void surface(EnvT* e) - { - surface_call surface; - surface.call(e, 1); - } -- --} // namespace -+} // namespace -\ No newline at end of file -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_windows.cpp gdl/src/plotting_windows.cpp ---- gdl-0.9.3/src/plotting_windows.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_windows.cpp 2013-06-03 14:22:52.000000000 -0600 -@@ -61,7 +61,7 @@ - title = "GDL "+i2s( wIx); - } - -- DLong xPos=0, yPos=0; -+ DLong xPos=-1, yPos=-1; - e->AssureLongScalarKWIfPresent( "XPOS", xPos); - e->AssureLongScalarKWIfPresent( "YPOS", yPos); - -@@ -69,7 +69,7 @@ - #ifdef HAVE_X - DeviceX::DefaultXYSize(&xSize, &ySize); - #else -- xSize = 640; -+ xSize = 640; - ySize = 512; - #endif - e->AssureLongScalarKWIfPresent( "XSIZE", xSize); -@@ -80,8 +80,7 @@ - cout << "xPos/yPos :"<< xPos << " " << yPos << endl; - cout << "xSize/ySize :"<< xSize << " " << ySize << endl; - } -- -- if( xSize <= 0 || ySize <= 0 || xPos < 0 || yPos < 0) -+ if( xSize <= 0 || ySize <= 0 || xPos < -1 || yPos < -1) - e->Throw( "Unable to create window " - "(BadValue (integer parameter out of range for " - "operation))."); -@@ -89,7 +88,18 @@ - bool success = actDevice->WOpen( wIx, title, xSize, ySize, xPos, yPos); - if( !success) - e->Throw( "Unable to create window."); -- } -+ success = actDevice->CursorCrosshair(); -+ success = actDevice->UnsetFocus(); -+ bool doretain=true; -+ DLong retainType ; //=Graphics::getRetain(); -+// if (retainType=0) doretain=false; -+ if( e->KeywordPresent( 3)) // RETAIN -+ { -+ e->AssureLongScalarKWIfPresent( "RETAIN", retainType); -+ if (retainType=0) doretain=false; -+ } -+ success = actDevice->EnableBackingStore(doretain); -+ } - - void wset( EnvT* e) - { -@@ -113,12 +123,15 @@ - #ifdef HAVE_X - DeviceX::DefaultXYSize(&xSize, &ySize); - #else -- xSize = 640; -+ xSize = 640; - ySize = 512; - #endif -- bool success = actDevice->WOpen( 0, "GDL 0", xSize, ySize, 0, 0); -+ bool success = actDevice->WOpen( 0, "GDL 0", xSize, ySize, -1, -1); - if( !success) - e->Throw( "Unable to create window."); -+ success = actDevice->CursorCrosshair(); -+ success = actDevice->UnsetFocus(); -+ //FIXME: ADD support for RETAIN (BackingSTORE)) - return; - } - } -@@ -141,6 +154,7 @@ - // On the system I tested (Ubuntu 10.4), I was not able to have - // the expected SHOW behavior, with IDL 7.0 and GDL :( - // Help/suggestions welcome -+ // works for me (GD) on mandriva 2010.2 - bool show = true; - if (nParam == 2) { - DIntGDL *showval = e->GetParAs(1); -@@ -151,12 +165,13 @@ - // I don't know how to find the sub-window number (third parametre - // in call XIconifyWindow()) - // Help/suggestions welcome -+ //GD: it is not a sub-window, but a screen number: xwd->screen, but that does not make window iconic any better! - - bool iconic = false; - if( e->KeywordSet("ICONIC")) iconic=true; - - if (!actDevice->WShow( wIx, show, iconic)) -- e->Throw( "Window is closed and unavailable."); -+ e->Throw( "Window number "+i2s(wIx)+" out of range or no more windows."); - } - - void wdelete( EnvT* e) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/plotting_xyouts.cpp gdl/src/plotting_xyouts.cpp ---- gdl-0.9.3/src/plotting_xyouts.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/plotting_xyouts.cpp 2013-08-04 20:25:19.030699283 -0600 -@@ -18,360 +18,397 @@ - #include "includefirst.hpp" - #include "plotting.hpp" - #include "math_utl.hpp" --#include - --namespace lib { -+#define DPI (double)(4*atan(1.0)) -+#define DEGTORAD DPI/180.0 -+ -+namespace lib -+{ - - using namespace std; - -- void takelog(PLFLT *a, PLFLT *a_orient) // {{{ -- { -- if (*a_orient != 0.) -- { -- *a_orient = log10( *a + *a_orient) - log10( *a); -- } -- *a = log10( *a); -- } // }}} -+ static DDouble lastTextPosX=0.0; -+ static DDouble lastTextPosY=0.0; - -- class xyouts_call : public plotting_routine_call -+ class xyouts_call: public plotting_routine_call - { -+ PLFLT currentBoxXmin, currentBoxXmax, currentBoxYmin, currentBoxYmax, currentBoxZmin, currentBoxZmax; -+ PLFLT vpXmin, vpXmax, vpYmin, vpYmax; -+ DDoubleGDL* yVal, *xVal, *zVal; -+ Guard xval_guard, yval_guard, zval_guard; -+ DStringGDL* strVal; -+ SizeT xEl, yEl, zEl, strEl; -+ bool xLog, yLog, zLog; -+ bool doClip, restoreClipBox; -+ PLFLT savebox[4]; -+ bool kwWidth; -+ PLFLT width; -+ DLong minEl; -+ DLongGDL *color; -+ DFloatGDL *spacing,*orientation,*charthick,*alignement,*size; -+ Guard alignement_guard, orientation_guard,size_guard; -+ bool doT3d; -+ DDoubleGDL* t3dMatrix; -+ Guard t3dMatrix_guard; -+ DDoubleGDL *xValou; -+ DDoubleGDL *yValou; -+ Guard xvalou_guard, yvalou_guard; -+ bool singleArg; -+ private: - -- private: bool handle_args( EnvT* e) // {{{ -+ bool handle_args(EnvT* e) - { -- return true; -- } // }}} -- -- private: void old_body( EnvT* e, GDLGStream* actStream) // {{{ -- { -- DDoubleGDL* yVal, *xVal; -- DStringGDL* strVal; -- SizeT xEl, yEl,strEl; -- if(nParam() == 1) -+ // KEYWORDS are: CLIP(YES), COLOR(YES), DATA(YES) , DEVICE(YES) , -+ // NORMAL(YES) , FONT(NO), ORIENTATION(YES), /NOCLIP(YES), T3D(YES), Z(YES) -+ static int zvIx = e->KeywordIx( "Z"); -+ DDouble zValue=0.0; -+ e->AssureDoubleScalarKWIfPresent ( zvIx, zValue ); -+ singleArg=false; -+ if ( nParam()==1 ) - { -- //string only... -- e->Throw("String only, not implemented"); -+ singleArg=true; -+ //string only... -+ xVal=new DDoubleGDL(1, BaseGDL::ZERO); -+ xval_guard.Reset(xVal); // delete upon exit -+ yVal=new DDoubleGDL(1, BaseGDL::ZERO); -+ yval_guard.Reset(yVal); // delete upon exit -+ xEl=yEl=xVal->N_Elements(); -+ strVal=e->GetParAs(0); -+ strEl=strVal->N_Elements(); -+ zVal=new DDoubleGDL(1); -+ zval_guard.Reset(zVal); // delete upon exit -+ (*zVal)[0]=zValue; -+ minEl=strEl; //in this case only - } -- else if(nParam() == 3) -+ else if ( nParam()==3 ) - { -- xVal = e->GetParAs< DDoubleGDL>(0); -- xEl = xVal->N_Elements(); -- yVal = e->GetParAs< DDoubleGDL>(1); -- yEl = yVal->N_Elements(); -- strVal=e->GetParAs(2); -- strEl=strVal->N_Elements(); -- } -- else -- { -- e->Throw("Not enough parameters. Either 1 parameter or 3 " -- "parameters valid."); -- } -- //ok... -- DLong minEl = (xEl < yEl)? xEl:yEl; -- minEl=(minEl < strEl)? minEl:strEl; -- -- DFloat xMarginL, xMarginR,yMarginB, yMarginT; -- get_axis_margin("X", xMarginL, xMarginR); -- get_axis_margin("Y", yMarginB, yMarginT); -- -- DDouble xStart, xEnd, yStart, yEnd; -- bool xLog, yLog; --// DDouble minVal, maxVal; -- -- get_axis_crange("X", xStart, xEnd); -- get_axis_crange("Y", yStart, yEnd); -- get_axis_type("X", xLog); -- get_axis_type("Y", yLog); -- -- -- /* DLong background = p_background; -- static int cix=e->KeywordIx("COLOR"); -- BaseGDL* color_arr=e->GetKW(cix); -- DLongGDL* l_color_arr; -- if(color_arr != NULL) -- { -- l_color_arr=static_cast -- (color_arr->Convert2(GDL_LONG, BaseGDL::COPY)); -- if(color_arr->N_Elements() < minEl && color_arr->N_Elements() > 1) -- e->Throw( "Array "+e->GetParString(cix)+ -- " does not have enough elements for COLOR keyword."); -- } -- DLong color = p_color; -- -- if(color_arr != NULL) -- if(color_arr->N_Elements() >= 1) -- color=(*l_color_arr)[0]; -- */ -- --// pen thickness for axis --actStream->wid( 0); -- -- -- //start drawing. KEYWORDS are: CLIP(NO), COLOR(PARTIALLY), DATA(YES) , DEVICE(YES) , -- // NORMAL(YES) , FONT(NO), ORIENTATION(YES), /NOCLIP(YES), T3D(NO), Z(NO) -- // actStream->Background( background); -- // actStream->Color( color); -- // gkw_background(e, actStream); -- gkw_color(e, actStream); -- -- PLFLT xMR, xML, yMB, yMT; -- CheckMargin( e, actStream, -- xMarginL, -- xMarginR, -- yMarginB, -- yMarginT, -- xMR, xML, yMB, yMT); -- -- bool mapSet=false; --#ifdef USE_LIBPROJ4 -- // Map Stuff (xtype = 3) -- LPTYPE idata; -- XYTYPE odata; -- -- get_mapset(mapSet); -- -- if ( mapSet) { -- ref = map_init(); -- if ( ref == NULL) { -- e->Throw( "Projection initialization failed."); -+ xVal=e->GetParAs< DDoubleGDL>(0); -+ xEl=xVal->N_Elements(); -+ yVal=e->GetParAs< DDoubleGDL>(1); -+ yEl=yVal->N_Elements(); -+ strVal=e->GetParAs(2); -+ strEl=strVal->N_Elements(); -+ //z will be set at Zero unless Z=value is given -+ zEl=xEl; -+ zVal=new DDoubleGDL(dimension(zEl)); -+ zval_guard.Reset(zVal); // delete upon exit -+ for (SizeT i=0; i< zEl ; ++i) (*zVal)[i]=zValue; -+ minEl=(xElThrow("Not enough parameters. Either 1 parameter or 3 " -+ "parameters valid."); - } -+ return true; - } --#endif - -- DDouble *sx, *sy; -- DFloat *wx, *wy; -- GetSFromPlotStructs(&sx, &sy); -- GetWFromPlotStructs(&wx, &wy); -- -- int isdatabydefault=0; -- -- if(e->KeywordSet("DEVICE")) { -- PLFLT xpix, ypix; -- PLINT xleng, yleng, xoff, yoff; -- actStream->gpage(xpix, ypix,xleng, yleng, xoff, yoff); -- xStart=0; xEnd=xleng; -- yStart=0; yEnd=yleng; -- xLog = false; yLog = false; -- actStream->NoSub(); -- actStream->vpor(0, 1, 0, 1); -- } else if(e->KeywordSet("NORMAL")) { -- xStart = 0; -- xEnd = 1; -- yStart = 0; -- yEnd = 1; -- actStream->NoSub(); -- actStream->vpor(0, 1, 0, 1); -- xLog = false; yLog = false; -- } else { -- isdatabydefault=1; -- actStream->NoSub(); -- if (xLog || yLog) actStream->vpor(wx[0], wx[1], wy[0], wy[1]); -- else actStream->vpor(0, 1, 0, 1); // (to be merged with the condition on DataCoordLimits...) -- } -+ private: - -- // Determine data coordinate limits -- // These are computed from window and scaling axis system -- // variables because map routines change these directly. -- -- // if (e->KeywordSet("NORMAL") || e->KeywordSet("DATA")) { -- if (e->KeywordSet("DATA") || (isdatabydefault == 1)) { -- DataCoordLimits(sx, sy, wx, wy, &xStart, &xEnd, &yStart, &yEnd, (xLog || yLog)); -+ void getTextPos(GDLGStream *a, DDouble &wx, DDouble &wy) -+ { -+ a->DeviceToWorld(lastTextPosX, lastTextPosY, wx, wy); -+ if (GDL_DEBUG_PLSTREAM) fprintf(stderr,"getTextPos: Got norm: %lf %lf giving %lf %lf world\n", lastTextPosX, lastTextPosY, wx, wy); - } - --// minVal=yStart; maxVal=yEnd; -- -- //CLIPPING --// DLong noclip=1; --// e->AssureLongScalarKWIfPresent( "NOCLIP", noclip); --// if(noclip == 0) --// { --// static int clippingix = e->KeywordIx( "CLIP"); --// DDoubleGDL* clippingD = e->IfDefGetKWAs( clippingix); --// if( clippingD != NULL) --// Clipping( clippingD, xStart, xEnd, minVal, maxVal); --// } -- -- // for orient -- PLFLT xScale = abs(xEnd - xStart), yScale = abs(yEnd - yStart); -- -- -- // SA: following a patch from Joanna (3029409) TODO: this is repeated in PLOTS POLYFILL and XYOUTS -- if ( xEnd - xStart == 0 || yEnd - yStart == 0 || isnan(xStart) || isnan(yStart) ) { -- actStream->wind( 0, 1, 0, 1 ); -- } else { -- actStream->wind( xStart, xEnd, yStart, yEnd); -- } -+ void old_body(EnvT* e, GDLGStream* actStream) -+ { -+ int clippingix=e->KeywordIx("CLIP"); -+ DFloatGDL* clipBox=NULL; - -- PLFLT x,y; -- string out; - -- //orientation -- static int oix=e->KeywordIx("ORIENTATION"); -- BaseGDL* orient=e->GetKW(oix); -- DDoubleGDL* d_orient; -- PLFLT p_orient, p_orient_x, p_orient_y; -- p_orient=0.0; -- p_orient_x=xScale; -- p_orient_y=0.0; -- -- if(orient != NULL) -- { -- d_orient=static_cast -- (orient->Convert2(GDL_DOUBLE, BaseGDL::COPY)); -- if(orient->N_Elements() < minEl && orient->N_Elements() > 1) -- e->Throw( "Array "+e->GetParString(oix)+ -- " does not have enough elements for ORIENTATION keyword."); -- p_orient=(*d_orient)[0]; -- while(p_orient < 0) p_orient+=360.0; -- while(p_orient > 360.0) p_orient-=360.0; -- } -- -- p_orient_x=xScale*cos(p_orient*0.0174533); -- p_orient_y=yScale*sin(p_orient*0.0174533); -- -- //ALIGNMENT -- DDouble alignment = 0.0; -- e->AssureDoubleScalarKWIfPresent( "ALIGNMENT", alignment); -- -- // !P.MULTI vs. POSITION -- handle_pmulti_position(e, actStream); -- -- //CHARSIZE Note that SIZE is apparently used in some old implementations and -- //seems to be supported silently with *DL. So we support it also: -- DFloat charsize; -- gkw_charsize_xyouts(e, actStream, charsize); -- -- // WIDTH keyword -- static int widthIx = e->KeywordIx( "WIDTH"); -- bool kwWidth = e->KeywordPresent(widthIx); -- PLFLT width = 0.; -- -- // SA: plplot uses a "reference point" that "lies along a line passing -- // through the string at half the height of a capital letter" -- // getting character height so it can be later used to move the -- // "reference point" half character height lower (tracker item no. 2982623) -- PLFLT charheight; -+ //T3D -+ static int t3dIx = e->KeywordIx( "T3D"); -+ doT3d=(e->KeywordSet(t3dIx)|| T3Denabled(e)); - --#ifdef HAVE_PLPLOT_BEFORE_5994 -- { -- PLFLT nullf, htmm; -- plgchr(&nullf, &htmm); // height of a letter in millimetres -- PLINT htpc = plP_mmpcy(htmm); // height of a letter in physical coordinates -- PLINT nulli, p_iymin, p_iymax; -- plP_gphy(&nulli, &nulli, &p_iymin, &p_iymax); // physical device limits in physical coordinates -- PLFLT wy, wy0; -- plcalc_world(0., htpc / double(p_iymax - p_iymin), &nullf, &wy, &nulli); // wy = height of a letter in world coordinates -- plcalc_world(0., 0., &nullf, &wy0, &nulli); // wy = height of a letter in world coordinates -- charheight = wy - wy0; -- } --#else // HAVE_PLPLOT_BEFORE_5994 -- cout << "Warning : charheight not changeable" << endl; -- cout << "Warning : no more useful symbols in plplot 5.9.9-4" << endl; -- charheight=1.; --#endif // HAVE_PLPLOT_BEFORE_5994 - -+ // WIDTH keyword (read, write) -+ static int widthIx=e->KeywordIx("WIDTH"); -+ kwWidth=e->KeywordPresent(widthIx); -+ width=0.; - -- if(minEl == 1) -+ enum - { -- x=static_cast((*xVal)[0]); -- y=static_cast((*yVal)[0]); -- -- if( yLog) if( y <= 0.0) goto skip; else takelog(&y, &p_orient_y); -- if( xLog) if( x <= 0.0) goto skip; else takelog(&x, &p_orient_x); -+ DATA=0, -+ NORMAL, -+ DEVICE -+ } coordinateSystem=DATA; -+ //check presence of DATA,DEVICE and NORMAL options -+ if ( e->KeywordSet("DATA") ) coordinateSystem=DATA; -+ if ( e->KeywordSet("DEVICE") ) coordinateSystem=DEVICE; -+ if ( e->KeywordSet("NORMAL") ) coordinateSystem=NORMAL; -+ // get_axis_type -+ gdlGetAxisType("X", xLog); -+ gdlGetAxisType("Y", yLog); -+ gdlGetAxisType("Z", zLog); - -+ bool mapSet=false; - #ifdef USE_LIBPROJ4 -- if (mapSet && !e->KeywordSet("NORMAL")) { -- idata.lam = x * DEG_TO_RAD; -- idata.phi = y * DEG_TO_RAD; -- odata = PJ_FWD(idata, ref); -- x = odata.x; -- y = odata.y; -- } -- // TODO: p_orient_x? p_orient_y? -+ get_mapset(mapSet); -+ if ( mapSet ) -+ { -+ ref=map_init(); -+ if ( ref==NULL ) -+ { -+ e->Throw("Projection initialization failed."); -+ } -+ } - #endif -+ restoreClipBox=false; -+ int noclipvalue=1; -+ e->AssureLongScalarKWIfPresent( "NOCLIP", noclipvalue); -+ doClip=(noclipvalue==0); //XYOUTS by default does not clip, even if clip is defined by CLIP= or !P.CLIP. -+ clipBox=e->IfDefGetKWAs(clippingix); -+ if(doClip && clipBox!=NULL && clipBox->N_Elements()>=4 ) //clipbox exist, will be used: convert to device coords -+ //and save in !P.CLIP... -+ { -+ restoreClipBox=true; //restore later -+ // save current !P.CLIP box, replace by our current clipbox in whatever coordinates, will -+ // give back the !P.CLIP box at end... -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned clipTag=pStruct->Desc()->TagIndex("CLIP"); //must be in device coordinates -+ static PLFLT tempbox[4]; -+ for ( int i=0; i<4; ++i ) savebox[i]=(*static_cast(pStruct->GetTag(clipTag, 0)))[i]; -+ if ( coordinateSystem==DEVICE ) -+ { -+ for ( int i=0; i<4; ++i ) tempbox[i]=(*clipBox)[i]; -+ } -+ else if ( coordinateSystem==DATA ) -+ { -+ //handle log: if existing box is already in log, use log of clipbox values. -+ PLFLT worldbox[4]; -+ for ( int i=0; i<4; ++i ) worldbox[i]=(*clipBox)[i]; -+ if (xLog) {worldbox[0]=log10(worldbox[0]); worldbox[2]=log10(worldbox[2]);} -+ if (yLog) {worldbox[1]=log10(worldbox[1]); worldbox[3]=log10(worldbox[3]);} -+ bool okClipBox=true; -+ for ( int i=0; i<4; ++i ) -+ { -+ if (!(worldbox[i]==worldbox[i])) //NaN -+ { -+ okClipBox=false;restoreClipBox=false;doClip=false; -+ } -+ } -+ if (okClipBox) -+ { -+ actStream->WorldToDevice(worldbox[0], worldbox[1], tempbox[0], tempbox[1]); -+ actStream->WorldToDevice(worldbox[2], worldbox[3], tempbox[2], tempbox[3]); -+ } -+ } -+ else -+ { -+ actStream->NormedDeviceToDevice((*clipBox)[0],(*clipBox)[1], tempbox[0], tempbox[1]); -+ actStream->NormedDeviceToDevice((*clipBox)[2],(*clipBox)[3], tempbox[2], tempbox[3]); -+ } -+ //place in !P.CLIP -+ for ( int i=0; i<4; ++i ) (*static_cast(pStruct->GetTag(clipTag, 0)))[i]=tempbox[i]; -+ } - -- y += .5 * charheight; -+ PLFLT wun, wdeux, wtrois, wquatre; -+ actStream->pageWorldCoordinates(wun, wdeux, wtrois, wquatre); - -- out=(*strVal)[0]; -- actStream->ptex(x,y,p_orient_x, p_orient_y,alignment,out.c_str()); --#ifdef HAVE_PLPLOT_BEFORE_5994 -- if (kwWidth) width = plstrl(out.c_str()); --#endif -+ actStream->OnePageSaveLayout(); // one page -+ actStream->vpor(0, 1, 0, 1); //set full viewport -+ -+ if ( coordinateSystem==DEVICE ) -+ { -+ actStream->wind(0.0, actStream->xPageSize(), 0.0, actStream->yPageSize()); -+ xLog=false; -+ yLog=false; -+ } -+ else if ( coordinateSystem==NORMAL ) -+ { -+ actStream->wind(0.0, 1.0, 0.0, 1.0); -+ xLog=false; -+ yLog=false; - } -- else -+ else //with XYOUTS, we can plot *outside* the box(e)s in DATA coordinates. - { -- for(int i=0; iwind(wun, wdeux, wtrois, wquatre); -+ } -+ -+ PLFLT x,y,aspectw,aspectd; -+ aspectw=actStream->boxAspectWorld(); -+ aspectd=actStream->boxAspectDevice(); -+ -+ int colorIx=e->KeywordIx ( "COLOR" ); bool docolor=false; -+ int charthickIx=e->KeywordIx ( "CHARTHICK" ); bool docharthick=false; -+ int charsizeIx=e->KeywordIx ( "CHARSIZE" ); bool docharsize=false; -+ if ( e->GetKW ( colorIx )!=NULL ) -+ { -+ color=e->GetKWAs( colorIx ); docolor=true; -+ } -+ if ( e->GetKW ( charthickIx )!=NULL ) -+ { -+ charthick=e->GetKWAs( charthickIx ); docharthick=true; -+ } -+ if ( e->GetKW ( charsizeIx )!=NULL ) -+ { -+ size=e->GetKWAs( charsizeIx ); docharsize=true; -+ } -+ else //for security in future conditional evaluation... -+ { -+ size=new DFloatGDL ( dimension (1), BaseGDL::ZERO ); -+ size_guard.Init ( size); -+ (*size)[0]=1.0; -+ } -+ int orientationIx=e->KeywordIx ( "ORIENTATION" ); -+ if ( e->GetKW ( orientationIx )!=NULL ) -+ { -+ orientation=e->GetKWAs( orientationIx ); -+ } -+ else -+ { -+ orientation=new DFloatGDL ( dimension (1), BaseGDL::ZERO ); -+ orientation_guard.Init ( orientation); -+ (*orientation)[0]=0; -+ } -+ int alignIx=e->KeywordIx ( "ALIGNMENT" ); -+ if ( e->GetKW ( alignIx )!=NULL ) -+ { -+ alignement=e->GetKWAs( alignIx ); -+ } -+ else -+ { -+ alignement=new DFloatGDL ( dimension (1), BaseGDL::ZERO ); -+ alignement_guard.Init (alignement); -+ (*alignement)[0]=0; -+ } - -- if(orient != NULL && orient->N_Elements() > 1) -- { -- p_orient=(*d_orient)[i]; -- while(p_orient < 0) p_orient+=360.0; -- while(p_orient > 360.0) p_orient-=360.0; -- p_orient_x=xScale*cos(p_orient*0.0174533); -- p_orient_y=yScale*sin(p_orient*0.0174533); -- } - -- x=static_cast((*xVal)[i]); -- y=static_cast((*yVal)[i]); -+ // make all clipping computations BEFORE setting graphic properties (color, size) -+ bool stopClip=false; -+ if ( doClip ) if ( startClipping(e, actStream, true)==TRUE ) stopClip=true; -+ -+ // *** start drawing by defalut values -+ gdlSetGraphicsForegroundColorFromKw(e, actStream); -+ gdlSetPlotCharthick(e, actStream); -+ gdlSetPlotCharsize(e, actStream, true); //accept SIZE kw! - -- if( yLog) if( y <= 0.0) continue; else takelog( &y, &p_orient_y); -- if( xLog) if( x <= 0.0) continue; else takelog( &x, &p_orient_x); -+ if ( doT3d ) //convert X,Y,Z in X',Y' as per T3D perspective. -+ { -+ DDoubleGDL* t3dMatrix=gdlGetT3DMatrix(); //the original one -+ t3dMatrix_guard.Reset(t3dMatrix); -+ DDouble *sx, *sy, *sz; -+ GetSFromPlotStructs(&sx, &sy, &sz); -+ xValou=new DDoubleGDL(dimension(xEl)); -+ yValou=new DDoubleGDL(dimension(yEl)); -+ Guard xval_guard, yval_guard; -+ xval_guard.reset(xValou); -+ yval_guard.reset(yValou); -+ gdlProject3dCoordinatesIn2d(t3dMatrix, xVal, sx, yVal, sy, zVal, sz, xValou, yValou); -+ xVal=xValou; -+ yVal=yValou; -+ } -+ // Get decomposed value for colors -+ DLong decomposed=Graphics::GetDevice()->GetDecomposed(); - -+ for ( SizeT i=0; i((*xVal)[i%xVal->N_Elements ( )]); //insure even 1 parameter, string array -+ y=static_cast((*yVal)[i%xVal->N_Elements ( )]); -+ -+ //following obviously wrong if T3D... - #ifdef USE_LIBPROJ4 -- if (mapSet && !e->KeywordSet("NORMAL")) { -- idata.lam = x * DEG_TO_RAD; -- idata.phi = y * DEG_TO_RAD; -- odata = PJ_FWD(idata, ref); -- x = odata.x; -- y = odata.y; -- if (!isfinite(x) || !isfinite(y)) continue; -- } -+ if ( mapSet&& coordinateSystem==DATA ) -+ { -+ LPTYPE idata; -+ XYTYPE odata; -+ idata.lam=x * DEG_TO_RAD; -+ idata.phi=y * DEG_TO_RAD; -+ odata=PJ_FWD(idata, ref); -+ x=odata.x; -+ y=odata.y; -+ } - #endif - -- /* if(color_arr != NULL) -- if(color_arr->N_Elements() > 1) -- actStream->Color((*l_color_arr)[i]); -- */ -- out=(*strVal)[i]; -- y += .5 * charheight; -- actStream->ptex(x,y,p_orient_x, p_orient_y,alignment,out.c_str()); -+ if( xLog ) x=log10(x); -+ if( yLog ) y=log10(y); - --#ifdef HAVE_PLPLOT_BEFORE_5994 -- if (kwWidth) width = max(plstrl(out.c_str()), width); --#endif -- } -+ if ( !isfinite(x)|| !isfinite(y) ) continue; //no plot -+ if ( docharsize && ( *size )[i%size->N_Elements ( )] < 0) continue; //no plot either -+ -+ //plot! -+ if (docharsize) actStream->sizeChar(( *size )[i%size->N_Elements ( )]); -+ if (docolor) actStream->Color ( ( *color )[i%color->N_Elements ( )], decomposed, 2); -+ if (docharthick) actStream->wid ( ( *charthick )[i%charthick->N_Elements ( )]); -+ //orientation word is not orientation page depending on axes increment direction [0..1] vs. [1..0] -+ PLFLT oriD=(( *orientation )[i%orientation->N_Elements ( )]); //ori DEVICE -+ PLFLT oriW=oriD; //ori WORLD -+ oriD *= DEGTORAD; -+ if ((wdeux-wun)<0) oriW=180.0-oriW; -+ if ((wquatre-wtrois)<0) oriW*=-1; -+ oriW *= DEGTORAD; -+ PLFLT cosOriD=cos(oriD); -+ PLFLT sinOriD=sin(oriD); -+ PLFLT cosOriW=cos(oriW); -+ PLFLT sinOriW=sin(oriW); -+ PLFLT align=( *alignement )[i%alignement->N_Elements ( )]; -+ align=max(align,0.0); align=min(align,1.0); -+ PLFLT dispx,dispy, chsize, dx, dy; -+ // displacement due to offset (reference in IDL is baseline, -+ // in plplot it's the half-height) is best computed in device coords -+ chsize=actStream->dCharHeight()*0.5; -+ actStream->WorldToDevice(x, y, dx, dy); -+ actStream->DeviceToWorld(dx-chsize*sinOriD,dy+chsize*cosOriD,dispx,dispy); -+ string out=(*strVal)[i%strVal->N_Elements ( )]; -+ actStream->ptex(dispx, dispy, cosOriW, sinOriW*aspectw/aspectd, align, out.c_str()); -+ -+ if (singleArg || (i==minEl-1 ) ) //then x and y are not given and whatever the number of strings, are retrieved -+ // from lastTextPos. We must thus remember lastTextPos. -+ { -+ width=actStream->gdlGetmmStringLength(out.c_str()); //in mm -+ //we want normed size: -+ width=actStream->m2dx(width); -+ //save position - compute must be in DEVICE coords, or in normed*aspect! -+ actStream->WorldToNormedDevice(x, y, dx, dy); //normed -+ actStream->NormedDeviceToWorld(dx+(1.0-align)*width*cosOriD,dy+(1.0-align)*width*sinOriD/aspectd,dispx,dispy); -+ actStream->WorldToDevice(dispx, dispy, lastTextPosX, lastTextPosY); -+ } - } -- -- skip: -- if (kwWidth) -+ if (stopClip) stopClipping(actStream); -+ -+ if ( kwWidth ) -+ { -+ // width is in "normalized coordinates" -+ e->SetKW(widthIx, new DFloatGDL(width)); -+ } -+ } -+ -+ private: -+ -+ void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ - { -- // SA: we should return value of width in "normalized coordinate units" -- // width contains output from plstrl() expressed in millimetres -- // plP_mmpcx() converts it into physical coordinates -- // plP_gphy() gives "physical device limits in physical coordinates" -- --#ifdef HAVE_PLPLOT_BEFORE_5994 -- PLINT p_ixmin, p_ixmax, p_iymin, p_iymax; -- plP_gphy(&p_ixmin, &p_ixmax, &p_iymin, &p_iymax); -- e->SetKW(widthIx, new DFloatGDL(plP_mmpcx(width)/double(p_ixmax - p_ixmin))); --#endif -- } -- } // }}} -+ } - -- private: void call_plplot(EnvT* e, GDLGStream* actStream) // {{{ -- { -- } // }}} -+ private: - -- private: virtual void post_call(EnvT*, GDLGStream*) // {{{ -+ virtual void post_call(EnvT* e, GDLGStream* actStream) // {{{ - { -- } // }}} -+ actStream->RestoreLayout(); -+ if (restoreClipBox) -+ { -+ static DStructGDL* pStruct=SysVar::P(); -+ static unsigned clipTag=pStruct->Desc()->TagIndex("CLIP"); //must be in device coordinates -+ for ( int i=0; i<4; ++i ) (*static_cast(pStruct->GetTag(clipTag, 0)))[i]=savebox[i]; -+ } -+ actStream->sizeChar(1.0); -+ } - -- }; -+ }; - - void xyouts(EnvT* e) - { - xyouts_call xyouts; - xyouts.call(e, 1); - } -- -+ - } // namespace -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/print.cpp gdl/src/print.cpp ---- gdl-0.9.3/src/print.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/print.cpp 2013-07-08 12:39:22.581384994 -0600 -@@ -138,7 +138,7 @@ - write_journal( ip->GetClearActualLine()); - write_journal_comment( e, parOffset, width); - } -- -+ - void print_os( ostream* os, EnvT* e, int parOffset, SizeT width) - { - // FORMAT keyword -@@ -149,11 +149,23 @@ - - if( fmtString != "") - { -- RefFMTNode fmtAST = GetFMTAST( fmtString); -- -- // formatted output ignores WIDTH -- FMTOut Formatter( fmtAST, os, e, parOffset); -- return; -+ try { -+ RefFMTNode fmtAST = GetFMTAST( fmtString); -+#ifdef GDL_DEBUG -+ antlr::print_tree pt; -+ cout << "Format parser output:" << endl; -+ pt.pr_tree(static_cast(fmtAST)); -+ cout << "Format Parser end." << endl; -+#endif -+ -+ // formatted output ignores WIDTH -+ FMTOut Formatter( fmtAST, os, e, parOffset); -+ return; -+ } -+ catch( antlr::ANTLRException& ex) -+ { -+ e->Throw( ex.getMessage()); -+ } - } - } - //else // default-format output -@@ -201,7 +213,7 @@ - // GDL magick (based on the Python interface code) - static int printIx = LibProIx("PRINT"); - EnvT* env = new EnvT(NULL, libProList[printIx]); -- auto_ptr env_guard(env); -+ Guard env_guard(env); - BaseGDL* par; - env->SetNextPar(&par); - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/delvar.pro gdl/src/pro/delvar.pro ---- gdl-0.9.3/src/pro/delvar.pro 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/pro/delvar.pro 2013-07-25 17:19:10.000000000 -0600 -@@ -0,0 +1,45 @@ -+;+ -+; NAME: -+; DELVAR -+; PURPOSE: -+; As IDL's DELVAR internal function (GDL:FIXME!), using -+; code taken from 'delvarx.pro' under BSD license, all rights reserved. -+; CALLING SEQUENCE: -+; DELVAR, vra1, var2 .... var48 -+; -+; INPUTS: -+; p0, p1... p48 - variables to delete -+; -+; RESTRICTIONS: -+; Can't use recursively due to EXECUTE function -+; -+; METHOD: -+; Uses EXECUTE and TEMPORARY function (old version of delvarx) -+; new version of delvarx using ptr_new(/no_copy) does not work -+; with GDL -+; -+; REVISION HISTORY: -+; Copied from the Solar library, written by slf, 25-Feb-1993 -+; Added to Astronomy Library, September 1995 -+; Converted to IDL V5.0 W. Landsman September 1997 -+; Modified, 26-Mar-2003, Zarro (EER/GSFC) 26-Mar-2003 -+; - added FREE_MEM to free pointer/objects -+; Modified, 26-Jul-2013 as 'delvar' for GDL, with 48 -+; parameters,by G. Duvert -+;- -+ -+PRO delvar, p0,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20,p21,p22,p23,p24,p25,p26,p27,p28,p29,p30,p31,p32,p33,p34,p35,p36,p37,p38,p39,p40,p41,p42,p43,p44,p45,p46,p47 -+; 48 is enough? -+ FOR i = 0, N_PARAMS()-1 DO BEGIN ; for each parameter -+ param = STRCOMPRESS("p" + STRING(i),/remove) -+; only delete if defined on input (avoids error message) -+ exestat = execute("defined=n_elements(" + param + ")" ) -+ -+ IF defined GT 0 THEN BEGIN -+ exestat = execute("heap_free," + param) -+ exestat = execute(param + "=0") -+ exestat = execute("dvar=temporary(" + param + ")" ) -+ ENDIF -+ ENDFOR -+ RETURN -+END -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/diag_matrix.pro gdl/src/pro/diag_matrix.pro ---- gdl-0.9.3/src/pro/diag_matrix.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/diag_matrix.pro 2013-05-16 12:36:33.000000000 -0600 -@@ -1,8 +1,69 @@ -+;+ - ; --; limited version of DIAG_MATRIX - ; please report problems / examples / extensions - ; --; Alain C., 23-JAN-2012, under GNU GPL v2 or later -+; NAME: DIAG_MATRIX -+; -+; PURPOSE: 1/ returning the diagonal of the input matrix -+; 2/ generating a square matrix with a given diagonal. -+; -+; CATEGORY: Matrix utilities -+; -+; CALLING SEQUENCE: -+; - case 1: my_diagonal=DIAG_MATRIX(matrix) -+; - case 2: matrix=DIAG_MATRIX(a_diag_vector, an_offset) -+; -+; INPUTS: -+; - case 1: a matrix (square or not) -+; - case 2: a vector (might be a singleton) -+; -+; OPTIONAL INPUTS: -+; - case 1: none -+; - case 2: an offset -+; -+; KEYWORD PARAMETERS: -+; -+; OUTPUTS: -+; - case 1: a vector, the diagonal -+; - case 2: a square matrix -+; -+; OPTIONAL OUTPUTS: none -+; -+; COMMON BLOCKS: none -+; -+; SIDE EFFECTS: none -+; -+; RESTRICTIONS: none known ! -+; -+; PROCEDURE: straightforward -+; -+; EXAMPLE: -+; -+; - case 1: print, DIAG_MATRIX(DIST(10)) -+; -+; - case 2: -+; ** generating a NxN rotation matrix: -+; matrix=DIAG_MATRIX(REPLICATE(1.,nbp-1),1) -+; matrix[0,nbp-1]=1. -+; ** generating a IDENTITY matrix (equal to: identity=IDENTITY(nbp) -+; identity=DIAG_MATRIX(REPLICATE(1.,nbp)) -+; -+; MODIFICATION HISTORY: -+; -+; * 23-JAN-2012: initial version by Alain C. -+; -+; * 11-APR-2013: - in fact, when creating the output matrix, -+; we have to derive the type from the input diagonal ! -+; - more documentation -+; -+;- -+; LICENCE: Copyright (C) 2012, 2013, Alain Coulais, under GNU GPL v2 or later -+; -+; This program is free software; you can redistribute it and/or modify -+; it under the terms of the GNU General Public License as published by -+; the Free Software Foundation; either version 2 of the License, or -+; (at your option) any later version. -+;- - ; - function DIAG_MATRIX, input, position, $ - debug=debug, help=help, test=test -@@ -10,87 +71,98 @@ - if N_PARAMS() EQ 0 then MESSAGE, 'Incorrect number of arguments.' - ; - if KEYWORD_SET(help) then begin -- print, 'function DIAG_MATRIX, input, position, $' -- print, ' debug=debug, help=help, test=test' -- return, -1 -+ print, 'function DIAG_MATRIX, input, position, $' -+ print, ' debug=debug, help=help, test=test' -+ return, -1 - endif - ; - if SIZE(input,/n_dim) GT 2 then begin -- MESSAGE, 'Only 1 or 2 dimensions allowed '+input -+ MESSAGE, 'Only 1 or 2 dimensions allowed '+input - endif - ; -+; case 1, first usage: returning the diagonal -+; - if (SIZE(input,/n_dim) EQ 2) then begin -- if N_PARAMS() EQ 1 then position=0 -- info_size=SIZE(input,/dim) -- x=info_size[0] -- y=info_size[1] -- ;; -- diag=INDGEN(MIN([x,y])) -- ;; -- if (position EQ 0) then begin -- xx=diag -- yy=diag -- endif -- ;; -- if (position GT 0) then begin -- if (position GE x) then begin -- MESSAGE, '% Specified offset to array is out of range: '+STRING(position)+' versus: '+STRING(x) -- endif -- xx=diag+position -- xx=xx[WHERE(xx LT x)] -- yy=diag[0:N_ELEMENTS(xx)-1] -- endif -- if (position LT 0) then begin -- if (ABS(position) GE y) then begin -- MESSAGE, '% Specified offset to array is out of range: '+STRING(position)+' versus: '+STRING(y) -- endif -- yy=diag+ABS(position) -- yy=yy[WHERE(yy LT y)] -- xx=diag[0:N_ELEMENTS(yy)-1] -- endif -- resu=REFORM(input[xx,yy]) -- if KEYWORD_SET(debug) then begin -- print, '-----------------------' -- print, 'x :', x, ', y :', y, ', Position indice: ', position -- print, 'input matrix :' -- print, input -- print, 'position XX :', xx -- print, 'position YY :', yy -- print, 'extracted vector :', resu -- endif -+ if N_PARAMS() EQ 1 then position=0 -+ info_size=SIZE(input,/dim) -+ x=info_size[0] -+ y=info_size[1] -+ ;; -+ diag=INDGEN(MIN([x,y])) -+ ;; -+ if (position EQ 0) then begin -+ xx=diag -+ yy=diag -+ endif -+ ;; -+ txt='% Specified offset to array is out of range: ' -+ ;; -+ if (position GT 0) then begin -+ if (position GE x) then begin -+ MESSAGE, txt+STRING(position)+' versus: '+STRING(x) -+ endif -+ xx=diag+position -+ xx=xx[WHERE(xx LT x)] -+ yy=diag[0:N_ELEMENTS(xx)-1] -+ endif -+ if (position LT 0) then begin -+ if (ABS(position) GE y) then begin -+ MESSAGE, txt+STRING(position)+' versus: '+STRING(y) -+ endif -+ yy=diag+ABS(position) -+ yy=yy[WHERE(yy LT y)] -+ xx=diag[0:N_ELEMENTS(yy)-1] -+ endif -+ resu=REFORM(input[xx,yy]) -+ if KEYWORD_SET(debug) then begin -+ print, '-----------------------' -+ print, 'x :', x, ', y :', y, ', Position indice: ', position -+ print, 'input matrix :' -+ print, input -+ print, 'position XX :', xx -+ print, 'position YY :', yy -+ print, 'extracted vector :', resu -+ endif - endif - ; -+; case 2: second usage: generating a square matrix populated -+; by "diagonals" passed by argument, with a given "offset". -+; - if (SIZE(input,/n_dim) LE 1) then begin -- if N_PARAMS() EQ 1 then position=0 -- nbp=N_ELEMENTS(input)+ABS(position) -- resu=FLTARR(nbp,nbp) -- diag=INDGEN(nbp) -- if (position EQ 0) then begin -- resu[diag,diag]=input -- xx=diag -- yy=diag -- endif -- if (position GT 0) then begin -- xx=diag+position -- xx=xx[WHERE(xx LT nbp)] -- yy=diag[0:N_ELEMENTS(xx)-1] -- resu[xx,yy]=input -- endif -- if (position LT 0) then begin -- yy=diag+ABS(position) -- yy=yy[WHERE(yy LT nbp)] -- xx=diag[0:N_ELEMENTS(yy)-1] -- resu[xx,yy]=input -- endif -- if KEYWORD_SET(debug) then begin -- print, '-----------------------' -- print, 'Position indice: ', position -- print, 'input vector :', input -- print, 'position XX :', xx -- print, 'position YY :', yy -- print, 'computed matrix :' -- print, resu -- endif -+ ;; determining the size of the output matrix -+ if N_PARAMS() EQ 1 then position=0 -+ nbp=N_ELEMENTS(input)+ABS(position) -+ ;; creating wthe output matrix with adequate type -+ type=SIZE(input,/type) -+ resu=MAKE_ARRAY(nbp,nbp, type=type) -+ ;; -+ diag=INDGEN(nbp) -+ if (position EQ 0) then begin -+ resu[diag,diag]=input -+ xx=diag -+ yy=diag -+ endif -+ if (position GT 0) then begin -+ xx=diag+position -+ xx=xx[WHERE(xx LT nbp)] -+ yy=diag[0:N_ELEMENTS(xx)-1] -+ resu[xx,yy]=input -+ endif -+ if (position LT 0) then begin -+ yy=diag+ABS(position) -+ yy=yy[WHERE(yy LT nbp)] -+ xx=diag[0:N_ELEMENTS(yy)-1] -+ resu[xx,yy]=input -+ endif -+ if KEYWORD_SET(debug) then begin -+ print, '-----------------------' -+ print, 'Position indice: ', position -+ print, 'input vector :', input -+ print, 'position XX :', xx -+ print, 'position YY :', yy -+ print, 'computed matrix :' -+ print, resu -+ endif - endif - ; - if KEYWORD_SET(test) then STOP -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/dialog_pickfile.pro gdl/src/pro/dialog_pickfile.pro ---- gdl-0.9.3/src/pro/dialog_pickfile.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/dialog_pickfile.pro 2013-05-16 12:36:33.000000000 -0600 -@@ -116,6 +116,10 @@ - ; 14-NOV-2012: - large part of code, common with DIALOG_MESSAGE, - ; related to Zenity, moved into ZENITY_CHECK() - ; -+; 14-May-2013: - correcting "bug" 3612324: must start in current directory when -+; no path given. This problem appears due to change in -+; Zenity in Gnome3 (e.g. : http://www.kirsle.net/blog/kirsle/zenity-and-gnome-3) -+; - ;- - ; - ; This function try to reproduce the IDL's DIALOG_PICKFILE behavior using "zenity". -@@ -141,8 +145,8 @@ - ; - ;- - ; LICENCE: --; Copyright (C) 2010, Maxime Lenoir (main author) and Alain Coulais --; (idea, contact) -+; Copyright (C) 2010, Maxime Lenoir (main author) and Alain Coulais (idea, contact) -+; - ; This program is free software; you can redistribute it and/or modify - ; it under the terms of the GNU General Public License as published by - ; the Free Software Foundation; either version 2 of the License, or -@@ -180,6 +184,10 @@ - zenity_version=zenity_version, $ - help=help, test=test, debug=debug, verbose=verbose) - ; -+if (!zenity.version LT 0) then begin -+ return, '' -+endif -+; - ; Check default_extension - if KEYWORD_SET(default_extension) then default_extension=STRING(default_extension[0]) - ; -@@ -205,14 +213,24 @@ - ; if path and file are set, then initial = path/file if exists, path otherwise (or current working directory if invalid path) - ; if file is set, initial = file - ; Zenity can't initialy select a non-exising file/directory -+; -+; in gnome3, by default, Zenity (eg: 3.4.0 in Ubuntu 12.04) -+; uses value storing in ~/.recently-used -+; for the path. We must set it up now :( -+; (no side effects found up to now with older versions of Zenity) -+; - start='' - if KEYWORD_SET(path) then begin -- path=STRING(path[0]) -- start+=path+path_sep() --endif -- -+ path=STRING(path[0]) -+ start+=path+path_sep() -+endif else begin -+ CD, current=current -+ path=current -+ start+=current+path_sep() -+end -+; - if KEYWORD_SET(file) then file=STRING(file[0]) -- -+; - if start ne '' then begin - if KEYWORD_SET(file) && FILE_TEST(start+file) then begin - cmd+='--filename="'+start+file+'" ' -Only in gdl-0.9.3/src/pro/dicom: Makefile.in -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/doc_library.pro gdl/src/pro/doc_library.pro ---- gdl-0.9.3/src/pro/doc_library.pro 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/pro/doc_library.pro 2013-03-01 10:35:35.000000000 -0700 -@@ -0,0 +1,92 @@ -+;+ -+; NAME: -+; DOC_LIBRARY -+; -+; PURPOSE: -+; Extract and display documentation headers from a program or routine. -+; -+; CATEGORY: -+; Documentation -+; -+; CALLING SEQUENCE: -+; DOC_LIBRARY, procedure -+; -+; INPUTS: -+; procedure STRING The procedure to document. -+; -+; KEYWORD PARAMETERS: -+; /print Set to print the output to the default printer. -+; -+; SIDE EFFECTS: -+; A file is created in /tmp and deleted after use. -+; -+; RESTRICTIONS: -+; Only one documentation block per file is handled. -+; -+; EXAMPLE: -+; DOC_LIBRARY, 'doc_library' -+; -+; MODIFICATION HISTORY: -+; Original: 2013-March-28; SJT (see Feature Requests 3606434) -+; -+; LICENCE: -+; This code in under GNU GPL v2 or later -+; -+;- -+pro DOC_LIBRARY, proc, print = print, test=test -+ -+ON_ERROR, 2 -+ -+if (!version.os_family ne 'unix') then begin -+ print, "DOC_LIBRARY is currently only available for Unix like systems" -+ return -+endif -+ -+if (KEYWORD_SET(print)) then begin -+ less = FILE_WHICH(getenv('PATH'), 'lp') -+ if (less eq '') then less = FILE_WHICH(GETENV('PATH'), 'lpr') -+ if (less eq '') then begin -+ print, "Neither lp nor lpr was found" -+ return -+ endif -+endif else begin -+ less = FILE_WHICH(GETENV('PATH'), 'less') -+ if (less eq '') then less = FILE_WHICH(GETENV('PATH'), 'more') -+ if (less eq '') then begin -+ print, "Neither more nor less was found" -+ return -+ endif -+endelse -+ -+proc_path = FILE_WHICH(proc+'.pro', /include_current) -+if (proc_path eq '') then begin -+ print, proc, ' not found' -+ return -+endif -+ -+out_name = '/tmp/'+proc+'.txt' -+ -+OPENR, ipu, proc_path, /get -+dflag = 0b -+inln = '' -+ -+OPENW, isu, out_name, /get -+ -+while (~EOF(ipu)) do begin -+ READF, ipu, inln -+ inln = STRTRIM(inln, 2) -+ if (STRPOS(inln, ';+') eq 0) then dflag = 1b -+ if (STRPOS(inln, ';-') eq 0) then break -+ ;; -+ if dflag then printf, isu, STRMID(inln, 1) -+endwhile -+; -+FREE_LUN, isu, ipu -+; -+SPAWN, less+' '+out_name -+; -+FILE_DELETE, out_name -+; -+if KEYWORD_SET(test) then STOP -+; -+end -Only in gdl-0.9.3/src/pro/envi: Makefile.in -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/file_basename_old.pro gdl/src/pro/file_basename_old.pro ---- gdl-0.9.3/src/pro/file_basename_old.pro 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/pro/file_basename_old.pro 2013-07-01 11:09:31.000000000 -0600 -@@ -0,0 +1,112 @@ -+; -+; Since First July 2013, because a C++ internal version is available -+; this file is OBSOLETING, will be removed in the future !! -+; -+; -+;+ -+; NAME: FILE_BASENAME -+; -+; PURPOSE: The FILE_BASENAME function returns the basename of a file -+; path. A file path is a string containing one or more segments -+; consisting of names separated by directory delimiter characters -+; (slash (/) under UNIX, or backslash (\) under Microsoft -+; Windows). The basename is the final rightmost segment of the file -+; path; it is usually a file, but can also be a directory name. -+; -+; FILE_BASENAME is based on the standard UNIX basename(1) utility. -+ -+; CATEGORY: UNIX utility. -+; -+; CALLING SEQUENCE: Result = FILE_BASENAME(Path [, RemoveSuffix] [, /FOLD_CASE]) -+; -+; INPUTS: Path: A scalar string or string array containing paths for -+; which the basename is desired. -+; -+; OPTIONAL INPUTS: RemoveSuffix: An optional scalar string or -+; 1-element string array specifying a filename suffix to be removed -+; from the end of the basename, if present. -+; -+; KEYWORD PARAMETERS: /FOLD_CASE is not available now (and useless -+; for Unix). return -1 if activated -+; -+; OUTPUTS: A scalar string or string array containing the basename for -+; each element of the Path argument. -+; -+; OPTIONAL OUTPUTS: none -+; -+; COMMON BLOCKS: none -+; -+; SIDE EFFECTS: none -+; -+; RESTRICTIONS: only for Unix (Unix, Linux and Mac OS X) systems -+; -+; Rules used by FILE_BASENAME -+; FILE_BASENAME makes a copy of the input file path string, then -+; modifies the copy according to the following rules: -+; - If Path is a NULL string, then FILE_BASENAME returns a NULL -+; string. -+; - If Path consists entirely of directory delimiter characters, the -+; result of FILE_BASENAME is a single directory delimiter character. -+; - If there are any trailing directory delimiter characters, they -+; are removed. -+; - If any directory delimiter characters remain, all characters up -+; to and including the last directory delimiter are removed. -+; - If the RemoveSuffix argument is present, is not identical to the -+; characters remaining, and matches the suffix of the characters -+; remaining, the suffix is removed. Otherwise, the Result is not -+; modified by this step. -+; -+; PROCEDURE: -+; -+; EXAMPLE: -+; -+; print, file_basename('/usr/local/rsi/idl/lib/dist.pro', '.pro') -+; GDL prints: -+; dist -+; -+; MODIFICATION HISTORY: -+; - Sept 2007: created by Sebastien Masson -+; - Sept 2007: managing insufficient numbers of parameters, /help -+; - June 2010: escape special characters by Lea Noreskal -+; -+;- -+; LICENCE: -+; Copyright (C) 2007, Sebastien Masson -+; This program is free software; you can redistribute it and/or modify -+; it under the terms of the GNU General Public License as published by -+; the Free Software Foundation; either version 2 of the License, or -+; (at your option) any later version. -+;- -+; -+FUNCTION FILE_BASENAME_OLD, Path, RemoveSuffix, $ -+ FOLD_CASE = fold_case, help=help -+; -+ON_ERROR, 2 -+; -+if KEYWORD_SET(help) then begin -+ print, 'FUNCTION FILE_BASENAME, Path, [RemoveSuffix], [/FOLD_CASE], [/help]' -+ return, -1 -+endif -+; -+if ((N_PARAMS() LT 1) OR (N_PARAMS() GT 2)) then begin -+ MESSAGE, 'Incorrect number of arguments.' -+endif -+; -+IF KEYWORD_SET(fold_case) then begin -+ MESSAGE, 'Sorry, Keyword FOLD_CASE is not available now.' -+endif -+; -+sfx = N_ELEMENTS(RemoveSuffix) NE 0 ? RemoveSuffix : '' -+result = STRARR(N_ELEMENTS(Path)) -+; -+for i = 0, N_ELEMENTS(path) - 1 do begin -+ if STRTRIM(path[i], 2) ne '' then begin -+ SPAWN, '\basename ' + ESCAPE_SPECIAL_CHAR(path[i]) + ' ' + ESCAPE_SPECIAL_CHAR(sfx), res -+ result[i] = TEMPORARY(res) -+ endif else result[i] = path[i] -+endfor -+; -+return, SIZE(path, /n_dim) eq 0 ? result[0] : result -+; -+end -+ -Only in gdl-0.9.3/src/pro: file_basename.pro -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/file_dirname_old.pro gdl/src/pro/file_dirname_old.pro ---- gdl-0.9.3/src/pro/file_dirname_old.pro 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/pro/file_dirname_old.pro 2013-07-01 11:09:31.000000000 -0600 -@@ -0,0 +1,104 @@ -+; -+; Since First July 2013, because a C++ internal version is available -+; this file is OBSOLETING, will be removed in the future !! -+; -+;+ -+; NAME: FILE_DIRNAME -+; -+; PURPOSE: The FILE_DIRNAME function returns the dirname of a file -+; path. A file path is a string containing one or more segments -+; consisting of names separated by directory delimiter characters -+; (slash (/) under UNIX, or backslash (\) under Microsoft -+; Windows). The dirname is the final rightmost segment of the file -+; path; it is usually a file, but can also be a directory name. -+; -+; FILE_DIRNAME is based on the standard Unix dirname(1) utility. -+; -+; CATEGORY: UNIX utility. -+; -+; CALLING SEQUENCE: Result = FILE_DIRNAME(Path [, /MARK_DIRECTORY]) -+; -+; INPUTS: Path: A scalar string or string array containing the dirname -+; for each element of the Path argument. -+; -+; OPTIONAL INPUTS: none -+; -+; KEYWORD PARAMETERS: /MARK_DIRECTORY: Set this keyword to include a -+; directory separator character at the end of the returned directory -+; name string. Including the directory character allows you to -+; concatenate a file name to the end of the directory name string -+; without having to supply the separator character manually. This is -+; convenient for cross platform programming, as the separator -+; characters differ between operating systems. -+; -+; OUTPUTS: Result: A scalar string or string array containing the -+; dirname for each element of the Path argument. -+; Note: By default, the dirname does not include a final directory -+; separator character; this behavior can be changed using the -+; MARK_DIRECTORY keyword. -+; -+; OPTIONAL OUTPUTS: none -+; -+; COMMON BLOCKS: none -+; -+; SIDE EFFECTS: none -+; -+; RESTRICTIONS: only for Unix (Unix, Linux and Mac OS X) systems -+; -+; Rules used by FILE_DIRNAME -+; FILE_DIRNAME makes a copy of the input path string, and then -+; modifies the copy according to the following rules: -+; - If Path is a NULL string, then FILE_DIRNAME returns a single -+; dot (.) character, representing the current working directory of -+; the IDL process. -+; - If Path consists entirely of directory delimiter characters, -+; the result of FILE_DIRNAME is a single directory delimiter -+; character. -+; - All characters to the right of the rightmost directory -+; delimiter character are removed. -+; - All trailing directory delimiter characters are removed. -+; - If the MARK_DIRECTORY keyword is set, a single directory -+; delimiter character is appended to the end. -+; -+; PROCEDURE: -+; -+; EXAMPLE: -+; -+; print, file_dirname('/usr/local/rsi/idl/lib/dist.pro') -+; IDL prints: -+; /usr/local/rsi/idl/lib -+; -+; MODIFICATION HISTORY: -+; - Sept 2007: created by Sebastien Masson -+; - Setp 2007: mananing wrong numbers of parameters, /help -+; - June 2010: escape special characters by Lea Noreskal -+; -+;- -+; LICENCE: -+; Copyright (C) 2007, Sebastien Masson -+; This program is free software; you can redistribute it and/or modify -+; it under the terms of the GNU General Public License as published by -+; the Free Software Foundation; either version 2 of the License, or -+; (at your option) any later version. -+;- -+; -+FUNCTION FILE_DIRNAME_OLD, Path, MARK_DIRECTORY = mark_directory, help=help -+ on_error, 2 -+; -+if KEYWORD_SET(help) then begin -+ PRINT, 'FUNCTION FILE_DIRNAME, Path [, /mark_directory] [, /help]' -+ return, -1 -+endif -+; -+IF (N_PARAMS() NE 1) THEN BEGIN -+ MESSAGE, 'Incorrect number of arguments.' -+ENDIF -+; -+command = '\dirname ' + ESCAPE_SPECIAL_CHAR(Path) -+SPAWN, command, result -+; -+IF KEYWORD_SET(mark_directory) THEN result = result + PATH_SEP() -+; -+return, result -+; -+END -Only in gdl-0.9.3/src/pro: file_dirname.pro -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/interpol.pro gdl/src/pro/interpol.pro ---- gdl-0.9.3/src/pro/interpol.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/interpol.pro 2013-02-25 17:04:31.000000000 -0700 -@@ -8,6 +8,9 @@ - ; We have to manage also points in "p2" outside "p1" range ... - ; (new cases not include in testsuite/test_interpol.pro) - ; -+; revised 18-Feb-2013 by Alain C. after bug report 3602770 -+; We have to manage NaN and Infinity ... -+; - function INTERPOL, p0, p1, p2, lsquadratic=lsquadratic, $ - quadratic=quadratic, spline=spline, $ - test=test, help=help, debug=debug -@@ -15,35 +18,35 @@ - ON_ERROR, 2 - ; - if KEYWORD_SET(help) then begin -- print, 'function INTERPOL, p0, p1, p2, lsquadratic=lsquadratic, $' -- print, ' quadratic=quadratic, spline=spline, $' -- print, ' test=test, help=help, debug=debug' -- print, '/lsquadratic and /quadratic not available, help welcome !' -- return, -1 -+ print, 'function INTERPOL, p0, p1, p2, lsquadratic=lsquadratic, $' -+ print, ' quadratic=quadratic, spline=spline, $' -+ print, ' test=test, help=help, debug=debug' -+ print, '/lsquadratic and /quadratic not available, help welcome !' -+ return, -1 - endif - ; - ;; sanity checks - ; - if N_PARAMS() eq 1 then $ -- MESSAGE, 'Two or three parameters required' -+ MESSAGE, 'Two or three parameters required' - if KEYWORD_SET(lsquadratic) then $ -- MESSAGE, 'LSQUADRATIC keyword not supported yet (FIXME!)' -+ MESSAGE, 'LSQUADRATIC keyword not supported yet (FIXME!)' - if KEYWORD_SET(quadratic) then $ -- MESSAGE, 'QUADRATIC keyword not supported yet (FIXME!)' -+ MESSAGE, 'QUADRATIC keyword not supported yet (FIXME!)' - ; - ; if N_PARAMS() eq 3 and N_ELEMENTS(p0) ne N_ELEMENTS(p1) then $ - ; MESSAGE, 'In the three-parameter case the first and second argument must be of equal length' - ; - if N_PARAMS() eq 3 then begin -- if N_ELEMENTS(p0) ne N_ELEMENTS(p1) then $ -+ if N_ELEMENTS(p0) ne N_ELEMENTS(p1) then $ - MESSAGE, 'In the three-parameter case the first and second argument must be of equal length' -- ;; -- ;; note by AC, 27-02-2012: is it really true ?? -- all_equal_test=ABS((p1 - SHIFT(p1,+1))(1:*)) -- if MIN(TEMPORARY(all_equal_test)) eq 0 then begin -- MESSAGE, /cont, $ ; usually only triggered for integer arrays -- 'In the three-parameter case, the second argument must be strictly increasing or strictly decreasing.' -- endif -+ ;; -+ ;; note by AC, 27-02-2012: is it really true ?? -+ all_equal_test=ABS((p1 - SHIFT(p1,+1))(1:*)) -+ if MIN(TEMPORARY(all_equal_test)) eq 0 then begin -+ MESSAGE, /cont, $ ; usually only triggered for integer arrays -+ 'In the three-parameter case, the second argument must be strictly increasing or strictly decreasing.' -+ endif - endif - ; - ; -@@ -53,62 +56,92 @@ - nbp_inside=N_ELEMENTS(p0) - nbp_outside=0 - ; -+ExistNotFinite=0 -+; - if N_PARAMS() eq 2 then begin -- ;; regular grid case -- if SIZE(p1, /dimensions) eq 0 then begin -- ind = FINDGEN(p1) / (p1 - (p1 eq 1 ? 0 : 1)) * (N_ELEMENTS(p0) - 1) -- endif else begin -- MESSAGE, 'In the two-parameter case the second parameter must be a scalar' -- ;; TODO: IDL does something else here... -- endelse -+ ;; regular grid case -+ if SIZE(p1, /dimensions) eq 0 then begin -+ ind = FINDGEN(p1) / (p1 - (p1 eq 1 ? 0 : 1)) * (N_ELEMENTS(p0) - 1) -+ endif else begin -+ MESSAGE, 'In the two-parameter case the second parameter must be a scalar' -+ ;; TODO: IDL does something else here... -+ endelse - endif else if ~KEYWORD_SET(spline) then begin -- ;; irregular grid case -- ;; we need to manage points outside p1 range -- p1_min=MIN(p1, max=p1_max) -- outside_OK=WHERE((p2 LT p1_min) OR (p2 GT p1_max), nbp_outside) -- if (nbp_outside GT 0) then begin -- outside=p2[outside_OK] -- inside_OK=WHERE((p2 GE p1_min) AND (p2 LE p1_max), nbp_inside) -- if (nbp_inside GT 0) then begin -- p2_inside=p2[inside_OK] -- ind = FINDEX(p1, p2_inside) -- endif -- endif else begin -- ;; if we are here, all the points in "p2" are inside "p1" range -- ind=FINDEX(p1,p2) -- endelse -+ ;; first, we exclude the NaN and Infinity values ... -+ ;; if fact, we copy in another array the not finite values ... -+ p2_info=SIZE(p2,/dim) -+ index_p2_finite=WHERE(FINITE(p2) EQ 1, nbp_ok) -+ if (nbp_ok GT 0) then begin -+ if (N_ELEMENTS(p2) GT nbp_ok) then begin -+ ExistNotFinite=1 -+ index_p2_not_finite=WHERE(FINITE(p2) EQ 0) -+ p2_not_finite=p2[index_p2_not_finite] -+ p2=p2[index_p2_finite] -+ endif else begin -+ ;; all data are finite ... we don't need to recopy -+ ExistNotFinite=0 -+ endelse -+ endif else begin -+ ;; all input data are not finite ... -+ if KEYWORD_SET(test) then STOP -+ return, p2 -+ endelse -+ ;; irregular grid case -+ ;; we need to manage points outside p1 range -+ p1_min=MIN(p1, max=p1_max) -+ outside_OK=WHERE((p2 LT p1_min) OR (p2 GT p1_max), nbp_outside) -+ if (nbp_outside GT 0) then begin -+ outside=p2[outside_OK] -+ inside_OK=WHERE((p2 GE p1_min) AND (p2 LE p1_max), nbp_inside) -+ if (nbp_inside GT 0) then begin -+ p2_inside=p2[inside_OK] -+ ind = FINDEX(p1, p2_inside) -+ endif -+ endif else begin -+ ;; if we are here, all the points in "p2" are inside "p1" range -+ ind=FINDEX(p1,p2) -+ endelse - endif - ; - if KEYWORD_SET(spline) then begin -+ if (N_ELEMENTS(p0) LT 4) then MESSAGE, 'as least 4 input points need !' - ;; spline case - if N_PARAMS() eq 2 then begin -- x = FINDGEN(N_ELEMENTS(p0)) -- y = SPL_INTERP(x, p0, SPL_INIT(x, p0), ind) -- endif else begin -- y = SPL_INTERP(p1, p0, SPL_INIT(p1, p0), p2) -- endelse -- result=FIX(TEMPORARY(y), type=SIZE(p0, /type)) -+ x = FINDGEN(N_ELEMENTS(p0)) -+ y = SPL_INTERP(x, p0, SPL_INIT(x, p0), ind) -+ endif else begin -+ if (N_ELEMENTS(p1) LT 4) then MESSAGE, 'as least 4 input points need !' -+ y = SPL_INTERP(p1, p0, SPL_INIT(p1, p0), p2) -+ endelse -+ result=FIX(TEMPORARY(y), type=SIZE(p0, /type)) - endif else begin -- ;; linear interpolation case -- if (nbp_inside GT 0) then result=INTERPOLATE(isint ? FLOAT(p0) : p0, ind) -- if (nbp_outside GT 0) then begin -- tmp=p2 -- if (nbp_inside GT 0) then tmp[inside_OK]=result -- last=N_ELEMENTS(p0)-1 -- slope_begin=(1.*p0[1]-p0[0])/(p1[1]-p1[0]) -- slope_end =(1.*p0[last-1]-p0[last])/(p1[last-1]-p1[last]) -- for ii=0, nbp_outside-1 do begin -- if outside[ii] LT p1_min then begin -- tmp[outside_OK[ii]]=slope_begin*(outside[ii]-p1[0])+p0[0] -- endif else begin -- tmp[outside_OK[ii]]=slope_end*(outside[ii]-p1[last-1])+p0[last-1] -- endelse -- endfor -- result=tmp -- endif -+ ;; linear interpolation case -+ if (nbp_inside GT 0) then result=INTERPOLATE(isint ? FLOAT(p0) : p0, ind) -+ if (nbp_outside GT 0) then begin -+ tmp=p2 -+ if (nbp_inside GT 0) then tmp[inside_OK]=result -+ last=N_ELEMENTS(p0)-1 -+ slope_begin=(1.*p0[1]-p0[0])/(p1[1]-p1[0]) -+ slope_end =(1.*p0[last-1]-p0[last])/(p1[last-1]-p1[last]) -+ for ii=0, nbp_outside-1 do begin -+ if outside[ii] LT p1_min then begin -+ tmp[outside_OK[ii]]=slope_begin*(outside[ii]-p1[0])+p0[0] -+ endif else begin -+ tmp[outside_OK[ii]]=slope_end*(outside[ii]-p1[last-1])+p0[last-1] -+ endelse -+ endfor -+ result=tmp -+ endif - endelse - ; --if KEYWORD_SET(test) then STOP -+if ExistNotFinite then begin -+ resres=MAKE_ARRAY(p2_info, type=SIZE(result,/type)) -+ resres[index_p2_not_finite]=p2_not_finite -+ resres[index_p2_finite]=result -+ result=resres -+endif -+; -+if KEYWORD_SET(test) or KEYWORD_SET(debug) then STOP - ; - return, result - ; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/loadct.pro gdl/src/pro/loadct.pro ---- gdl-0.9.3/src/pro/loadct.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/loadct.pro 2013-02-25 17:04:31.000000000 -0700 -@@ -22,6 +22,8 @@ - ; NCOLORS number of colors to use. the smaller of - ; !D.TABLE_SIZE-1 and NCOLORS is used - ; BOTTOM first color index to use -+; RGB_TABLE=mytable return table colors in mytable, do not load -+; colortable. - ; - ; OUTPUTS: - ; none -@@ -58,7 +60,7 @@ - ;- - - pro LOADCT, table, GET_NAMES=names, FILE=file,$ -- NCOLORS=nColors,BOTTOM=bottom,SILENT=silent -+ NCOLORS=mynColors,BOTTOM=mybottom,SILENT=silent,RGB_TABLE=rgb_table - - on_error, 2 - common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr -@@ -70,8 +72,7 @@ - return - endif - --if N_ELEMENTS( table) eq 0 or not KEYWORD_SET( silent) then begin -- -+if N_ELEMENTS( table) eq 0 or not KEYWORD_SET(silent) then begin - LOADCT_INTERNALGDL,GET_NAMES=names - if n_elements( table) eq 0 then begin - for n=0,n_elements(names)-1 do begin -@@ -82,13 +83,26 @@ - endif - endif - -+if KEYWORD_SET(RGB_TABLE) then begin -+ LOADCT_INTERNALGDL,table,RGB_TABLE=rgb_table -+ return -+endif -+ - LOADCT_INTERNALGDL,table - - if not KEYWORD_SET( silent) then begin - MESSAGE,'Loading table ' + names[table],/INFO - endif - --if N_ELEMENTS(bottom) eq 0 then bottom=0 -+if N_ELEMENTS(mybottom) eq 0 then bottom=0 else begin -+ bottom=mybottom -+ bottom >= 0 & bottom <= !D.TABLE_SIZE-1 -+end -+if N_ELEMENTS(mynColors) eq 0 then nColors=!D.TABLE_SIZE else begin -+ nColors=mynColors -+ nColors >= 1 & nColors <=!D.TABLE_SIZE -+end -+if (bottom+nColors GE !D.TABLE_SIZE) then nColors=!D.TABLE_SIZE-bottom - - TVLCT,r,g,b,/GET - -@@ -98,14 +112,10 @@ - b_orig = bytarr( !D.TABLE_SIZE) - endif - --if KEYWORD_SET(Ncolors) then begin -- if N_ELEMENTS(Ncolors) NE 256 then begin -- idx=Lindgen(Ncolors)*255/(Ncolors-1) -- r=r[idx] -- g=g[idx] -- b=b[idx] -- endif --endif -+idx=Lindgen(nColors)*(!D.TABLE_SIZE-1)/(nColors-1) -+r=r[idx] -+g=g[idx] -+b=b[idx] - - r_orig[bottom] = r - g_orig[bottom] = g -@@ -114,7 +124,7 @@ - g_curr = g_orig - b_curr = b_orig - --TVLCT, r, g, b, bottom -+TVLCT, r_curr, g_curr, b_curr - - end - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/Makefile.am gdl/src/pro/Makefile.am ---- gdl-0.9.3/src/pro/Makefile.am 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/Makefile.am 2013-07-08 12:39:22.752382967 -0600 -@@ -12,12 +12,13 @@ - dialog_message.pro \ - dialog_pickfile.pro \ - dist.pro \ -+ doc_library.pro \ - escape_special_char.pro \ - factorial.pro \ -- file_basename.pro \ -+ file_basename_old.pro \ - file_copy.pro \ - file_delete.pro \ -- file_dirname.pro \ -+ file_dirname_old.pro \ - file_expand_path.pro \ - file_lines.pro \ - file_which.pro \ -@@ -47,6 +48,7 @@ - meanabsdev.pro \ - moment.pro \ - norm.pro \ -+ online_help.pro \ - path_sep.pro \ - ploterr.pro \ - poly.pro \ -Only in gdl-0.9.3/src/pro: Makefile.in -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/matrix_multiply.pro gdl/src/pro/matrix_multiply.pro ---- gdl-0.9.3/src/pro/matrix_multiply.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/matrix_multiply.pro 2013-05-16 12:36:33.000000000 -0600 -@@ -5,26 +5,60 @@ - ; - ; AUTHOR: Philippe Prugniel 2008/02/29 - ; --; Copyright (C) 2008, -+; Modifications: -+; 05-Feb-2013: when GDL is compiled with Eigen Lib., we use internal -+; fast MATMUL function. It is not ready for Complex/DoubleComplex -+; 01-Mar-2013: with Eigen Lib, matmul function is OK with complex values, removed -+; some code -+; 28-Mar-2013: MATMUL removed, direct interface to Eigen3, all types -+; should be OK -+; -+; Copyright (C) 2008, 2013. - ; This program is free software; you can redistribute it and/or modify - ; it under the terms of the GNU General Public License as published by - ; the Free Software Foundation; either version 2 of the License, or - ; (at your option) any later version. - ; - ;----------------------------------------------------------------------------- --function matrix_multiply, a, b, ATRANSPOSE=atr, BTRANSPOSE=btr -- on_error, 2 -- -- IF (N_PARAMS() NE 2) THEN BEGIN -- message, 'Incorrect number of arguments.' -- ENDIF --; -- case (1) of -- keyword_set(atr) and not keyword_set(btr): return, transpose(a) # b -- keyword_set(btr) and not keyword_set(atr): return, a # transpose(b) -- keyword_set(atr) and keyword_set(btr): return, transpose(a) # transpose(b) -+; -+function MATRIX_MULTIPLY, a, b, ATRANSPOSE=atr, BTRANSPOSE=btr, help=help -+; -+ON_ERROR, 2 -+; -+if KEYWORD_SET(help) then begin -+ print, 'function MATRIX_MULTIPLY, a, b, ATRANSPOSE=atr, BTRANSPOSE=btr, help=help' -+ return, -1 -+endif -+; -+IF (N_PARAMS() NE 2) THEN BEGIN -+ MESSAGE, 'Incorrect number of arguments.' -+ENDIF -+; -+; note by AC, 28 MArch 2013: we don't removed that if we need -+; to go back to basic tests related to Eigen3 ... -+; -+; "type" will be 1 if GDL compiled with Eigen, 0 -+; !matmul_quiet to avoid repeating internal message if no Eigen around ... -+; -+;DEFSYSV, "!matmul_quiet", exist=quiet -+;if ~quiet then begin -+; type=MATMUL(/available, quiet=quiet) -+; DEFSYSV, "!matmul_quiet", 1, 1 -+;endif else begin -+; type=MATMUL(/available,/quiet) -+;endelse -+; -+;if (type EQ 0) then begin -+ -+case (1) of -+ KEYWORD_SET(atr) and not KEYWORD_SET(btr): return, TRANSPOSE(a) # b -+ KEYWORD_SET(btr) and not KEYWORD_SET(atr): return, a # TRANSPOSE(b) -+ KEYWORD_SET(atr) and KEYWORD_SET(btr): return, TRANSPOSE(a) # TRANSPOSE(b) - else : return, a # b -- endcase -+endcase -+;endif else begin -+; return, MATMUL(a, b, ATRANSPOSE=atr, BTRANSPOSE=btr, debug=debug) -+;endelse - ; - end - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/online_help.pro gdl/src/pro/online_help.pro ---- gdl-0.9.3/src/pro/online_help.pro 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/pro/online_help.pro 2013-05-16 12:36:33.000000000 -0600 -@@ -0,0 +1,261 @@ -+;+ -+; -+; NAME: ONLINE_HELP -+; -+; PURPOSE: accessing the documentation, the general one or for a given -+; procedure of function (intrinsic or not) -+; -+; CATEGORY: documentation -+; -+; CALLING SEQUENCE: ( ? or ONLINE_HELP ) or ( ?fft or ONLINE_HELP, 'fft') -+; -+; INPUTS: no mandatory ones -+; -+; OPTIONAL INPUTS: name of a procedure, function or code -+; -+; KEYWORD PARAMETERS: -+; original ones: book=, context=, full_path=, title= -+; extensions : nopdf=nopdf, nohtml=nohtml, nokey=nokey, browser=browser, $ -+; path2pdf=path2pdf, path2key=path2key, link2html=link2htlm, $ -+; test=test, debug=debug, help=help, verbose=verbose -+; -+; OUTPUTS: none -+; -+; OPTIONAL OUTPUTS: none -+; -+; COMMON BLOCKS: none -+; -+; SIDE EFFECTS: may or not succeed to start a WEB browser. -+; -+; RESTRICTIONS: -+; -+; 1/ except if a copy of the "GDL.pdf" is locally available -+; and in the !path, an internet connection is mandatory ... -+; -+; 2/ the result is very sensitive to the version of the WEB browser -+; and which plugings (and pluging versions) are available. -+; -+; PROCEDURE: straitforward -+; -+; EXAMPLE: ONLINE_HELP, 'fft', browser='midori' -+; -+; MODIFICATION HISTORY: -+; -- 01-March-2013: creation by Alain Coulais, -+; -- 18-April-2013: managing the book= keyword, with/out /full_path -+; -+; LICENCE: This code is under GNU GPL v2 or later. -+; -+; -+; Very preliminary concept. the goal is to link to internal pages of -+; the PDF file "gdl.pdf" (eventually downloaded if not found) -+; (currently at: http://gnudatalanguage.sourceforge.net/gdl.pdf) -+; and also starting online HTML doc. -+; -+; The PDF file is currently at: http://gnudatalanguage.sourceforge.net/gdl.pdf -+; Following Adobe Documention, direct links to page, chapter shall be possible -+; http://partners.adobe.com/public/developer/en/acrobat/PDFOpenParameters.pdf -+; We use now only the search option ralated to Acroread viewer. -+; Up to now, no equivalent functions inside alternative PDF -+; readers (evince, xpdf) but is is supposed to be OK with "pdf.js" -+; pluging in Firefox https://github.com/mozilla/pdf.js/issues/1875 -+; -+; We have to consider to have local HTML version of the documentation. -+; -+; It seems that recent Firefox browsers can be call passing --new-tab -+; / --new-win -+; -+;- -+pro ONLINE_HELP, name, book=book, context=context, full_path=full_path, title=title, $ -+ nopdf=nopdf, nohtml=nohtml, nokey=nokey, browser=browser, $ -+ path2pdf=path2pdf, path2key=path2key, link2html=link2htlm, $ -+ test=test, debug=debug, help=help, verbose=verbose -+; -+ON_ERROR, 2 -+; -+if ~KEYWORD_SET(test) then ON_ERROR, 2 -+; -+if KEYWORD_SET(help) then begin -+ print, 'pro ONLINE_HELP, name, book=book, context=context, full_path=full_path, title=title, $' -+ print, ' nopdf=nopdf, nohtml=nohtml, nokey=nokey, browser=browser, $' -+ print, ' path2pdf=path2pdf, path2key=path2key, link2html=link2htlm, $' -+ print, ' test=test, debug=debug, help=help, verbose=verbose' -+ print, '' -+ return -+endif -+; -+if N_PARAMS() EQ 0 then name='' -+; -+if N_PARAMS() EQ 1 then name=STRCOMPRESS(name,/remove_all) -+; -+; do we have access to X11 ?? -+; (we may consider using Lynx (tested succesfully) but is it really -+; useful ?) -+; -+status=EXECUTE('xy=GET_SCREEN_SIZE()') -+if (status EQ 0) then begin -+ MESSAGE, 'Since we are unable to connect to X Windows display, no ONLINE HELP' -+endif -+; -+if KEYWORD_SET(context) then begin -+ MESSAGE, /continue, 'This option (only MSwin) is not available' -+endif -+; -+; setting a default browser if not provided -+; this code was tested with konqueror, midori and firefox -+; -+if ~KEYWORD_SET(browser) then begin -+ ;; classical default ! -+ browser='firefox' -+ ;; -+ ;; on some GNU/Linux systems, a BROWSER is defined ... -+ default_browser=GETENV('BROWSER') -+ if (STRLEN(default_browser) GT 0) then browser=default_browser -+ ;; -+ ;; on OSX, it seems to be better to use "open" but this is not -+ ;; working over ssh -X connection ... (suggestion welcome !) -+ ;; -+ if (!version.os EQ 'darwin') then browser='open' -+endif -+; -+; we check if the default or selected brower is in the path -+; -+SPAWN, 'which '+browser, ok, error -+; -+if (STRLEN(ok) EQ 0) then begin -+ MESSAGE, /continue, 'WEB Browser not found : '+browser -+ MESSAGE, 'Please provide the name (+path) to the browser you want to use' -+endif -+; -+space=' ' -+background=' &' -+; -+if KEYWORD_SET(book) then begin -+ ;; -+ ;; when the document is a PDF file, we try to use a PDF viewer -+ ;; -+ idx_suffixe=STRPOS(book, '.', /reverse_search) -+ ;; when the suffixe is not found we keed "browser" -+ if (idx_suffixe GE 0) then begin -+ suffixe=STRMID(book, idx_suffixe+1) -+ if STRLOWCASE(suffixe) EQ 'pdf' then begin -+ ;; don't hesitate to complete this list -+ list_of_pdf_viewers=['xpdf','evince','acroread'] -+ ;; if we don't locate a PDF viewer, we will use the default (web) Brower -+ for ii=0, N_ELEMENTS(list_of_pdf_viewers)-1 do begin -+ SPAWN, 'which '+list_of_pdf_viewers[ii], ok, error -+ if (STRLEN(ok) NE 0) then begin -+ browser=list_of_pdf_viewers[ii] -+ break -+ endif -+ endfor -+ endif -+ endif -+ if ~KEYWORD_SET(full_path) then begin -+ ;;message, /continue, 'ToDo : managing !HELP_PATH' -+ DEFSYSV, '!HELP_PATH', exist=exist -+ if exist then begin -+ book=FILE_WHICH(!HELP_PATH,book) -+ if (STRLEN(book) EQ 0) then MESSAGE, 'no file found, please check !HELP_PATH and book name' -+ endif else begin -+ ;; falling back to standard multi-tab help -+ MESSAGE, /continue, '!HELP_PATH not set !' -+ endelse -+ endif -+ ;; we have to check whether the file exist or not !! -+ if FILE_TEST(book) then begin -+ command=browser+space+book+background -+ goto, execute_command -+ endif -+endif -+; -+; link to IDL exelis in-line documentation -+; -+link1='' -+if ~KEYWORD_SET(nohtml) then begin -+ if ~KEYWORD_SET(link2html) then link2html='http://www.exelisvis.com/docs/' -+ suffixe='.html' -+ ;; -+ if STRLEN(name) GT 0 then begin -+ link1=space+link2html+STRUPCASE(name)+suffixe -+ endif else begin -+ link1=space+link2html -+ endelse -+endif -+; -+; link to PDF -+; if not found in the !PATH, this file is downloaded the first time -+; -+link2='' -+if ~KEYWORD_SET(nopdf) then begin -+ path2pdf='http://gnudatalanguage.sourceforge.net/' -+ local_pdf=FILE_WHICH(!path, 'gdl.pdf',/include_current_dir) -+ ;; -+ ;; if no "gdl.pdf" in the !Path, trying to download it -+ if STRLEN(local_pdf) EQ 0 then begin -+ script='' -+ SPAWN, 'which wget', res -+ if STRLEN(res) GT 0 then begin -+ script='wget ' -+ endif else begin -+ SPAWN, 'which curl', res -+ if STRLEN(res) GT 0 then script='curl -O ' -+ endelse -+ if (STRLEN(script) GT 0) then begin -+ SPAWN, script+path2pdf+'gdl.pdf', ok, pb -+ endif -+ local_pdf=FILE_WHICH(!path, 'gdl.pdf',/include_current_dir) -+ endif -+ ;; -+ if (STRLEN(local_pdf) GT 0) then begin -+ if STRLEN(name) GT 0 then begin -+ ;; activating the search capability inside PDF, -+ ;; worked on Acroread pluging -+ ;; should worked withing -+ link2='file://'+FILE_EXPAND_PATH(local_pdf)+'#search="'+name+'"' -+ endif else begin -+ link2='file://'+FILE_EXPAND_PATH(local_pdf) -+ endelse -+ endif else begin -+ MESSAGE, /continue, 'GDL pdf documentaion not found :(' -+ endelse -+endif -+; -+link3='' -+if ~KEYWORD_SET(nokey) then begin -+ path2key='http://aramis.obspm.fr/~coulais/IDL_et_GDL/' -+ ;; -+ if (STRLEN(name) GT 0) then begin -+ ;; is it a .PRO file ?? -+ pro_file=FILE_WHICH(name+'.pro') -+ if STRLEN(pro_file) GT 0 then begin -+ link3='file://'+pro_file+space -+ link3=link3+path2key+'Matrice_IDLvsGDL.html#'+STRUPCASE(STRMID(name,0,1)) -+ endif else begin -+ link3=path2key+'known_keywords.html#GDL_'+STRUPCASE(name) -+ endelse -+ endif else begin -+ link3=path2key+'Matrice_IDLvsGDL.html' -+ endelse -+endif -+; -+; line by line the command used by browser -+; -+if keyword_set(verbose) then begin -+ MESSAGE, /continue, 'link2html= : '+link2html -+ MESSAGE, /continue, 'path2pdf = : '+path2pdf -+ MESSAGE, /continue, 'path2key = : '+path2key -+endif -+; -+command=browser+space+link1+space+link2+space+link3+background -+; -+execute_command: -+; -+if KEYWORD_SET(debug) then begin -+ print, command -+ STOP -+endif -+SPAWN, command -+; -+if KEYWORD_SET(test) then stop -+; -+end -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/oploterr.pro gdl/src/pro/oploterr.pro ---- gdl-0.9.3/src/pro/oploterr.pro 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/src/pro/oploterr.pro 2013-07-26 08:42:50.000000000 -0600 -@@ -0,0 +1,148 @@ -+;+ -+; NAME: oploterr -+; -+; PURPOSE: oplot points with (symetrical) error bars -+; -+; CATEGORY: plotting -+; -+; CALLING SEQUENCE: oploterr [,x], y, y_error,[psym] -+; -+; INPUTS: Y (mandatory) -+; y_error (mandatory) -+; -+; OPTIONAL INPUTS: x (optional) -+; psym (optional, default : 7) -+; -+; for the procedure : -+; help <-- return list of keywords -+; -+; OUTPUTS: none -+; -+; OPTIONAL OUTPUTS: none -+; -+; COMMON BLOCKS: none -+; -+; SIDE EFFECTS: none ? -+; -+; RESTRICTIONS: - if sizes are differents, smaller size is used -+; - if not enough points, no plot -+; - arrays cannot be of type string -+; - we convert the rrors to ABS(error) -+; - take care that: -+; -- if 2 vectors (in this order): Y, Yerrors -+; -- if 3 vectors (in this order): X, Y, Yerrors -+; -+; PROCEDURE: - checks the number of input vectors -+; - oplot the errors -+; -+; EXAMPLE: see test_oploterr.pro -+; -+; nbp=10 & y=REPLICATE(1.,nbp) & yerr=RANDOMN(seed,10) & x=10+findgen(10)*2. -+; -+; plot, y, yerr -+; oploterr, y, yerr -+; plot, x, y -+; oploterr, x, y, yerr -+; -+; MODIFICATION HISTORY: -+; - 24/07/2013 created by GD as an edited version of PLOTERR by AC -+; -+;- -+; LICENCE: -+; Copyright (C) 2013, Alain Coulais, Gilles Duvert -+; This program is free software; you can redistribute it and/or modify -+; it under the terms of the GNU General Public License as published by -+; the Free Software Foundation; either version 2 of the License, or -+; (at your option) any later version. -+;- -+; -+pro OPLOTERR, x, y, y_error, psym, help=help -+; -+ON_ERROR,2 -+; -+if KEYWORD_SET(help) then begin -+ print, 'pro OPLOTERR, [x,] y, y_error, [psym]' -+ return -+endif -+; -+; -+; only "y" and "err" are mandatory -+; -+nb_inputs=N_PARAMS(0) -+; -+if (nb_inputs LT 2 or nb_inputs GT 4) then begin -+ mess='Must be called with 2-4 parameters: ' -+ mess=mess+'[X,] Y, Y_ERR [,PSYM] ...' -+ message, mess -+ return -+endif -+; -+; Here, we have ONLY Y and Y_error -+; -+if (nb_inputs EQ 2) then begin -+ y_new=x -+ y_err=y -+ nbp_y=N_ELEMENTS(y_new) -+ nbp_ey=N_ELEMENTS(y_err) -+ ;; the 2 missing fields -+ nbp_x=MIN([nbp_y, nbp_ey]) -+ ;; we have to generate a X vector -+ x_new=DINDGEN(nbp_x) -+endif -+; -+; We have X, Y and Y_error or Y,Yerror and psym... -+; -+if (nb_inputs EQ 3) then begin -+ if (n_elements(y_error) lt 2) then begin ; Y,Yerror and psym -+ y_new=x -+ x_new=dindgen(N_ELEMENTS(y_new)) -+ y_err=ABS(y) -+ nbp_x=N_ELEMENTS(x_new) -+ nbp_y=N_ELEMENTS(y_new) -+ nbp_ey=N_ELEMENTS(y_err) -+ mypsym=y_error ; psym -+ endif else begin -+ x_new=x -+ y_new=y -+ y_err=ABS(y_error) -+ nbp_x=N_ELEMENTS(x_new) -+ nbp_y=N_ELEMENTS(y_new) -+ nbp_ey=N_ELEMENTS(y_err) -+ mypsym=7 -+ endelse -+endif -+if (nb_inputs EQ 4) then begin -+ x_new=x -+ y_new=y -+ y_err=ABS(y_error) -+ nbp_x=N_ELEMENTS(x_new) -+ nbp_y=N_ELEMENTS(y_new) -+ nbp_ey=N_ELEMENTS(y_err) -+ mypsym=psym -+endif -+; -+nbp_min=MIN([nbp_x,nbp_y,nbp_ey]) -+if (nbp_min LT 2) then message, 'Not enough points to plot.' -+; -+; we limit the range for all array up to "nbp_min" -+; -+if (nbp_x GT nbp_min) then x_new=x_new[0:nbp_min-1] -+if (nbp_y GT nbp_min) then y_new=y_new[0:nbp_min-1] -+if (nbp_ey GT nbp_min) then y_err=y_err[0:nbp_min-1] -+; -+; oplot the values with psym -+oplot,x_new,y_new,psym=mypsym -+; we need 2 arrays for the top and the bottom of Errors -+; -+y_low=y_new-y_err -+y_hig=y_new+y_err -+; use NaN with PLOTS to go fast! -+null=replicate(!values.d_nan,nbp_min) -+x_new=reform(transpose([[x_new],[x_new],[null]]),3*nbp_min) -+y_new=reform(transpose([[y_low],[y_hig],[null]]),3*nbp_min) -+; overplot the error bars -+; -+plots,x_new,y_new,noclip=0 -+; -+end -+; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/ploterr.pro gdl/src/pro/ploterr.pro ---- gdl-0.9.3/src/pro/ploterr.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/ploterr.pro 2013-07-31 09:41:44.277244520 -0600 -@@ -160,7 +160,6 @@ - ; - nbp_min=MIN([nbp_x,nbp_y,nbp_ey,nbp_ex]) - if (nbp_min LT 2) then message, 'Not enough points to plot.' --if (nbp_min GT 100) then print, 'Warning: please wait until end of long rendering' - ; - ; we limit the range for all array up to "nbp_min" - ; -@@ -172,6 +171,8 @@ - ; - y_low=y_new-y_err - y_hig=y_new+y_err -+; use NaN with PLOTS to go fast! -+null=replicate(!values.d_nan,nbp_min) - ; - ; Eventually, we have also 2 arrays for X-errors - if (flag_x EQ 1) then begin -@@ -234,14 +235,21 @@ - ; we overplot the error bars - ; - ; begin of basic PLOTERR feature (only on Y axis ...) --; --for i=0,(nbp_min-1) do PLOTS,[x_new[i], x_new[i]], [y_low[i], y_hig[i]] -+; speedup trick by GD - to be tested - -+x_new2=reform(transpose([[x_new],[x_new],[null]]),3*nbp_min) -+y_new2=reform(transpose([[y_low],[y_hig],[null]]),3*nbp_min) -+plots,x_new2,y_new2 -+ -+;for i=0,(nbp_min-1) do PLOTS,[x_new[i], x_new[i]], [y_low[i], y_hig[i]] - ; - ; end of basic PLOTERR feature --; begin og extra PLOTERR features ! -+; begin of extra PLOTERR features ! - ; - if (flag_x EQ 1) then begin -- for i=0,(nbp_min-1) do PLOTS,[x_low[i], x_hig[i]], [y_new[i], y_new[i]] -+ x_new3=reform(transpose([[x_low],[x_hig],[null]]),3*nbp_min) -+ y_new3=reform(transpose([[y_new],[y_new],[null]]),3*nbp_min) -+ plots,x_new3,y_new3 -+; for i=0,(nbp_min-1) do PLOTS,[x_low[i], x_hig[i]], [y_new[i], y_new[i]] - endif - ; - if KEYWORD_SET(hat) then begin -@@ -283,20 +291,26 @@ - ;; - x_hatlow=x_new-x_half - x_hathig=x_new+x_half -- for i=0,(nbp_min-1) do begin -- PLOTS,[x_hatlow[i], x_hathig[i]], [y_low[i], y_low[i]] -- PLOTS,[x_hatlow[i], x_hathig[i]], [y_hig[i], y_hig[i]] -- endfor -+ x_new4=reform(transpose([[x_hatlow],[x_hathig],[null],[x_hatlow],[x_hathig],[null]]),6*nbp_min) -+ y_new4=reform(transpose([[y_low],[y_low],[null],[y_hig],[y_hig],[null]]),6*nbp_min) -+ plots,x_new4,y_new4 -+; for i=0,(nbp_min-1) do begin -+; PLOTS,[x_hatlow[i], x_hathig[i]], [y_low[i], y_low[i]] -+; PLOTS,[x_hatlow[i], x_hathig[i]], [y_hig[i], y_hig[i]] -+; endfor - ;; - ;; second we plot the Vertical hats of the Horizontal bars - ;; - if (flag_x EQ 1) then begin - y_hatlow=y_new-y_half - y_hathig=y_new+y_half -- for i=0,(nbp_min-1) do begin -- PLOTS,[x_low[i], x_low[i]], [y_hatlow[i], y_hathig[i]] -- PLOTS,[x_hig[i], x_hig[i]], [y_hatlow[i], y_hathig[i]] -- endfor -+ y_new5=reform(transpose([[y_hatlow],[y_hathig],[null],[y_hatlow],[y_hathig],[null]]),6*nbp_min) -+ x_new5=reform(transpose([[x_low],[x_low],[null],[x_hig],[x_hig],[null]]),6*nbp_min) -+ plots,x_new5,y_new5 -+; for i=0,(nbp_min-1) do begin -+; PLOTS,[x_low[i], x_low[i]], [y_hatlow[i], y_hathig[i]] -+; PLOTS,[x_hig[i], x_hig[i]], [y_hatlow[i], y_hathig[i]] -+; endfor - endif - endif - ; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/read_ascii.pro gdl/src/pro/read_ascii.pro ---- gdl-0.9.3/src/pro/read_ascii.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/read_ascii.pro 2013-05-16 12:36:33.000000000 -0600 -@@ -244,8 +244,8 @@ - MESSAGE, 'DATA_START value >= data length (' $ - + STRTRIM(STRING(data_start), 2) + ' >= ' $ - + STRTRIM(STRING(N_ELEMENTS(text)),2) + ')' -- text = text[data_start:*] - endif -+ text = text[data_start:*] - endif - ; - ;----------------- -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/smooth.pro gdl/src/pro/smooth.pro ---- gdl-0.9.3/src/pro/smooth.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/smooth.pro 2013-07-08 12:39:22.782382612 -0600 -@@ -219,7 +219,7 @@ - ;; - ;; this will be dimensions for 1d kernel ([1,1,1]) - ;; -- output_array=input_array -+ ;output_array=input_array - for i=0,N_ELEMENTS(real_width)-1 do begin - temp_width[i]=real_width[i] - ;; -@@ -230,7 +230,8 @@ - ;;creating kernel (gate) for 1d convolution - ;; - norm_of_gate=TOTAL(gate) -- output_array=CONVOL(TEMPORARY(output_array), gate, norm_of_gate, $ -+; output_array=CONVOL(TEMPORARY(output_array), gate, norm_of_gate, $ -+ output_array=CONVOL(input_array, gate, norm_of_gate, $ - EDGE_TRUNCATE=EDGE_TRUNCATE) - ;; - ;;convolution with 1d kernel -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/str_sep.pro gdl/src/pro/str_sep.pro ---- gdl-0.9.3/src/pro/str_sep.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/str_sep.pro 2013-07-08 12:39:22.783382600 -0600 -@@ -73,6 +73,9 @@ - endif - ;; debug=1 - resu='' -+ if SIZE(str_input, /type) NE 7 then begin -+ str_input = byte( str_input) -+ end - residual=STRING(str_input) - while (STRLEN(residual) GT 0) do begin - pos=STRPOS(residual, str_separator) -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/strsplit.pro gdl/src/pro/strsplit.pro ---- gdl-0.9.3/src/pro/strsplit.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/strsplit.pro 2013-08-04 20:25:19.391697899 -0600 -@@ -22,11 +22,18 @@ - ; 11-Jul-2012 : When /extract, we must return STRARR even for 1-element - ; 14-Aug-2012 : Now GDL enforces scalar type in FOR loop ... take care - ; of STRLEN ! We ensure to work on pure STRING = '', not STRING = Array[1] -+; 25-Jul-2013 : After fixing STRTOK this simplified version should -+; do. -+; 01-Aug-2013 : Patch for bug #554, insure LENGTH and EXTRACT are -+; not present simultaneously, return correct length in cases such as -+; strsplit('aaaaaaaaaaaaaaaaaaaaaa','b',leng=leng) and -+; strsplit('aaaaaaaaaaaaaaaaaaaaaa','a',leng=leng). - ; - ; LICENCE: - ; Copyright (C) - ; 2004, Pierre Chanial - ; 2010, Alain Coulais and Lea Noreskal; 2012 :AC -+; 2013, Marc Schellens - ; This program is free software; you can redistribute it and/or modify - ; it under the terms of the GNU General Public License as published by - ; the Free Software Foundation; either version 2 of the License, or -@@ -34,39 +41,10 @@ - ; - ;- - ; --function STRMULTIPOS, str, single_char, test=test --; --ON_ERROR, 2 --; --if (SIZE(str, /type) NE 7) OR (SIZE(single_char, /type) NE 7) then begin -- MESSAGE, 'Invalid input string.' -- return, -1 --endif --if (STRLEN(single_char) NE 1) then begin -- MESSAGE, 'field2 must be a Single Char' -- return, -1 --endif --; --inside_str=str[0] --; --resu=-1 --; --for ii=0, STRLEN(inside_str)-1 do begin -- sub_str=STRMID(inside_str,ii,1) -- if (sub_str EQ single_char) then resu=[resu,ii] --endfor --; --if N_ELEMENTS(resu) GT 1 then resu=resu[1:*] --; --if KEYWORD_SET(test) then STOP --; --return, resu --; --end - ; - ; ---------------------------------------- - ; --function STRSPLIT, input1, input2, count=count, length=length, $ -+function STRSPLIT, input1, pattern, count=count, length=length, $ - extract=extract, regex=regex, escape=escape, $ - fold_case=fold_case, preserve_null=preserve_null, $ - test=test, help=help -@@ -74,7 +52,7 @@ - ON_ERROR, 2 - ; - if KEYWORD_SET(help) then begin -- print, 'function STRSPLIT, input1, input2, count=count, length=length, $' -+ print, 'function STRSPLIT, input1, pattern, count=count, length=length, $' - print, ' extract=extract, regex=regex, escape=escape, $' - print, ' fold_case=fold_case, preserve_null=preserve_null, $' - print, ' test=test, help=help' -@@ -90,7 +68,7 @@ - MESSAGE, 'Expression must be a scalar or 1 element array in this context: STRINGIN.' - ; - if (N_PARAMS() EQ 2) then begin -- if N_ELEMENTS(input2) EQ 0 then MESSAGE, 'Variable is undefined: PATTERN.' -+ if N_ELEMENTS(pattern) EQ 0 then MESSAGE, 'Variable is undefined: PATTERN.' - endif - ; - if KEYWORD_SET(escape) then begin -@@ -115,6 +93,7 @@ - local_input1=input1 - endelse - ; -+if ARG_PRESENT(length) and KEYWORD_SET(extract) then MESSAGE, "Conflicting keywords." - ; we explicitely change String [1] array into pure String. - local_input1=local_input1[0] - ; -@@ -127,91 +106,29 @@ - if KEYWORD_SET(extract) then resu='' else resu=0 - endif - if (N_PARAMS() EQ 2) then begin -- if (STRLEN(input2) EQ 0) then begin -+ if (STRLEN(pattern) EQ 0) then begin - short_cut=1 - if KEYWORD_SET(extract) then resu='' else resu=0 - endif else begin -- local_input2=input2[0] -+ local_pattern=pattern[0] - endelse - endif - ; --; When no Pattern is provided, default pattern is white space (' ') -+; When no Pattern is provided, default pattern is white space (' ' and -+; tab) - ; - if ((short_cut EQ 0) AND (N_PARAMS() EQ 1)) then begin -- resu=STRTOK(local_input1, extract=extract, preserve_null=preserve_null) -+ resu=STRTOK(local_input1, extract=extract,$ -+ REGEX=regex, preserve_null=preserve_null) -+; 2nd pass for length. -+if ARG_PRESENT(length) then temp=STRTOK(local_input1, LENGTH=length, REGEX=regex, preserve_null=preserve_null) - endif - ; - if ((short_cut EQ 0) AND (N_PARAMS() EQ 2)) then begin -- ;; -- ;; AC 14-Oct-2010: may be not fully OK -- if KEYWORD_SET(regex) then begin -- resu=STRTOK(local_input1, local_input2, extract=extract,$ -- REGEX=regex, preserve_null=preserve_null) -- endif else begin -- resu=0 -- beg=0 -- ;; -- for ii=0, STRLEN(local_input2)-1 do begin -- resu=[resu, STRMULTIPOS(local_input1, STRMID(local_input2, ii, 1))] -- endfor -- ;; -- resu=resu[WHERE(resu GE 0)] -- tst=resu[WHERE(resu EQ 0)] -- resu=resu[UNIQ(resu,SORT(resu))] -- ;; -- if N_ELEMENTS(tst) EQ 2 then beg=1 -- ;; -- if KEYWORD_SET(extract) then begin -- if (beg eq 1) then resu=[0,resu] -- if N_ELEMENTS(resu) EQ 1 then begin -- if (beg eq 0) then begin -- resu=local_input1 -- endif else begin -- resu=STRMID(local_input1, resu[0]+1) -- endelse -- endif else begin -- sresu=STRARR(N_ELEMENTS(resu)) -- if (beg eq 0) then begin -- sresu[0]=STRMID(local_input1, 0, resu[1]) -- endif else begin -- sresu[0]=STRMID(local_input1, resu[0]+1, resu[1]-resu[0]-1) -- endelse -- -- for ii=1, N_ELEMENTS(resu)-2 do begin -- ;;print, resu[ii]+1,resu[ii+1]-resu[ii]-1 -- sresu[ii]=STRMID(local_input1, resu[ii]+1,resu[ii+1]-resu[ii]-1) -- endfor -- sresu[N_ELEMENTS(resu)-1]=STRMID(local_input1, resu[N_ELEMENTS(resu)-1]+1) -- ;;stop -- resu=sresu -- endelse -- ;; -- if NOT(KEYWORD_SET(preserve_null)) then begin -- ok=WHERE(STRLEN(resu) GT 0, nb_ok) -- if (nb_ok GT 0) then resu=resu[ok] else resu='' -- endif -- ;; going back to the case /extract not set -- endif else begin -- if N_ELEMENTS(resu) GT 1 then resu[1:*]=resu[1:*]+1 else resu=0 -- if (beg EQ 1) then resu[0]=resu[0]+1 -- -- if (KEYWORD_SET(preserve_null) and (N_ELEMENTS(resu) GT 1) and (resu[0] ne 0)) then resu=[0,resu] -- -- if NOT(KEYWORD_SET(preserve_null)) then begin -- refresu=resu -- resu=-1 -- -- for ii=0, N_ELEMENTS(refresu)-2 do begin -- if ((refresu[ii+1]-refresu[ii]) ne 1) then resu=[resu,refresu[ii]] -- endfor -- -- -- if (refresu[N_ELEMENTS(refresu)-1] lt STRLEN(local_input1)) then resu=[resu,refresu[N_ELEMENTS(refresu)-1]] -- if (N_ELEMENTS(resu) eq 1 ) then resu=0 else resu=resu[WHERE(resu GE 0)] -- -- endif -- endelse -- endelse -+ resu=STRTOK(local_input1, local_pattern, extract=extract,$ -+ REGEX=regex, preserve_null=preserve_null) -+; 2nd pass for length. -+ if ARG_PRESENT(length) then temp=STRTOK(local_input1, local_pattern, LENGTH=length, REGEX=regex, preserve_null=preserve_null) - endif - ; - if ARG_PRESENT(count) then begin -@@ -222,8 +139,6 @@ - endelse - endif - ; --if ARG_PRESENT(length) then length=STRLEN(resu) --; - if KEYWORD_SET(test) then STOP - ; - if (SIZE(resu,/type) NE 7) then begin -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/wmenu.pro gdl/src/pro/wmenu.pro ---- gdl-0.9.3/src/pro/wmenu.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/wmenu.pro 2013-01-13 16:49:28.000000000 -0700 -@@ -1,8 +1,8 @@ - ;+ - ; NAME: WMENU - ; --; PURPOSE: This a emulation of the famous X11 WMENU (obsolete --; routine). We provide a Zenity-based version but also a text-based version. -+; PURPOSE: This a emulation of the famous X11 WMENU (obsolete routine). -+; We provide a Zenity-based version but also a text-based version. - ; - ; Credits: with some idea form EMENU (from SolarSoft (Soho, Nasa)) - ; -@@ -52,7 +52,7 @@ - ; - 25-JAN-2006 : created by Alain Coulais - ; - 09-FEB-2006 : various debugging (WHERE does not work with STRINGs!) - ; - 13-FEB-2006 : title is a index, not a string ! --; - 19-NOV-2012 : Zenity-based version -+; - 19-NOV-2012 : Zenity-based version, pushed in the public CVS - ;- - ; LICENCE: - ; Copyright (C) 2006-2012, Alain Coulais -@@ -216,7 +216,7 @@ - ; - list_flag=REPLICATE(' ', nbp_local) - if (flag_init EQ 1) then list_flag(init)='* ' --print, transpose(list_flag+answers_str+' | '+local_choice) -+print, TRANSPOSE(list_flag+answers_str+' | '+local_choice) - ; - if KEYWORD_SET(test) then stop - ; -@@ -265,7 +265,7 @@ - ; -------------------------------------------------- - ; - function WMENU_ZENITY, list_of_choice, title=title, init=init, $ -- strict=strict, test=test, help=help -+ strict=strict, test=test, help=help, debug=debug - ; - zenity=!zenity.name - ; -@@ -287,17 +287,19 @@ - for ii=0, N_ELEMENTS(list_of_choice)-1 do begin - reform_list_of_choice=reform_list_of_choice+' "'+Str_list_of_choice[ii]+'"' - endfor -- -+; - command=zenity+cmd_title+cmd_text+cmd_column_text - command=command+' --list '+reform_list_of_choice - ; --help, command -+if KEYWORD_SET(debug) then HELP, command -+; -+SPAWN, command, result, error -+; -+if KEYWORD_SET(debug) then begin -+ print, 'SPAWN returned error : ', error -+ print, 'SPAWN returned result : ', result -+endif - ; --spawn, command, result, error -- --print, error --print, result -- - indice=WHERE(result EQ Str_list_of_choice) - - indice2=STRPOS(Str_list_of_choice, result) -@@ -307,22 +309,21 @@ - print, 'Warning, More than one entry found' - endif - indice=OK[0] -- -+; - return, indice -- -+; - end -- -- -+; - ; -------------------------------------------------- - ; - function WMENU, list_of_choice, title=title, init=init, $ -- test=test, help=help -+ test=test, help=help, debug=debug - ; - ON_ERROR, 2 - ; - if KEYWORD_SET(help) then begin - print, 'function WMENU, list_of_choice, title=title, init=init, $' -- print, ' test=test, help=help' -+ print, ' test=test, help=help, debug=debug' - return, -1 - end - ; -@@ -347,9 +348,11 @@ - endif - ; - if (!zenity.version LT 0) then begin -- resu=WMENU_TEXT(list_of_choice, title=title, init=init, test=test, help=help) -+ resu=WMENU_TEXT(list_of_choice, title=title, init=init, $ -+ test=test, help=help) - endif else begin -- resu=WMENU_ZENITY(list_of_choice, title=title, init=init, test=test, help=help) -+ resu=WMENU_ZENITY(list_of_choice, title=title, init=init, $ -+ test=test, help=help, debug=debug) - endelse - ; - if KEYWORD_SET(help) then STOP -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/write_png.pro gdl/src/pro/write_png.pro ---- gdl-0.9.3/src/pro/write_png.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/write_png.pro 2013-07-31 09:41:44.353244255 -0600 -@@ -22,9 +22,8 @@ - ; green: the Green colormap vector (for PseudoColor images) - ; blue : the Blue colormap vector (for PseudoColor images) - ; --; - ; RESTRICTIONS: --; Requires ImageMagick (this is tested) -+; Requires ImageMagick or GraphicsMagick (this is tested) - ; - ; PROCEDURE: - ; Use ImageMagick to write the data as requested -@@ -45,6 +44,11 @@ - ; - 2D images can be writen (but not the best way today :( - ; (help welcome, same problem than in WRITE_JPEG) - ; -+; Modifications by Alain Coulais 17-Jul-2013: -+; -correcting bug 553 (color mixing in 2D+RBG) -+; test case: next image must be red !! -+; WRITE_PNG,'test.png', DIST(256), INDGEN(256), INTARR(256), INTARR(256) -+; - ;- - ; LICENCE: - ; Copyright (C) 2004, 2011, 2012: CL, JMG, AC -@@ -133,7 +137,7 @@ - ;; - MAGICK_WRITECOLORTABLE, mid, red, green, blue - ; MAGICK_WRITE, mid, reform(image,1,im_size[0],im_size[1]) ;, rgb=rgb -- MAGICK_WRITE, mid, _image -+ MAGICK_WRITE, mid, _image, rgb=rgb - if (KEYWORD_SET(order)) then MAGICK_FLIP, mid - MAGICK_WRITEFILE, mid, filename, "PNG" - MAGICK_CLOSE, mid -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pro/zenity_check.pro gdl/src/pro/zenity_check.pro ---- gdl-0.9.3/src/pro/zenity_check.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pro/zenity_check.pro 2013-01-13 16:49:28.000000000 -0700 -@@ -14,13 +14,9 @@ - ; - ; KEYWORD PARAMETERS: - ; -+; OUTPUTS: a name or '' - ; --; --; OUTPUTS: a name --; --; --; --; OPTIONAL OUTPUTS: zenity_version= an u -+; OPTIONAL OUTPUTS: - ; - ; COMMON BLOCKS: none - ; -@@ -55,11 +51,13 @@ - ;- - function ZENITY_CHECK, zenity_name=zenity_name, zenity_path=zenity_path, $ - zenity_version=zenity_version, reset=reset, $ -+ show_path=show_path, how_to_install=how_to_install, $ - help=help, test=test, debug=debug, verbose=verbose - ; - if KEYWORD_SET(help) then begin - print, 'function ZENITY_CHECK, zenity_name=zenity_name, zenity_path=zenity_path, $' - print, ' zenity_version=zenity_version, reset=reset, $' -+ print, ' show_path=show_path, how_to_install=how_to_install, $' - print, ' help=help, test=test, debug=debug, verbose=verbose' - return, -1 - endif -@@ -128,14 +126,31 @@ - endif - if (list_zenity eq '') then begin - MESSAGE, /continue, 'Zenity not found ! Zenity must be installed or in your PATH.' -- MESSAGE, /continue, 'Your current path is : '+GETENV('PATH') - MESSAGE, /continue, 'You can give a path to Zenity with keyword ZENITY_PATH=' - MESSAGE, /continue, 'or using shell $ZENITY_PATH' -- if (STRLOWCASE(!version.OS) EQ 'darwin') then begin -- MESSAGE, /continue, ' ' -- MESSAGE, /continue, 'How to install "zenity" on OSX ? Please have a look here:' -- MESSAGE, /continue, 'http://www.macports.org/ports.php?by=name&substr=zenity' -- endif -+ MESSAGE, /continue, '' -+ ;; -+ if KEYWORD_SET(show_path) then begin -+ MESSAGE, /continue, 'Your current path where Zenity is searched in is : ' -+ print, TRANSPOSE(STRSPLIT(GETENV('PATH'), ':',/extract)) -+ endif else begin -+ MESSAGE, /continue, 'zen=ZENITY_CHECK(/show_path) to see the researched paths' -+ endelse -+ ;; -+ if KEYWORD_SET(how_to_install) then begin -+ MESSAGE, /continue, ' On Debian/Ubuntu like distros: sudo apt-get install zenity' -+ MESSAGE, /continue, ' On RH/FC/CentOS like distros: yum install zenity' -+ MESSAGE, /continue, ' On OSX distros: port install zenity' -+ ;; -+ if (STRLOWCASE(!version.OS) EQ 'darwin') then begin -+ MESSAGE, /continue, ' ' -+ MESSAGE, /continue, 'How to install "zenity" on OSX ? Please have a look here:' -+ MESSAGE, /continue, 'http://www.macports.org/ports.php?by=name&substr=zenity' -+ endif -+ endif else begin -+ MESSAGE, /continue, 'zen=ZENITY_CHECK(/how_to_install) to see how to add Zenity' -+ endelse -+ ;; - zenity_struct={name: '', version: -1} - DEFSYSV, '!zenity', zenity_struct - return, '' -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/prognode.cpp gdl/src/prognode.cpp ---- gdl-0.9.3/src/prognode.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/prognode.cpp 2013-07-31 09:41:44.213244743 -0600 -@@ -31,13 +31,19 @@ - bool* GetNonCopyNodeLookupArray() - { - static bool nonCopyNodeLookupArray[ GDLTokenTypes::MAX_TOKEN_NUMBER]; --for( int i=0; ilabelEnd) - { - initInt = refNode->initInt; -+ if( libFun != NULL) -+ libFunFun = libFun->Fun(); -+ else if( libPro != NULL) -+ libProPro = libPro->Pro(); - } - - -@@ -134,20 +144,24 @@ - { - ProgNodeP _t = this->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - BaseGDL* res; - if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- res=interpreter->lib_function_call(_t); -- _t = interpreter->GetRetTree(); -- if( !interpreter->CallStackBack()->Contains( res)) -- r_guard.reset( res); -+// res=interpreter->lib_function_call(_t); -+// _t = interpreter->GetRetTree(); -+ res = static_cast(_t)->EvalFCALL_LIB(); -+ if( !interpreter->CallStackBack()->Contains( res)) -+ r_guard.Reset( res); -+ _t = _t->getNextSibling(); - } - else - { -- res=interpreter->tmp_expr(_t); -- _t = interpreter->GetRetTree(); -- r_guard.reset( res); -+// res=interpreter->tmp_expr(_t); -+// _t = interpreter->GetRetTree(); -+ res = _t->Eval(); -+ r_guard.Reset( res); -+ _t = _t->getNextSibling(); - } - - BaseGDL** l=_t->LExpr( res); //l_expr(_t, res); -@@ -162,21 +176,25 @@ - { - ProgNodeP _t = this->getFirstChild(); - -- auto_ptr r_guard; -+ Guard r_guard; - - BaseGDL* res; - if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- res=interpreter->lib_function_call(_t); -- _t = interpreter->GetRetTree(); -+// res=interpreter->lib_function_call(_t); -+// _t = interpreter->GetRetTree(); -+ res = static_cast(_t)->EvalFCALL_LIB(); - if( !interpreter->CallStackBack()->Contains( res)) -- r_guard.reset( res); -+ r_guard.Reset( res); -+ _t = _t->getNextSibling(); - } - else - { -- res=interpreter->tmp_expr(_t); -- _t = interpreter->GetRetTree(); -- r_guard.reset( res); -+// res=interpreter->tmp_expr(_t); -+// _t = interpreter->GetRetTree(); -+ res = _t->Eval(); -+ r_guard.Reset( res); -+ _t = _t->getNextSibling(); - } - - ProgNodeP mark = _t; -@@ -218,42 +236,45 @@ - } - BaseGDL* ASSIGN_REPLACENode::Eval() - { -- ProgNodeP _t = this->getFirstChild(); -+ ProgNodeP _t = this->getFirstChild(); - -- auto_ptr r_guard; -+// Guard r_guard; -+// BaseGDL* res; -+// if( _t->getType() == GDLTokenTypes::FCALL_LIB) -+// { -+// // res=interpreter->lib_function_call(_t); -+// // _t = interpreter->GetRetTree(); -+// res = static_cast(_t)->EvalFCALL_LIB(); -+// _t = _t->getNextSibling(); -+// if( !interpreter->CallStackBack()->Contains( res)) -+// r_guard.Init( res); -+// else if( res == (*l)) -+// return; -+// } -+// else -+// { -+// // res=interpreter->tmp_expr(_t); -+// // _t = interpreter->GetRetTree(); -+// res = _t->Eval(); -+// _t = _t->getNextSibling(); -+// r_guard.Init( res); -+// } - -- BaseGDL* res; -- if( _t->getType() == GDLTokenTypes::FCALL_LIB) -- { -- res=interpreter->lib_function_call(_t); -- _t = interpreter->GetRetTree(); -- if( !interpreter->CallStackBack()->Contains( res)) -- r_guard.reset( res); -- } -- else -- { -- res=interpreter->tmp_expr(_t); -- _t = interpreter->GetRetTree(); -- r_guard.reset( res); -- } -+ BaseGDL* res = _t->Eval(); -+ Guard r_guard( res); - -- BaseGDL** l=_t->LEval(); -- //_t = _t->getNextSibling(); -- //_t = _retTree; -+ _t = _t->getNextSibling(); - -- if( res != (*l)) -- { -- GDLDelete(*l); -- *l = res->Dup(); -+ BaseGDL** l=_t->LEval(); - -- if( r_guard.get() == res) // owner -- { -- r_guard.release(); -- } -- else -- res = res->Dup(); -- } -- return res; -+ if( *l != res) -+ { -+ GDLDelete(*l); -+ *l = res; -+ } -+ r_guard.Release(); -+ -+ return res->Dup(); - } - - -@@ -283,56 +304,71 @@ - - DType ty=e->Type(); - if( ty == GDL_UNDEF) -- { -- throw GDLException( _t, "Variable is undefined: "+ -- ProgNode::interpreter->Name(e),true,false); -- } -+ { -+ throw GDLException( _t, "Variable is undefined: "+ -+ ProgNode::interpreter->Name(e),true,false); -+ } -+ - if( cType == GDL_UNDEF) -- { -- cType=ty; -- cTypeData=e; -- } -+ { -+// array of struct is (of course) fine -+// if( DTypeOrder[ty] >= 100) // struct, ptr, object -+// { -+// throw -+// GDLException( _t, e->TypeStr()+ -+// " is not allowed in this context.",true,false); -+// } -+ -+ cType=ty; -+ cTypeData=e; -+ } - else -- { -- if( cType != ty) -- { -- if( DTypeOrder[ty] > 100 || DTypeOrder[cType] > 100) // struct, ptr, object -+ { -+ if( cType != ty) -+ { -+ // update order if larger type (or types are equal) -+ if( DTypeOrder[ty] >= DTypeOrder[cType]) -+ { -+ if( DTypeOrder[ty] >= 100) // struct, ptr, object - { - throw - GDLException( _t, e->TypeStr()+ - " is not allowed in this context.",true,false); - } -- -- // update order if larger type (or types are equal) -- if( DTypeOrder[ty] >= DTypeOrder[cType]) -- { -- cType=ty; -- cTypeData=e; -- } -- } -- if( ty == GDL_STRUCT) -- { -- // check for struct compatibility -- DStructDesc* newS= -- static_cast(e)->Desc(); -- DStructDesc* oldS= -- static_cast(cTypeData)->Desc(); -- -- // *** here (*newS) != (*oldS) must be set when -- // unnamed structs not in struct list anymore -- // WRONG! This speeds up things for named structs -- // unnamed structs all have their own desc -- // and thus the next is always true for them -- if( newS != oldS) -+ -+ cType=ty; -+ cTypeData=e; -+ } -+ else if( DTypeOrder[cType] >= 100) // struct, ptr, object - { -- -- if( (*newS) != (*oldS)) -- throw GDLException( _t, -- "Conflicting data structures: "+ -- ProgNode::interpreter->Name(cTypeData)+", "+ProgNode::interpreter->Name(e),true,false); -- } -- } -- } -+ throw -+ GDLException( _t, cTypeData->TypeStr()+ -+ " is not allowed in this context.",true,false); -+ } -+ } -+ if( ty == GDL_STRUCT) -+ { -+ // check for struct compatibility -+ DStructDesc* newS= -+ static_cast(e)->Desc(); -+ DStructDesc* oldS= -+ static_cast(cTypeData)->Desc(); -+ -+ // *** here (*newS) != (*oldS) must be set when -+ // unnamed structs not in struct list anymore -+ // WRONG! This speeds up things for named structs -+ // unnamed structs all have their own desc -+ // and thus the next is always true for them -+ if( newS != oldS) -+ { -+ -+ if( (*newS) != (*oldS)) -+ throw GDLException( _t, -+ "Conflicting data structures: "+ -+ ProgNode::interpreter->Name(cTypeData)+", "+ProgNode::interpreter->Name(e),true,false); -+ } -+ } -+ } - - // memorize maximum Rank - SizeT rank=e->Rank(); -@@ -361,14 +397,14 @@ - // instance takes care of nStructDesc since it is unnamed - // DStructGDL* instance = new DStructGDL( nStructDesc, dimension(1)); - DStructGDL* instance = new DStructGDL( nStructDesc); -- auto_ptr instance_guard(instance); -+ Guard instance_guard(instance); - - ProgNodeP rTree = this->getNextSibling(); - // match(antlr::RefAST(_t),STRUC); - ProgNodeP _t = this->getFirstChild(); - for (; _t != NULL;) { - ProgNodeP si = _t; -- // match(antlr::RefAST(_t),IDENTIFIER); -+ // match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); - BaseGDL* e=_t->Eval(); //interpreter->expr(_t); - _t = _t->getNextSibling(); -@@ -394,7 +430,7 @@ - ProgNodeP ii = NULL; - - DStructDesc* nStructDesc; -- auto_ptr nStructDescGuard; -+ Guard nStructDescGuard; - BaseGDL* e; - BaseGDL* ee; - -@@ -420,7 +456,7 @@ - nStructDesc= new DStructDesc( id->getText()); - - // guard it -- nStructDescGuard.reset( nStructDesc); -+ nStructDescGuard.Reset( nStructDesc); - } - else - { // NTags() == 0 -@@ -433,7 +469,7 @@ - // dimension(1)); - DStructGDL* instance= new DStructGDL( nStructDesc); - -- auto_ptr instance_guard(instance); -+ Guard instance_guard(instance); - - while( _t != NULL) - { -@@ -652,8 +688,10 @@ - } - else - { -- BaseGDL* kval=ProgNode::interpreter-> -- lib_function_call(this->getFirstChild()->getNextSibling()); -+ BaseGDL* kval= -+// ProgNode::interpreter-> -+// lib_function_call(this->getFirstChild()->getNextSibling()); -+ static_cast(this->getFirstChild()->getNextSibling())->EvalFCALL_LIB(); - - BaseGDL** kvalRef = ProgNode::interpreter->callStack.back()->GetPtrTo( kval); - if( kvalRef != NULL) -@@ -741,7 +779,8 @@ - pval = p->Eval(); - return false; // pass value - } -- pval=ProgNode::interpreter->lib_function_call(p); -+// pval=ProgNode::interpreter->lib_function_call(p); -+ pval = static_cast(p)->EvalFCALL_LIB(); - BaseGDL** pvalRef = ProgNode::interpreter->callStack.back()->GetPtrTo( pval); - return (pvalRef != NULL); - // if( pvalRef != NULL) -@@ -781,8 +820,8 @@ - } - else - { -- BaseGDL* pval=ProgNode::interpreter->lib_function_call(this->getFirstChild()); -- -+ BaseGDL* //pval=ProgNode::interpreter->lib_function_call(this->getFirstChild()); -+ pval = static_cast(this->getFirstChild())->EvalFCALL_LIB(); - BaseGDL** pvalRef = ProgNode::interpreter->callStack.back()->GetPtrTo( pval); - if( pvalRef != NULL) - { // pass reference -@@ -823,7 +862,8 @@ - } - else - { -- BaseGDL* pval=ProgNode::interpreter->lib_function_call(this->getFirstChild()); -+ BaseGDL* //pval=ProgNode::interpreter->lib_function_call(this->getFirstChild()); -+ pval = static_cast(this->getFirstChild())->EvalFCALL_LIB(); - BaseGDL** pvalRef = ProgNode::interpreter->callStack.back()->GetPtrTo( pval); - if( pvalRef != NULL) - { // pass reference -@@ -859,7 +899,7 @@ - - RetCode WRAPPED_FUNNode::Run() - { -- EnvUDT* env = static_cast( ProgNode::interpreter->callStack.back()); -+ EnvUDT* env = static_cast( ProgNode::interpreter->CallStackBack()); - BaseGDL* res = (*this->fun)( env); - interpreter->SetRetTree( this->getNextSibling()); // ??? - assert( ProgNode::interpreter->returnValue == NULL); -@@ -869,7 +909,7 @@ - } - RetCode WRAPPED_PRONode::Run() - { -- EnvUDT* env = static_cast( ProgNode::interpreter->callStack.back()); -+ EnvUDT* env = static_cast( ProgNode::interpreter->CallStackBack()); - (*this->pro)( env); - interpreter->SetRetTree( this->getNextSibling()); // ??? - return RC_RETURN; -@@ -879,7 +919,7 @@ - { - BaseGDL* r; - BaseGDL** l; -- auto_ptr r_guard; -+ Guard r_guard; - - // match(antlr::RefAST(_t),ASSIGN); - ProgNodeP _t = this->getFirstChild(); -@@ -891,18 +931,20 @@ - } - else if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- r=ProgNode::interpreter->lib_function_call(_t); -- _t = ProgNode::interpreter->_retTree; -+// r=ProgNode::interpreter->lib_function_call(_t); -+// _t = ProgNode::interpreter->_retTree; -+ r = static_cast(_t)->EvalFCALL_LIB(); - if( !ProgNode::interpreter->callStack.back()->Contains( r)) -- r_guard.reset( r); // guard if no global data -+ r_guard.Init( r); // guard if no global data -+ _t = _t->getNextSibling(); - l=_t->LExpr( r); //ProgNode::interpreter->l_expr(_t, r); - } - else - { - r=_t->Eval(); //ProgNode::interpreter->indexable_tmp_expr(_t); -+ r_guard.Init( r); - _t = _t->getNextSibling(); - // _t = ProgNode::interpreter->_retTree; -- r_guard.reset( r); - l=_t->LExpr( r); //ProgNode::interpreter->l_expr(_t, r); - } - // switch ( _t->getType()) { -@@ -922,7 +964,7 @@ - // _t = ProgNode::interpreter->_retTree; - // - // if( !ProgNode::interpreter->callStack.back()->Contains( r)) --// r_guard.reset( r); // guard if no global data -+// r_guard.Reset( r); // guard if no global data - // - // break; - // } -@@ -930,7 +972,7 @@ - // { - // r=ProgNode::interpreter->indexable_tmp_expr(_t); - // _t = ProgNode::interpreter->_retTree; --// r_guard.reset( r); -+// r_guard.Reset( r); - // break; - // } - // }//switch -@@ -946,7 +988,7 @@ - { - BaseGDL* r; - BaseGDL** l; -- auto_ptr r_guard; -+ Guard r_guard; - - //match(antlr::RefAST(_t),ASSIGN_REPLACE); - ProgNodeP _t = this->getFirstChild(); -@@ -954,15 +996,17 @@ - // BOTH - if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- r=ProgNode::interpreter->lib_function_call(_t); -+// r=ProgNode::interpreter->lib_function_call(_t); -+ r = static_cast(_t)->EvalFCALL_LIB(); - - if( r == NULL) // ROUTINE_NAMES - ProgNode::interpreter->callStack.back()->Throw( "Undefined return value"); - -- _t = ProgNode::interpreter->_retTree; -- -+// _t = ProgNode::interpreter->_retTree; -+ _t = _t->getNextSibling(); -+ - if( !ProgNode::interpreter->callStack.back()->Contains( r)) -- r_guard.reset( r); -+ r_guard.Reset( r); - - } - else -@@ -978,7 +1022,7 @@ - r= _t->Eval(); //ProgNode::interpreter->indexable_tmp_expr(_t); - _t = _t->getNextSibling(); - // _t = ProgNode::interpreter->_retTree; -- r_guard.reset( r); -+ r_guard.Reset( r); - } - - // switch ( _t->getType()) { -@@ -996,7 +1040,7 @@ - // { - // r=ProgNode::interpreter->indexable_tmp_expr(_t); - // _t = ProgNode::interpreter->_retTree; --// r_guard.reset( r); -+// r_guard.Reset( r); - // break; - // } - // }//switch -@@ -1041,60 +1085,24 @@ - - RetCode ASSIGN_REPLACENode::Run() - { -- BaseGDL* r; -- auto_ptr r_guard; -- - //match(antlr::RefAST(_t),ASSIGN_REPLACE); - ProgNodeP _t = this->getFirstChild(); -- { --// if( _t->getType() == GDLTokenTypes::FCALL_LIB) --// { --// r=_t->Eval();//different: ProgNode::interpreter->lib_function_call(_t); --// _t = _t->getNextSibling(); //ProgNode::interpreter->_retTree; --// assert(_t != NULL); --// r_guard.reset( r); --// // if( !ProgNode::interpreter->callStack.back()->Contains( r)) --// // r_guard.reset( r); --// // else --// // r_guard.reset( r->Dup()); --// } --// else -- { -- //r=ProgNode::interpreter->tmp_expr(_t); -- r = _t->Eval(); -- r_guard.reset( r); -- _t = _t->getNextSibling(); -- assert(_t != NULL); -- } -- } --// switch ( _t->getType()) { --// case GDLTokenTypes::VAR: --// case GDLTokenTypes::VARPTR: --// case GDLTokenTypes::DEREF: --// { --// l=_t->LEval(); //ProgNode::interpreter->l_simple_var(_t); --// // _t = ProgNode::interpreter->_retTree; --// break; --// } --// default: --// // case GDLTokenTypes::FCALL: --// // case GDLTokenTypes::FCALL_LIB: --// // case GDLTokenTypes::MFCALL: --// // case GDLTokenTypes::MFCALL_PARENT: --// { --// l=ProgNode::interpreter->l_function_call(_t); --// // _t = ProgNode::interpreter->_retTree; --// break; --// } --// } // switch -+ -+ BaseGDL* r = _t->Eval(); -+ Guard r_guard( r); -+ -+ _t = _t->getNextSibling(); -+ assert(_t != NULL); - -- BaseGDL** l=_t->LEval(); -+ BaseGDL** l = _t->LEval(); - - if( r != (*l)) // && (*l) != NullGDL::GetSingleInstance()) -+ { - GDLDelete(*l); -+ *l = r; -+ } -+ r_guard.Release(); - -- *l = r_guard.release(); -- - ProgNode::interpreter->SetRetTree( this->getNextSibling()); - return RC_OK; - } -@@ -1105,7 +1113,7 @@ - { - // // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack - // StackGuard guard( ProgNode::interpreter->CallStack()); -- BaseGDL *self; -+// BaseGDL *self; - - // match(antlr::RefAST(_t),PCALL_LIB); - ProgNodeP _t = this->getFirstChild(); -@@ -1113,10 +1121,10 @@ - // match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); - -- EnvT* newEnv=new EnvT( pl, pl->libPro);//libProList[pl->proIx]); -+ EnvT* newEnv=new EnvT( this, pl->libPro);//libProList[pl->proIx]); - - ProgNode::interpreter->parameter_def_nocheck(_t, newEnv); -- auto_ptr guardEnv( newEnv); -+ Guard guardEnv( newEnv); - - // _t = _retTree; - //if( this->getLine() != 0) ProgNode::interpreter->callStack.back()->SetLineNumber( this->getLine()); -@@ -1125,7 +1133,8 @@ - // ProgNode::interpreter->callStack.push_back(newEnv); - - // make the call -- static_cast(newEnv->GetPro())->Pro()(newEnv); -+// static_cast(newEnv->GetPro())->Pro()(newEnv); -+ pl->libProPro(newEnv); - - ProgNode::interpreter->SetRetTree( this->getNextSibling()); - // ProgNode::interpreter->_retTree = this->getNextSibling(); -@@ -1149,7 +1158,7 @@ - // match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); - -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - newEnv=new EnvUDT( mp, self); - -@@ -1191,7 +1200,7 @@ - // match(antlr::RefAST(_t),IDENTIFIER); - _t = _t->getNextSibling(); - -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - newEnv = new EnvUDT( pp, self, parent->getText()); - -@@ -1292,7 +1301,7 @@ - - RetCode FORNode::Run()//for_statement(ProgNodeP _t) { - { -- EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -+ EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStackBack()); - - ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); - -@@ -1302,7 +1311,7 @@ - - BaseGDL* s=this->GetFirstChild()->Eval(); - // BaseGDL* s=ProgNode::interpreter->expr( this->GetFirstChild()); -- auto_ptr s_guard(s); -+ Guard s_guard(s); - - GDLDelete(loopInfo.endLoopVar); - loopInfo.endLoopVar=this->GetFirstChild()->GetNextSibling()->Eval(); -@@ -1313,7 +1322,7 @@ - if( loopInfo.endLoopVar->Type() != s->Type()) // promote s - { - BaseGDL* sPromote = s->Convert2(loopInfo.endLoopVar->Type(), BaseGDL::COPY); -- s_guard.reset( sPromote); -+ s_guard.Reset( sPromote); - } - - // ASSIGNMENT used here also -@@ -1322,52 +1331,51 @@ - - if( (*v)->ForCondUp( loopInfo.endLoopVar)) - { -- ProgNode::interpreter->_retTree = vP->GetNextSibling(); -- return RC_OK; -+ ProgNode::interpreter->_retTree = vP->GetNextSibling(); -+ return RC_OK; - } - else - { -- // skip if initial test fails -- ProgNode::interpreter->_retTree = this->GetNextSibling()->GetNextSibling(); -- return RC_OK; -+ // skip if initial test fails -+ ProgNode::interpreter->_retTree = this->GetNextSibling()->GetNextSibling(); -+ return RC_OK; - } - } - - - RetCode FOR_LOOPNode::Run() - { -- EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -- ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); -+ EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -+ ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); - // BaseGDL* endLoopVar = loopInfo.endLoopVar; -- if( loopInfo.endLoopVar == NULL) -- { -- // non-initialized loop (GOTO) -- ProgNode::interpreter->_retTree = this->GetNextSibling(); -- return RC_OK; -- } -+ if( loopInfo.endLoopVar == NULL) -+ { -+ // non-initialized loop (GOTO) -+ ProgNode::interpreter->_retTree = this->GetNextSibling(); -+ return RC_OK; -+ } - -- // // problem: -- // // EXECUTE may call DataListT.loc.resize(), as v points to the -- // // old sequence v might be invalidated -> segfault -- // // note that the value (*v) is preserved by resize() -- -- BaseGDL** v=this->getFirstChild()->LEval();//ProgNode::interpreter->l_simple_var(this->getFirstChild()); -+ // // problem: -+ // // EXECUTE may call DataListT.loc.resize(), as v points to the -+ // // old sequence v might be invalidated -> segfault -+ // // note that the value (*v) is preserved by resize() -+ -+ BaseGDL** v=this->getFirstChild()->LEval();//ProgNode::interpreter->l_simple_var(this->getFirstChild()); - - // shortCut:; -- -- //(*v)->ForAdd(); -- if( (*v)->ForAddCondUp( loopInfo.endLoopVar)) -- { -- ProgNode::interpreter->_retTree = this->statementList; //GetFirstChild()->GetNextSibling(); --// if( ProgNode::interpreter->_retTree == this) goto shortCut; -- } -- else -- { -- GDLDelete(loopInfo.endLoopVar); -- loopInfo.endLoopVar = NULL; -- ProgNode::interpreter->_retTree = this->GetNextSibling(); -- } -- return RC_OK; -+ -+ if( (*v)->ForAddCondUp( loopInfo.endLoopVar)) -+ { -+ ProgNode::interpreter->_retTree = this->statementList; //GetFirstChild()->GetNextSibling(); -+// if( ProgNode::interpreter->_retTree == this) goto shortCut; -+ } -+ else -+ { -+ GDLDelete(loopInfo.endLoopVar); -+ loopInfo.endLoopVar = NULL; -+ ProgNode::interpreter->_retTree = this->GetNextSibling(); -+ } -+ return RC_OK; - } - - -@@ -1383,7 +1391,7 @@ - - BaseGDL* s=this->GetFirstChild()->Eval(); - // BaseGDL* s=ProgNode::interpreter->expr( this->GetFirstChild()); -- auto_ptr s_guard(s); -+ Guard s_guard(s); - - GDLDelete(loopInfo.endLoopVar); - loopInfo.endLoopVar=this->GetFirstChild()->GetNextSibling()->Eval(); -@@ -1398,7 +1406,7 @@ - if( loopInfo.endLoopVar->Type() != s->Type()) // promote s - { - BaseGDL* sPromote = s->Convert2(loopInfo.endLoopVar->Type(), BaseGDL::COPY); -- s_guard.reset( sPromote); -+ s_guard.Reset( sPromote); - assert( loopInfo.loopStepVar->Type() == s_guard.get()->Type()); - } - -@@ -1408,21 +1416,19 @@ - - if( loopInfo.loopStepVar->Sgn() == -1) - { -- if( (*v)->ForCondDown( loopInfo.endLoopVar)) -- { -- ProgNode::interpreter->_retTree = vP->GetNextSibling(); -- return RC_OK; -- -- } -+ if( (*v)->ForCondDown( loopInfo.endLoopVar)) -+ { -+ ProgNode::interpreter->_retTree = vP->GetNextSibling(); -+ return RC_OK; -+ } - } - else - { -- if( (*v)->ForCondUp( loopInfo.endLoopVar)) -- { -- ProgNode::interpreter->_retTree = vP->GetNextSibling(); -- return RC_OK; -- -- } -+ if( (*v)->ForCondUp( loopInfo.endLoopVar)) -+ { -+ ProgNode::interpreter->_retTree = vP->GetNextSibling(); -+ return RC_OK; -+ } - } - // skip if initial test fails - ProgNode::interpreter->_retTree = this->GetNextSibling()->GetNextSibling(); -@@ -1476,136 +1482,195 @@ - - RetCode FOREACHNode::Run() - { -- EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -- ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); -+ EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -+ ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); - -- ProgNodeP vP = this->GetNextSibling()->GetFirstChild(); -+ ProgNodeP vP = this->GetNextSibling()->GetFirstChild(); - -- BaseGDL** v=vP->LEval(); // ProgNode::interpreter->l_simple_var(vP); -+ BaseGDL** v=vP->LEval(); // ProgNode::interpreter->l_simple_var(vP); - -- GDLDelete(loopInfo.endLoopVar); -- loopInfo.endLoopVar=this->GetFirstChild()->Eval(); -+ GDLDelete(loopInfo.endLoopVar); -+ loopInfo.endLoopVar=this->GetFirstChild()->Eval(); - // loopInfo.endLoopVar=ProgNode::interpreter->expr(this->GetFirstChild()); -+ SizeT nEl = loopInfo.endLoopVar->N_Elements(); -+ if( nEl == 0) -+ { -+ GDLDelete(loopInfo.endLoopVar); -+ loopInfo.endLoopVar = NULL; -+ ProgNode::interpreter->_retTree = this->GetNextSibling()->GetNextSibling(); -+ return RC_OK; -+ } - -- loopInfo.foreachIx = 0; -+ loopInfo.foreachIx = 0; - -- // currently there are no empty arrays -- //SizeT nEl = loopInfo.endLoopVar->N_Elements(); -+ // currently there are no empty arrays -+ //SizeT nEl = loopInfo.endLoopVar->N_Elements(); - -- // ASSIGNMENT used here also -- GDLDelete((*v)); -- (*v) = loopInfo.endLoopVar->NewIx( 0); -+ // ASSIGNMENT used here also -+ GDLDelete((*v)); -+ (*v) = loopInfo.endLoopVar->NewIx( 0); - -- ProgNode::interpreter->_retTree = vP->GetNextSibling(); -- return RC_OK; -+ ProgNode::interpreter->_retTree = vP->GetNextSibling(); -+ return RC_OK; - } - - RetCode FOREACH_LOOPNode::Run() - { -- EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -- ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); -+ EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -+ ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); - -- if( loopInfo.endLoopVar == NULL) -- { -- // non-initialized loop (GOTO) -- ProgNode::interpreter->_retTree = this->GetNextSibling(); -- return RC_OK; -- } -+ if( loopInfo.endLoopVar == NULL) -+ { -+ // non-initialized loop (GOTO) -+ ProgNode::interpreter->_retTree = this->GetNextSibling(); -+ return RC_OK; -+ } - -- BaseGDL** v=this->GetFirstChild()->LEval(); //ProgNode::interpreter->l_simple_var(this->GetFirstChild()); -- -- ++loopInfo.foreachIx; -+ BaseGDL** v=this->GetFirstChild()->LEval(); //ProgNode::interpreter->l_simple_var(this->GetFirstChild()); - -- SizeT nEl = loopInfo.endLoopVar->N_Elements(); -+ ++loopInfo.foreachIx; - -- if( loopInfo.foreachIx < nEl) -- { -- // ASSIGNMENT used here also -- GDLDelete((*v)); -- (*v) = loopInfo.endLoopVar->NewIx( loopInfo.foreachIx); -+ SizeT nEl = loopInfo.endLoopVar->N_Elements(); - -- ProgNode::interpreter->_retTree = this->GetFirstChild()->GetNextSibling(); -- return RC_OK; -- } -+ if( loopInfo.foreachIx < nEl) -+ { -+ // ASSIGNMENT used here also -+ GDLDelete((*v)); -+ (*v) = loopInfo.endLoopVar->NewIx( loopInfo.foreachIx); - -- GDLDelete(loopInfo.endLoopVar); -- loopInfo.endLoopVar = NULL; -- // loopInfo.foreachIx = -1; -- ProgNode::interpreter->SetRetTree( this->GetNextSibling()); -- return RC_OK; -+ ProgNode::interpreter->_retTree = this->GetFirstChild()->GetNextSibling(); -+ return RC_OK; -+ } -+ -+ GDLDelete(loopInfo.endLoopVar); -+ loopInfo.endLoopVar = NULL; -+ // loopInfo.foreachIx = -1; -+ ProgNode::interpreter->SetRetTree( this->GetNextSibling()); -+ return RC_OK; - } - - - --RetCode FOREACH_INDEXNode::Run() -+RetCode FOREACH_INDEXNode::Run() - { -- EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -- ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); -+ EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -+ ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); - -- ProgNodeP vP = this->GetNextSibling()->GetFirstChild(); -- ProgNodeP indexP = vP->GetNextSibling(); -+ ProgNodeP vP = this->GetNextSibling()->GetFirstChild(); -+ ProgNodeP indexP = vP->GetNextSibling(); - -- BaseGDL** v=vP->LEval(); //ProgNode::interpreter->l_simple_var(vP); -- BaseGDL** index=indexP->LEval(); //ProgNode::interpreter->l_simple_var(indexP); -+ BaseGDL** v=vP->LEval(); //ProgNode::interpreter->l_simple_var(vP); -+ BaseGDL** index=indexP->LEval(); //ProgNode::interpreter->l_simple_var(indexP); - -- GDLDelete(loopInfo.endLoopVar); -- loopInfo.endLoopVar=this->GetFirstChild()->Eval(); --// loopInfo.endLoopVar=ProgNode::interpreter->expr(this->GetFirstChild()); -+ GDLDelete(loopInfo.endLoopVar); -+ loopInfo.endLoopVar=this->GetFirstChild()->Eval(); -+ // loopInfo.endLoopVar=ProgNode::interpreter->expr(this->GetFirstChild()); -+ SizeT nEl = loopInfo.endLoopVar->N_Elements(); -+ if( nEl == 0) -+ { -+ GDLDelete(loopInfo.endLoopVar); -+ loopInfo.endLoopVar = NULL; -+ ProgNode::interpreter->_retTree = this->GetNextSibling()->GetNextSibling(); -+ return RC_OK; -+ } - -- loopInfo.foreachIx = 0; -+ loopInfo.foreachIx = 0; - -- // currently there are no empty arrays -- //SizeT nEl = loopInfo.endLoopVar->N_Elements(); -+ // currently there are no empty arrays -+ //SizeT nEl = loopInfo.endLoopVar->N_Elements(); - -- // ASSIGNMENT used here also -- GDLDelete((*v)); -- (*v) = loopInfo.endLoopVar->NewIx( 0); -- -- // ASSIGNMENT used here also -- GDLDelete((*index)); -- (*index) = new DLongGDL( 0); -+ // ASSIGNMENT used here also -+ GDLDelete((*v)); -+ (*v) = loopInfo.endLoopVar->NewIx( 0); // HASH sets here TABLE_FOREACH to key ptr - -- ProgNode::interpreter->_retTree = indexP->GetNextSibling(); -- return RC_OK; -+ // ASSIGNMENT used here also -+ GDLDelete((*index)); -+ if( loopInfo.endLoopVar->Type() == GDL_OBJ && loopInfo.endLoopVar->StrictScalar()) -+ { -+ DObj s = (*static_cast(loopInfo.endLoopVar))[0]; -+ DStructGDL* oStruct= GDLInterpreter::GetObjHeap( s); -+ DStructDesc* oStructDesc = oStruct->Desc(); -+ if( oStructDesc->IsParent( "HASH")) -+ { -+ unsigned forEachTag = oStructDesc->TagIndex( "TABLE_FOREACH"); -+ DPtr pForEach = (*static_cast( oStruct->GetTag( forEachTag, 0)))[0]; -+ // pForEach is pointer to current key -+ (*index) = GDLInterpreter::GetHeap( pForEach)->Dup(); -+ } -+ else -+ { -+ (*index) = new DLongGDL( 0); -+ } -+ } -+ else -+ { -+ (*index) = new DLongGDL( 0); -+ } -+ -+ ProgNode::interpreter->_retTree = indexP->GetNextSibling(); -+ return RC_OK; - } - --RetCode FOREACH_INDEX_LOOPNode::Run() -+RetCode FOREACH_INDEX_LOOPNode::Run() - { -- EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -- ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); -+ EnvUDT* callStack_back = static_cast(GDLInterpreter::CallStack().back()); -+ ForLoopInfoT& loopInfo = callStack_back->GetForLoopInfo( this->forLoopIx); - -- if( loopInfo.endLoopVar == NULL) -- { -- // non-initialized loop (GOTO) -- ProgNode::interpreter->_retTree = this->GetNextSibling(); -- return RC_OK; -- } -+ if( loopInfo.endLoopVar == NULL) -+ { -+ // non-initialized loop (GOTO) -+ ProgNode::interpreter->_retTree = this->GetNextSibling(); -+ return RC_OK; -+ } - -- BaseGDL** v=this->GetFirstChild()->LEval(); //ProgNode::interpreter->l_simple_var(this->GetFirstChild()); -- BaseGDL** index=this->GetFirstChild()->GetNextSibling()->LEval(); //ProgNode::interpreter->l_simple_var(this->GetFirstChild()->GetNextSibling()); -- -- ++loopInfo.foreachIx; -+ ProgNodeP thisGetFirstChildGetNextSibling = this->GetFirstChild()->GetNextSibling(); -+ -+ BaseGDL** v=this->GetFirstChild()->LEval(); //ProgNode::interpreter->l_simple_var(this->GetFirstChild()); -+ BaseGDL** index=thisGetFirstChildGetNextSibling->LEval(); //ProgNode::interpreter->l_simple_var(this->GetFirstChild()->GetNextSibling()); - -- SizeT nEl = loopInfo.endLoopVar->N_Elements(); -+ ++loopInfo.foreachIx; -+ -+ SizeT nEl = loopInfo.endLoopVar->N_Elements(); -+ -+ if( loopInfo.foreachIx < nEl) -+ { -+ // ASSIGNMENT used here also -+ GDLDelete((*v)); -+ (*v) = loopInfo.endLoopVar->NewIx( loopInfo.foreachIx); // HASH sets here TABLE_FOREACH to key ptr - -- if( loopInfo.foreachIx < nEl) -+ // ASSIGNMENT used here also -+ GDLDelete((*index)); -+ if( loopInfo.endLoopVar->Type() == GDL_OBJ && loopInfo.endLoopVar->StrictScalar()) -+ { -+ DObj s = (*static_cast(loopInfo.endLoopVar))[0]; -+ DStructGDL* oStruct= GDLInterpreter::GetObjHeap( s); -+ DStructDesc* oStructDesc = oStruct->Desc(); -+ if( oStructDesc->IsParent( "HASH")) -+ { -+ unsigned forEachTag = oStructDesc->TagIndex( "TABLE_FOREACH"); -+ DPtr pForEach = (*static_cast( oStruct->GetTag( forEachTag, 0)))[0]; -+ // pForEach is pointer to current key -+ (*index) = GDLInterpreter::GetHeap( pForEach)->Dup(); -+ } -+ else - { -- // ASSIGNMENT used here also -- GDLDelete((*v)); -- (*v) = loopInfo.endLoopVar->NewIx( loopInfo.foreachIx); -- -- // ASSIGNMENT used here also -- GDLDelete((*index)); -- (*index) = new DLongGDL( loopInfo.foreachIx); -- -- ProgNode::interpreter->_retTree = this->GetFirstChild()->GetNextSibling()->GetNextSibling(); -- return RC_OK; -+ // ASSIGNMENT used here also -+ (*index) = new DLongGDL( loopInfo.foreachIx); - } -+ } -+ else -+ { -+ (*index) = new DLongGDL( loopInfo.foreachIx); -+ } -+ -+ ProgNode::interpreter->_retTree = thisGetFirstChildGetNextSibling->GetNextSibling(); -+ return RC_OK; -+ } - -- GDLDelete(loopInfo.endLoopVar); -- loopInfo.endLoopVar = NULL; -- // loopInfo.foreachIx = -1; -- ProgNode::interpreter->SetRetTree( this->GetNextSibling()); -+ GDLDelete(loopInfo.endLoopVar); -+ loopInfo.endLoopVar = NULL; -+ // loopInfo.foreachIx = -1; -+ ProgNode::interpreter->SetRetTree( this->GetNextSibling()); - return RC_OK; - } - -@@ -1625,8 +1690,8 @@ - - RetCode REPEAT_LOOPNode::Run() - { -- auto_ptr eVal( this->GetFirstChild()->Eval()); --// auto_ptr eVal( ProgNode::interpreter->expr(this->GetFirstChild())); -+ Guard eVal( this->GetFirstChild()->Eval()); -+// Guard eVal( ProgNode::interpreter->expr(this->GetFirstChild())); - if( eVal.get()->False()) - { - ProgNode::interpreter->SetRetTree( this->GetFirstChild()->GetNextSibling()); // 1st loop statement -@@ -1643,7 +1708,7 @@ - - RetCode WHILENode::Run() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = this->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -1653,9 +1718,9 @@ - else - { - e1 = evalExpr->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Reset(e1); - } --// auto_ptr eVal( ProgNode::interpreter->expr( this->GetFirstChild())); -+// Guard eVal( ProgNode::interpreter->expr( this->GetFirstChild())); - if( e1->True()) - { - ProgNode::interpreter->SetRetTree( this->GetFirstChild()->GetNextSibling()); -@@ -1673,7 +1738,7 @@ - - RetCode IFNode::Run() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = this->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -1683,9 +1748,9 @@ - else - { - e1 = evalExpr->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Reset(e1); - } --// auto_ptr eVal( ProgNode::interpreter->expr( this->GetFirstChild())); -+// Guard eVal( ProgNode::interpreter->expr( this->GetFirstChild())); - if( e1->True()) - { - ProgNode::interpreter->SetRetTree( this->GetFirstChild()->GetNextSibling()); -@@ -1699,7 +1764,7 @@ - - RetCode IF_ELSENode::Run() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = this->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -1709,9 +1774,9 @@ - else - { - e1 = evalExpr->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Init(e1); - } --// auto_ptr eVal( ProgNode::interpreter->expr( this->GetFirstChild())); -+// Guard eVal( ProgNode::interpreter->expr( this->GetFirstChild())); - if( e1->True()) - { - ProgNode::interpreter->SetRetTree( this->GetFirstChild()->GetNextSibling()->GetFirstChild()); -@@ -1727,7 +1792,7 @@ - - RetCode CASENode::Run() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = this->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -1737,10 +1802,10 @@ - else - { - e1 = evalExpr->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Reset(e1); - } - --// auto_ptr eVal( ProgNode::interpreter->expr( this->GetFirstChild())); -+// Guard eVal( ProgNode::interpreter->expr( this->GetFirstChild())); - if( !e1->Scalar()) - throw GDLException( this->GetFirstChild(), "Expression must be a" - " scalar in this context: "+ProgNode::interpreter->Name(e1),true,false); -@@ -1767,7 +1832,7 @@ - { - ProgNodeP ex = b->GetFirstChild(); // EXPR - -- auto_ptr ee_guard; -+ Guard ee_guard; - BaseGDL* ee; - if( NonCopyNode( ex->getType())) - { -@@ -1776,10 +1841,10 @@ - else - { - ee = ex->Eval(); -- ee_guard.reset(ee); -+ ee_guard.Reset(ee); - } - // BaseGDL* ee=ProgNode::interpreter->expr(ex); -- // auto_ptr ee_guard(ee); -+ // Guard ee_guard(ee); - bool equalexpr=e1->EqualNoDelete(ee); // Equal deletes ee - - if( equalexpr) -@@ -1808,7 +1873,7 @@ - - RetCode SWITCHNode::Run() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = this->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -1818,10 +1883,10 @@ - else - { - e1 = evalExpr->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Reset(e1); - } - --// auto_ptr eVal( ProgNode::interpreter->expr( this->GetFirstChild())); -+// Guard eVal( ProgNode::interpreter->expr( this->GetFirstChild())); - if( !e1->Scalar()) - throw GDLException( this->GetFirstChild(), "Expression must be a" - " scalar in this context: "+ProgNode::interpreter->Name(e1),true,false); -@@ -1849,7 +1914,7 @@ - - if( !hook) - { -- auto_ptr ee_guard; -+ Guard ee_guard; - BaseGDL* ee; - if( NonCopyNode( ex->getType())) - { -@@ -1858,10 +1923,10 @@ - else - { - ee = ex->Eval(); -- ee_guard.reset(ee); -+ ee_guard.Reset(ee); - } - // BaseGDL* ee=ProgNode::interpreter->expr(ex); -- // auto_ptr ee_guard(ee); -+ // Guard ee_guard(ee); - hook=e1->EqualNoDelete(ee); // Equal deletes ee - } - -@@ -1939,7 +2004,7 @@ - { - ProgNodeP _t = this->getFirstChild(); - assert( _t != NULL); -- if ( !static_cast(GDLInterpreter::CallStack().back())->LFun()) -+ if ( !static_cast(GDLInterpreter::CallStack().back())->IsLFun()) - { - BaseGDL* e=_t->Eval(); //ProgNode::interpreter->expr(_t); - interpreter->SetRetTree( _t->getNextSibling()); // ??? -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/prognodeexpr.cpp gdl/src/prognodeexpr.cpp ---- gdl-0.9.3/src/prognodeexpr.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/prognodeexpr.cpp 2013-07-31 09:41:44.232244677 -0600 -@@ -114,7 +114,7 @@ - - // converts inferior type to superior type - // for not (yet) overloaded operators --void ProgNode::AdjustTypes(auto_ptr& a, auto_ptr& b) -+void ProgNode::AdjustTypes(Guard& a, Guard& b) - { - DType aTy=a->Type(); - DType bTy=b->Type(); -@@ -128,11 +128,11 @@ - // } - - // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) || -- (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- a.reset( a.release()->Convert2( GDL_COMPLEXDBL)); -- b.reset( b.release()->Convert2( GDL_COMPLEXDBL)); -+ a.reset( a.release()->Convert2( cxTy)); -+ b.reset( b.release()->Convert2( cxTy)); - return; - } - -@@ -150,7 +150,7 @@ - } - // converts inferior type to superior type - // handles overloaded operators --void ProgNode::AdjustTypesObj(auto_ptr& a, auto_ptr& b) -+void ProgNode::AdjustTypesObj(Guard& a, Guard& b) - { - DType aTy=a->Type(); - DType bTy=b->Type(); -@@ -164,11 +164,11 @@ - // } - - // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) || -- (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- a.reset( a.release()->Convert2( GDL_COMPLEXDBL)); -- b.reset( b.release()->Convert2( GDL_COMPLEXDBL)); -+ a.reset( a.release()->Convert2( cxTy)); -+ b.reset( b.release()->Convert2( cxTy)); - return; - } - -@@ -190,8 +190,8 @@ - } - - // for not (yet) overloaded operators --void BinaryExprNC::AdjustTypesNC(auto_ptr& g1, BaseGDL*& e1, -- auto_ptr& g2, BaseGDL*& e2) -+void BinaryExprNC::AdjustTypesNC(Guard& g1, BaseGDL*& e1, -+ Guard& g2, BaseGDL*& e2) - { - if( op1NC) - { -@@ -221,19 +221,28 @@ - // { - // throw GDLException( "Expressions of this type cannot be converted."); - // } -- -- // Change > to >= JMG -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); - g2.reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); - g1.reset( e1); // delete former e1 -- return; -- } -+ return; -+ } -+ -+ // Change > to >= JMG -+ if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ { -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); // delete former e1 -+// return; -+// } - - // convert e2 to e1 - e2 = e2->Convert2( aTy, BaseGDL::COPY); -@@ -241,15 +250,15 @@ - } - else - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); // delete former e1 -- return; -- } -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); // delete former e1 -+// return; -+// } - - // convert e1 to e2 - e1 = e1->Convert2( bTy, BaseGDL::COPY); -@@ -312,9 +321,11 @@ - if( e2 == NullGDL::GetSingleInstance()) - { - // e1 is not !NULL (but might be NULL) -- BaseGDL* tmp = e1; -- e1 = e2; -- e2 = tmp; -+// BaseGDL* tmp = e1; -+// e1 = e2; -+// e2 = tmp; -+ e2 = e1; -+ e1 = NullGDL::GetSingleInstance(); - return; - } - -@@ -342,17 +353,27 @@ - // } - - // Change > to >= JMG -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); - g2.Reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); - g1.Reset( e1); // delete former e1 - return; -- } -+ } -+ -+ if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ { -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.Reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.Reset( e1); // delete former e1 -+// return; -+// } - - // no conversion because of operator overloads - if( aTy == GDL_OBJ) // only check for aTy is ok because GDL_OBJ has highest order -@@ -364,15 +385,15 @@ - } - else - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.Reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.Reset( e1); // delete former e1 -- return; -- } -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.Reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.Reset( e1); // delete former e1 -+// return; -+// } - - // no conversion because of operator overloads - if( bTy == GDL_OBJ) // only check for bTy is ok because GDL_OBJ has highest order -@@ -499,16 +520,70 @@ - - BaseGDL* DEREFNode::Eval() - { -- BaseGDL** e2=this->LEval(); -- if( *e2 == NULL) -- throw GDLException( this, "Variable is undefined: "+ -- interpreter->Name(e2),true,false); -- return (*e2)->Dup(); -+ // use new env if set (during parameter parsing) -+ EnvBaseT* actEnv = DInterpreter::CallStackBack()->GetNewEnv(); -+ if( actEnv == NULL) actEnv = DInterpreter::CallStackBack(); -+ -+ assert( actEnv != NULL); -+ -+ Guard e1_guard; -+ BaseGDL* e1; -+ ProgNodeP evalExpr = this->getFirstChild(); -+ if( NonCopyNode( evalExpr->getType())) -+ { -+ e1 = evalExpr->EvalNC(); -+ } -+ else if( evalExpr->getType() == GDLTokenTypes::FCALL_LIB) -+ { -+// e1=interpreter->lib_function_call(evalExpr); -+ e1 = static_cast(evalExpr)->EvalFCALL_LIB(); -+ // set return tree not needed -+ if( e1 == NULL) // ROUTINE_NAMES -+ throw GDLException( evalExpr, "Undefined return value", true, false); -+ -+ if( !DInterpreter::CallStackBack()->Contains( e1)) -+ { -+ e1_guard.Init( e1); -+ } -+ } -+ else -+ { -+ e1 = evalExpr->Eval(); -+ e1_guard.Init( e1); -+ } -+ -+ if( e1 == NULL || e1->Type() != GDL_PTR) -+ throw GDLException( evalExpr, "Pointer type required" -+ " in this context: "+interpreter->Name(e1),true,false); -+ -+ DPtrGDL* ptr=static_cast(e1); -+ -+ DPtr sc; -+ if( !ptr->StrictScalar(sc)) -+ throw GDLException( this, "Expression must be a " -+ "scalar in this context: "+interpreter->Name(e1),true,false); -+ if( sc == 0) -+ throw GDLException( this, "Unable to dereference" -+ " NULL pointer: "+interpreter->Name(e1),true,false); -+ -+ BaseGDL** res; -+ try{ -+ res = &interpreter->GetHeap(sc); -+ } -+ catch( DInterpreter::HeapException) -+ { -+ throw GDLException( this, "Invalid pointer: "+interpreter->Name(e1),true,false); -+ } -+ -+ if( *res == NULL) -+ throw GDLException( this, "Variable is undefined: "+ -+ interpreter->Name(res),true,false); -+ return (*res)->Dup(); - } - - BaseGDL* DEREFNode::EvalNC() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = this->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -518,7 +593,7 @@ - else - { - e1 = evalExpr->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Reset(e1); - } - - if( e1 == NULL || e1->Type() != GDL_PTR) -@@ -549,15 +624,13 @@ - - BaseGDL** DEREFNode::LEval() - { --// ProgNodeP retTree = this->getNextSibling(); -- - // use new env if set (during parameter parsing) - EnvBaseT* actEnv = DInterpreter::CallStackBack()->GetNewEnv(); - if( actEnv == NULL) actEnv = DInterpreter::CallStackBack(); - - assert( actEnv != NULL); - -- auto_ptr e1_guard; -+// Guard e1_guard; - BaseGDL* e1; - ProgNodeP evalExpr = this->getFirstChild(); - if( NonCopyNode( evalExpr->getType())) -@@ -566,20 +639,25 @@ - } - else if( evalExpr->getType() == GDLTokenTypes::FCALL_LIB) - { -- e1=interpreter->lib_function_call(evalExpr); -- -+// e1=interpreter->lib_function_call(evalExpr); -+ e1 = static_cast(evalExpr)->EvalFCALL_LIB(); -+ // set return tree not needed - if( e1 == NULL) // ROUTINE_NAMES - throw GDLException( evalExpr, "Undefined return value", true, false); - - if( !DInterpreter::CallStackBack()->Contains( e1)) - { -- actEnv->Guard( e1); -+// e1_guard.Init( e1); -+ actEnv->DeleteAtExit( e1); // we need life cycle until end of current subroutine - } - } - else - { - e1 = evalExpr->Eval(); -- actEnv->Guard( e1); -+// e1_guard.Init( e1); -+ // in case *(ptr_new(value)), value will be destroyed due to ref counting -+ // when e1 is deleted -+ actEnv->DeleteAtExit( e1);// we need life cycle until end of current subroutine - } - - if( e1 == NULL || e1->Type() != GDL_PTR) -@@ -604,8 +682,7 @@ - { - throw GDLException( this, "Invalid pointer: "+interpreter->Name(e1),true,false); - } -- --// interpreter->SetRetTree( retTree); -+ - return res; - } - -@@ -617,7 +694,7 @@ - // trinary operator - BaseGDL* QUESTIONNode::Eval() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - if( NonCopyNode( op1->getType())) - { -@@ -626,9 +703,9 @@ - else - { - e1 = op1->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Reset(e1); - } --// auto_ptr e1( op1->Eval()); -+// Guard e1( op1->Eval()); - if( e1->True()) - { - return op2->Eval(); // right->down -@@ -638,7 +715,7 @@ - - ProgNodeP QUESTIONNode::AsParameter() - { -- auto_ptr e1_guard; -+ Guard e1_guard; - BaseGDL* e1; - if( NonCopyNode( op1->getType())) - { -@@ -647,9 +724,9 @@ - else - { - e1 = op1->Eval(); -- e1_guard.reset(e1); -+ e1_guard.Reset(e1); - } --// auto_ptr e1( op1->Eval()); -+// Guard e1( op1->Eval()); - if( e1->True()) - { - return op2; -@@ -670,15 +747,15 @@ - } - BaseGDL* LOG_NEGNode::Eval() - { -- auto_ptr e1( down->Eval()); -+ Guard e1( down->Eval()); - return e1->LogNeg(); - } - - // binary operators - BaseGDL* AND_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - if( e1->StrictScalar()) - { -@@ -706,8 +783,8 @@ - } - BaseGDL* OR_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - if( e1->StrictScalar()) - { -@@ -735,8 +812,8 @@ - } - BaseGDL* XOR_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - if( e1->N_Elements() <= e2->N_Elements()) - { -@@ -752,25 +829,25 @@ - } - BaseGDL* LOG_ANDNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -+ Guard e1( op1->Eval()); - if( !e1->LogTrue()) return new DByteGDL( 0); -- auto_ptr e2( op2->Eval()); -+ Guard e2( op2->Eval()); - if( !e2->LogTrue()) return new DByteGDL( 0); - return new DByteGDL( 1); - } - BaseGDL* LOG_ORNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -+ Guard e1( op1->Eval()); - if( e1->LogTrue()) return new DByteGDL( 1); -- auto_ptr e2( op2->Eval()); -+ Guard e2( op2->Eval()); - if( e2->LogTrue()) return new DByteGDL( 1); - return new DByteGDL( 0); - } - - BaseGDL* EQ_OPNode::Eval() - { -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypesObj(e1,e2); - if( e2->Type() == GDL_OBJ) - { -@@ -787,8 +864,8 @@ - } - BaseGDL* NE_OPNode::Eval() - { -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypesObj(e1,e2); - if( e2->Type() == GDL_OBJ) - { -@@ -805,32 +882,32 @@ - } - BaseGDL* LE_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - res=e1->LeOp(e2.get()); - return res; - } - BaseGDL* LT_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - res=e1->LtOp(e2.get()); - return res; - } - BaseGDL* GE_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - res=e1->GeOp(e2.get()); - return res; - } - BaseGDL* GT_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - res=e1->GtOp(e2.get()); - return res; -@@ -838,8 +915,8 @@ - BaseGDL* PLUSNode::Eval() - { - BaseGDL* res; -- auto_ptr e1 ( op1->Eval() ); -- auto_ptr e2 ( op2->Eval() ); -+ Guard e1 ( op1->Eval() ); -+ Guard e2 ( op2->Eval() ); - - DType aTy=e1->Type(); - DType bTy=e2->Type(); -@@ -850,11 +927,13 @@ - - } - // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- else if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) || -- (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+ else -+ { -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- e1.reset( e1.release()->Convert2( GDL_COMPLEXDBL)); -- e2.reset( e2.release()->Convert2( GDL_COMPLEXDBL)); -+ e1.reset( e1.release()->Convert2( cxTy)); -+ e2.reset( e2.release()->Convert2( cxTy)); - } - // Change > to >= JMG - else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -@@ -871,7 +950,8 @@ - return e2->AddInv( e1.get());; // for operator overloading, do not convert other type then - e1.reset( e1.release()->Convert2( bTy)); - } -- -+ } -+ - if ( e1->StrictScalar() ) - { - res= e2->AddInvS ( e1.get() ); // scalar+scalar or array+scalar -@@ -900,8 +980,8 @@ - BaseGDL* MINUSNode::Eval() - { - BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - // AdjustTypes(e1,e2); - - DType aTy=e1->Type(); -@@ -913,11 +993,13 @@ - - } - // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- else if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) || -- (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+ else -+ { -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- e1.reset( e1.release()->Convert2( GDL_COMPLEXDBL)); -- e2.reset( e2.release()->Convert2( GDL_COMPLEXDBL)); -+ e1.reset( e1.release()->Convert2( cxTy)); -+ e2.reset( e2.release()->Convert2( cxTy)); - } - // Change > to >= JMG - else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -@@ -934,7 +1016,7 @@ - return e2->SubInv( e1.get());; // for operator overloading, do not convert other type then - e1.reset( e1.release()->Convert2( bTy)); - } -- -+ } - if( e1->StrictScalar()) - { - res= e2->SubInvS(e1.get()); // scalar+scalar or array+scalar -@@ -962,8 +1044,8 @@ - } - BaseGDL* LTMARKNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - if( e1->StrictScalar()) - { -@@ -991,8 +1073,8 @@ - } - BaseGDL* GTMARKNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - if( e1->StrictScalar()) - { -@@ -1021,8 +1103,8 @@ - BaseGDL* ASTERIXNode::Eval() - { - BaseGDL* res; -- auto_ptr e1 ( op1->Eval() ); -- auto_ptr e2 ( op2->Eval() ); -+ Guard e1 ( op1->Eval() ); -+ Guard e2 ( op2->Eval() ); - AdjustTypes ( e1,e2 ); - if ( e1->StrictScalar() ) - { -@@ -1050,18 +1132,20 @@ - - BaseGDL* MATRIX_OP1Node::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - DType aTy=e1->Type(); - DType bTy=e2->Type(); -- DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -- -- DType cTy=maxTy; -- if( maxTy == GDL_BYTE || maxTy == GDL_INT) -- cTy=GDL_LONG; -- else if( maxTy == GDL_UINT) -- cTy=GDL_ULONG; -+ -+// DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -+// DType cTy=maxTy; -+// if( maxTy == GDL_BYTE || maxTy == GDL_INT) -+// cTy=GDL_LONG; -+// else if( maxTy == GDL_UINT) -+// cTy=GDL_ULONG; - -+ DType cTy = PromoteMatrixOperands( aTy, bTy); -+ - if( aTy != cTy) - e1.reset( e1.release()->Convert2( cTy)); - -@@ -1071,18 +1155,20 @@ - } - BaseGDL* MATRIX_OP2Node::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - DType aTy=e1->Type(); - DType bTy=e2->Type(); -- DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; - -- DType cTy=maxTy; -- if( maxTy == GDL_BYTE || maxTy == GDL_INT) -- cTy=GDL_LONG; -- else if( maxTy == GDL_UINT) -- cTy=GDL_ULONG; -+// DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -+// DType cTy=maxTy; -+// if( maxTy == GDL_BYTE || maxTy == GDL_INT) -+// cTy=GDL_LONG; -+// else if( maxTy == GDL_UINT) -+// cTy=GDL_ULONG; - -+ DType cTy = PromoteMatrixOperands( aTy, bTy); -+ - if( aTy != cTy) - e1.reset( e1.release()->Convert2( cTy)); - -@@ -1092,8 +1178,8 @@ - } - BaseGDL* SLASHNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - if( e1->StrictScalar()) - { -@@ -1122,8 +1208,8 @@ - } - BaseGDL* MOD_OPNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - AdjustTypes(e1,e2); - if( e1->StrictScalar()) - { -@@ -1153,8 +1239,8 @@ - - BaseGDL* POWNode::Eval() - { BaseGDL* res; -- auto_ptr e1( op1->Eval()); -- auto_ptr e2( op2->Eval()); -+ Guard e1( op1->Eval()); -+ Guard e2( op2->Eval()); - // special handling for aTy == complex && bTy != complex - DType aTy=e1->Type(); - DType bTy=e2->Type(); -@@ -1285,8 +1371,8 @@ - // *********************** - BaseGDL* AND_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC( g1, e1, g2, e2); - - if( e1->StrictScalar()) -@@ -1339,8 +1425,8 @@ - } - BaseGDL* OR_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC( g1, e1, g2, e2); - - if( e1->StrictScalar()) -@@ -1392,8 +1478,8 @@ - } - BaseGDL* XOR_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC( g1, e1, g2, e2); - - if( e1->StrictScalar()) -@@ -1443,8 +1529,8 @@ - } - BaseGDL* LOG_ANDNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - if( op1NC) - { -@@ -1471,8 +1557,8 @@ - } - BaseGDL* LOG_ORNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - if( op1NC) - { -@@ -1538,8 +1624,8 @@ - } - BaseGDL* LE_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - AdjustTypesNC( g1, e1, g2, e2); - res=e1->LeOp(e2); -@@ -1547,8 +1633,8 @@ - } - BaseGDL* LT_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - AdjustTypesNC( g1, e1, g2, e2); - res=e1->LtOp(e2); -@@ -1556,8 +1642,8 @@ - } - BaseGDL* GE_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - AdjustTypesNC( g1, e1, g2, e2); - res=e1->GeOp(e2); -@@ -1565,8 +1651,8 @@ - } - BaseGDL* GT_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - AdjustTypesNC( g1, e1, g2, e2); - res=e1->GtOp(e2); -@@ -1602,22 +1688,30 @@ - return e2->AddInvNew( e1); // smaller + larger - } - } -- auto_ptr g1; -- auto_ptr g2; -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ Guard g1; -+ Guard g2; -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) -+ { -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); -+ g2.reset( e2); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); -+ g1.reset( e1); -+ } -+ else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) - { - if( aTy == GDL_OBJ) - return e1->Add( e2); - -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if(aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if(aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - { - // convert e2 to e1 - e2 = e2->Convert2( aTy, BaseGDL::COPY); -@@ -1630,14 +1724,14 @@ - return e2->AddInv( e1); - - // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - {// convert e1 to e2 - e1 = e1->Convert2( bTy, BaseGDL::COPY); - g1.reset( e1); -@@ -1728,18 +1822,27 @@ - } - else // aTy != bTy - { -- // Change > to >= JMG -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); - g2.Reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); - g1.Reset( e1); // delete former e1 -- } -- else if( aTy == GDL_OBJ) // only check for aTy is ok because GDL_OBJ has highest order -+ } -+ // Change > to >= JMG -+ else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ { -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.Reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.Reset( e1); // delete former e1 -+// } -+// else -+ if( aTy == GDL_OBJ) // only check for aTy is ok because GDL_OBJ has highest order - return e1->Add(e2); // for operator overloading, do not convert other type then - else - { -@@ -1750,15 +1853,16 @@ - } - else - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.Reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.Reset( e1); // delete former e1 -- } -- else if( bTy == GDL_OBJ) // only check for bTy is ok because GDL_OBJ has highest order -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.Reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.Reset( e1); // delete former e1 -+// } -+// else -+ if( bTy == GDL_OBJ) // only check for bTy is ok because GDL_OBJ has highest order - return e2->AddInv( e1); // for operator overloading, do not convert other type then - else - { -@@ -1865,22 +1969,31 @@ - } - } - -- auto_ptr g1; -- auto_ptr g2; -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ Guard g1; -+ Guard g2; -+ -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) -+ { -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); -+ g2.reset( e2); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); -+ g1.reset( e1); -+ } -+ else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) - { - if( aTy == GDL_OBJ) - return e1->Sub( e2); - -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - { - // convert e2 to e1 - e2 = e2->Convert2( aTy, BaseGDL::COPY); -@@ -1892,15 +2005,15 @@ - if( bTy == GDL_OBJ) - return e2->SubInv( e1); - -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - {// convert e1 to e2 - e1 = e1->Convert2( bTy, BaseGDL::COPY); - g1.reset( e1); -@@ -1976,18 +2089,27 @@ - } - else // aTy != bTy - { -- // Change > to >= JMG -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); - g2.Reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); - g1.Reset( e1); // delete former e1 -- } -- else if( aTy == GDL_OBJ) // only check for aTy is ok because GDL_OBJ has highest order -+ -+ } // Change > to >= JMG -+ else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ { -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (aTy == GDL_COMPLEX && bTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.Reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.Reset( e1); // delete former e1 -+// } -+// else -+ if( aTy == GDL_OBJ) // only check for aTy is ok because GDL_OBJ has highest order - return e1->Sub(e2); // for operator overloading, do not convert other type then - else - { -@@ -1998,15 +2120,16 @@ - } - else - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.Reset( e2); // delete former e2 -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.Reset( e1); // delete former e1 -- } -- else if( bTy == GDL_OBJ) // only check for bTy is ok because GDL_OBJ has highest order -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.Reset( e2); // delete former e2 -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.Reset( e1); // delete former e1 -+// } -+// else -+ if( bTy == GDL_OBJ) // only check for bTy is ok because GDL_OBJ has highest order - return e2->SubInv( e1); // for operator overloading, do not convert other type then - else - { -@@ -2065,8 +2188,8 @@ - } - BaseGDL* LTMARKNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC( g1, e1, g2, e2); - - if( e1->StrictScalar()) -@@ -2117,8 +2240,8 @@ - } - BaseGDL* GTMARKNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC( g1, e1, g2, e2); - - if( e1->StrictScalar()) -@@ -2194,19 +2317,28 @@ - } - } - -- auto_ptr g1; -- auto_ptr g2; -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ Guard g1; -+ Guard g2; -+ -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) -+ { -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); -+ g2.reset( e2); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); -+ g1.reset( e1); -+ } -+ else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - { - // convert e2 to e1 - e2 = e2->Convert2( aTy, BaseGDL::COPY); -@@ -2215,15 +2347,15 @@ - } - else - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - {// convert e1 to e2 - e1 = e1->Convert2( bTy, BaseGDL::COPY); - g1.reset( e1); -@@ -2307,8 +2439,8 @@ - BaseGDL* ASTERIXNCNode::Eval() - { - BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC ( g1, e1, g2, e2 ); - - if ( e1->StrictScalar() ) -@@ -2386,8 +2518,8 @@ - - BaseGDL* MATRIX_OP1NCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - if( op1NC) - { -@@ -2409,17 +2541,17 @@ - } - DType aTy=e1->Type(); - DType bTy=e2->Type(); -- DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -- if( maxTy > 100) -- { -- throw GDLException( "Expressions of this type cannot be converted."); -- } -- -- DType cTy=maxTy; -- if( maxTy == GDL_BYTE || maxTy == GDL_INT) -- cTy=GDL_LONG; -- else if( maxTy == GDL_UINT) -- cTy=GDL_ULONG; -+// DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -+// if( maxTy > 100) -+// { -+// throw GDLException( "Expressions of this type cannot be converted."); -+// } -+// DType cTy=maxTy; -+// if( maxTy == GDL_BYTE || maxTy == GDL_INT) -+// cTy=GDL_LONG; -+// else if( maxTy == GDL_UINT) -+// cTy=GDL_ULONG; -+ DType cTy = PromoteMatrixOperands( aTy, bTy); - - if( aTy != cTy) - { -@@ -2438,8 +2570,8 @@ - BaseGDL* MATRIX_OP2NCNode::Eval() - { - BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - if( op1NC) - { -@@ -2461,17 +2593,18 @@ - } - DType aTy=e1->Type(); - DType bTy=e2->Type(); -- DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -- if( maxTy > 100) -- { -- throw GDLException( "Expressions of this type cannot be converted."); -- } -+// DType maxTy=(DTypeOrder[aTy] >= DTypeOrder[bTy])? aTy: bTy; -+// if( maxTy > 100) -+// { -+// throw GDLException( "Expressions of this type cannot be converted."); -+// } -+// DType cTy=maxTy; -+// if( maxTy == GDL_BYTE || maxTy == GDL_INT) -+// cTy=GDL_LONG; -+// else if( maxTy == GDL_UINT) -+// cTy=GDL_ULONG; - -- DType cTy=maxTy; -- if( maxTy == GDL_BYTE || maxTy == GDL_INT) -- cTy=GDL_LONG; -- else if( maxTy == GDL_UINT) -- cTy=GDL_ULONG; -+ DType cTy = PromoteMatrixOperands( aTy, bTy); - - if( aTy != cTy) - { -@@ -2513,20 +2646,28 @@ - return e2->DivInvNew( e1); // smaller + larger - } - } -+ Guard g1; -+ Guard g2; - -- auto_ptr g1; -- auto_ptr g2; -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) -+ DType cxTy = PromoteComplexOperand( aTy, bTy); -+ if( cxTy != GDL_UNDEF) -+ { -+ e2 = e2->Convert2( cxTy, BaseGDL::COPY); -+ g2.reset( e2); -+ e1 = e1->Convert2( cxTy, BaseGDL::COPY); -+ g1.reset( e1); -+ } -+ else if( DTypeOrder[aTy] >= DTypeOrder[bTy]) - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( aTy == GDL_COMPLEX && bTy == GDL_DOUBLE) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - { - // convert e2 to e1 - e2 = e2->Convert2( aTy, BaseGDL::COPY); -@@ -2535,15 +2676,15 @@ - } - else - { -- // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -- if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -- { -- e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g2.reset( e2); -- e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -- g1.reset( e1); -- } -- else -+// // GDL_COMPLEX op GDL_DOUBLE = GDL_COMPLEXDBL -+// if( (bTy == GDL_COMPLEX && aTy == GDL_DOUBLE)) -+// { -+// e2 = e2->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g2.reset( e2); -+// e1 = e1->Convert2( GDL_COMPLEXDBL, BaseGDL::COPY); -+// g1.reset( e1); -+// } -+// else - {// convert e1 to e2 - e1 = e1->Convert2( bTy, BaseGDL::COPY); - g1.reset( e1); -@@ -2601,8 +2742,8 @@ - } - BaseGDL* SLASHNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC( g1, e1, g2, e2); - - if( e1->StrictScalar()) -@@ -2654,8 +2795,8 @@ - } - BaseGDL* MOD_OPNCNode::Eval() - { BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; AdjustTypesNC( g1, e1, g2, e2); - - if( e1->StrictScalar()) -@@ -2708,8 +2849,8 @@ - BaseGDL* POWNCNode::Eval() - { - BaseGDL* res; -- auto_ptr g1; -- auto_ptr g2; -+ Guard g1; -+ Guard g2; - BaseGDL *e1, *e2; - if( op1NC) - { -@@ -2835,27 +2976,33 @@ - - DType convertBackT; - -+ bool aTyGEbTy = DTypeOrder[aTy] >= DTypeOrder[bTy]; - // convert back -- if( IntType( bTy) && (DTypeOrder[ bTy] > DTypeOrder[ aTy])) -+ if( IntType( bTy) && !aTyGEbTy) - convertBackT = aTy; - else - convertBackT = GDL_UNDEF; - - if( aTy != bTy) - { -- if( aTy > 100 || bTy > 100) -+ if( aTyGEbTy) // crucial: '>' -> '>=' - { -- throw GDLException( "Expressions of this type cannot be converted."); -- } -+ if( DTypeOrder[aTy] > 100) -+ { -+ throw GDLException( "Expressions of this type cannot be converted."); -+ } - -- if( DTypeOrder[aTy] >= DTypeOrder[bTy]) // crucial: '>' -> '>=' -- { - // convert e2 to e1 - e2 = e2->Convert2( aTy, BaseGDL::COPY); - g2.reset( e2); // delete former e2 - } -- else -+ else // bTy > aTy (order) - { -+ if( DTypeOrder[bTy] > 100) -+ { -+ throw GDLException( "Expressions of this type cannot be converted."); -+ } -+ - // convert e1 to e2 - e1 = e1->Convert2( bTy, BaseGDL::COPY); - g1.reset( e1); // delete former e1 -@@ -2863,7 +3010,7 @@ - } - - // AdjustTypes(e2,e1); // order crucial here (for converting back) --if( e1->StrictScalar()) -+ if( e1->StrictScalar()) - { - if( g2.get() == NULL) - res = e2->PowInvSNew( e1); -@@ -2965,9 +3112,9 @@ - BaseGDL* param; - bool isReference = - static_cast(this->getFirstChild())->ParameterDirect( param); -- auto_ptr guard; -+ Guard guard; - if( !isReference) -- guard.reset( param); -+ guard.Reset( param); - - if( param == NULL) - return new DLongGDL( 0); -@@ -2989,33 +3136,14 @@ - BaseGDL* FCALL_LIB_RETNEWNode::Eval() - { - // match(antlr::RefAST(_t),FCALL_LIB_RETNEW); --// _t = _t->getFirstChild(); --// match(antlr::RefAST(_t),IDENTIFIER); -- EnvT* newEnv=new EnvT( this, this->libFun);//libFunList[fl->funIx]); --// auto_ptr< EnvT> guardEnv( newEnv); --// _t =_t->getFirstChild(); --// EnvT* newEnv=new EnvT( fl, fl->libFun);//libFunList[fl->funIx]); -- // special handling for N_ELEMENTS() --// static int n_elementsIx = LibFunIx("N_ELEMENTS"); --// static DLibFun* n_elementsFun = libFunList[n_elementsIx]; --// --// if( this->libFun == n_elementsFun) --// { --// ProgNode::interpreter->parameter_def_n_elements(this->getFirstChild(), newEnv); --// } --// else --// { -- ProgNode::interpreter->parameter_def_nocheck(this->getFirstChild(), newEnv); --// } -- // push id.pro onto call stack --// guardEnv.release(); -- auto_ptr guardEnv( newEnv); --// // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack --// StackGuard guard(ProgNode::interpreter->CallStack()); --// ProgNode::interpreter->CallStack().push_back(newEnv); -- // make the call -+ EnvT* newEnv=new EnvT( this, this->libFun); -+ -+ ProgNode::interpreter->parameter_def_nocheck(this->getFirstChild(), newEnv); -+ -+ Guard guardEnv( newEnv); -+ -+ BaseGDL* res = this->libFunFun(newEnv); - //*** MUST always return a defined expression -- BaseGDL* res = static_cast(newEnv->GetPro())->Fun()(newEnv); - assert( res != NULL); - return res; - } -@@ -3030,9 +3158,9 @@ - BaseGDL* param; - bool isReference = - static_cast(this->getFirstChild())->ParameterDirect( param); -- auto_ptr guard; -+ Guard guard; - if( !isReference) -- guard.reset( param); -+ guard.Init( param); - // check already here to keep functions leaner - if( param == NULL) - { -@@ -3043,8 +3171,8 @@ - false,false); - } - try { -- BaseGDL* res = -- static_cast(this->libFun)->FunDirect()(param, isReference); -+ BaseGDL* res = this->libFunDirectFun(param, isReference); -+// static_cast(this->libFun)->FunDirect()(param, isReference); - assert( res != NULL); //*** MUST always return a defined expression - if( res == param) - guard.release(); -@@ -3062,10 +3190,11 @@ - EnvT* newEnv=new EnvT( this, this->libFun);//libFunList[fl->funIx]); - - ProgNode::interpreter->parameter_def_nocheck(this->getFirstChild(), newEnv); -- auto_ptr guardEnv( newEnv); -+ Guard guardEnv( newEnv); - - // make the call -- rEval = static_cast(newEnv->GetPro())->Fun()(newEnv); -+// rEval = static_cast(newEnv->GetPro())->Fun()(newEnv); -+ rEval = this->libFunFun(newEnv); - BaseGDL** res = ProgNode::interpreter->CallStackBack()->GetPtrTo( rEval); - return res; // NULL ok, rEval set properly - -@@ -3073,21 +3202,14 @@ - - BaseGDL** FCALL_LIBNode::LEval() - { --// // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack --// StackGuard guard(ProgNode::interpreter->CallStack()); -- // match(antlr::RefAST(_t),FCALL_LIB); - EnvT* newEnv=new EnvT( this, this->libFun);//libFunList[fl->funIx]); - --// EnvUDT* callerEnv = ProgNode::interpreter->CallStackBack(); -- - ProgNode::interpreter->parameter_def_nocheck(this->getFirstChild(), newEnv); -- auto_ptr guardEnv( newEnv); -+ Guard guardEnv( newEnv); - --// // push id.pro onto call stack --// ProgNode::interpreter->CallStack().push_back(newEnv); - // make the call - static DSub* scopeVarfetchPro = libFunList[ LibFunIx("SCOPE_VARFETCH")]; -- if( scopeVarfetchPro == newEnv->GetPro()) -+ if( scopeVarfetchPro == this->libFun)//newEnv->GetPro()) - { - BaseGDL** sV = lib::scope_varfetch_reference( newEnv); - if( sV != NULL) -@@ -3096,7 +3218,7 @@ - throw GDLException( this, "SCOPE_VARFETCH returned no l-value: "+this->getText()); - } - static DSub* routine_namesPro = libFunList[ LibFunIx("ROUTINE_NAMES")]; -- if( routine_namesPro == newEnv->GetPro()) -+ if( routine_namesPro == this->libFun)// newEnv->GetPro()) - { - BaseGDL** sV = lib::routine_names_reference( newEnv); - if( sV != NULL) -@@ -3104,8 +3226,12 @@ - // should never happen - throw GDLException( this, "ROUTINE_NAMES returned no l-value: "+this->getText()); - } -- BaseGDL* libRes = static_cast(newEnv->GetPro())->Fun()(newEnv); -+// BaseGDL* libRes = static_cast(newEnv->GetPro())->Fun()(newEnv); -+ BaseGDL* libRes = this->libFunFun(newEnv); -+ // this is correct: l-value in current environment - BaseGDL** res = ProgNode::interpreter->CallStackBack()->GetPtrTo( libRes); -+ // wrong: would return ptr to local -+ // BaseGDL** res = newEnv->GetPtrTo( libRes); - if( res == NULL) - { - GDLDelete( libRes); -@@ -3119,20 +3245,25 @@ - // returns new or existing variable - BaseGDL* FCALL_LIBNode::EvalFCALL_LIB() - { --// // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack --// StackGuard guard(ProgNode::interpreter->CallStack()); - EnvT* newEnv=new EnvT( this, this->libFun);//libFunList[fl->funIx]); - - ProgNode::interpreter->parameter_def_nocheck(this->getFirstChild(), newEnv); -- auto_ptr guardEnv( newEnv); - -- assert( dynamic_cast(ProgNode::interpreter->CallStackBack()) != NULL); -- EnvUDT* callStackBack = static_cast(ProgNode::interpreter->CallStackBack()); -+ Guard guardEnv( newEnv); -+ -+// assert( dynamic_cast(ProgNode::interpreter->CallStackBack()) != NULL); -+// EnvUDT* callStackBack = static_cast(ProgNode::interpreter->CallStackBack()); - --// // push id.pro onto call stack --// ProgNode::interpreter->CallStack().push_back(newEnv); -- // make the call -- BaseGDL* res=static_cast(newEnv->GetPro())->Fun()(newEnv); -+// BaseGDL* res=static_cast(newEnv->GetPro())->Fun()(newEnv); -+ BaseGDL* res=this->libFunFun(newEnv); -+ -+// if( newEnv->Contains( res)) -+// { -+// // now what to do? returned input parameter -+// // but caller will never know -+// // we need another solution -+// } -+ - // *** MUST always return a defined expression - assert( res != NULL); - return res; -@@ -3141,28 +3272,25 @@ - // returns always a new variable - see EvalFCALL_LIB - BaseGDL* FCALL_LIBNode::Eval() - { --// // better than auto_ptr: auto_ptr wouldn't remove newEnv from the stack --// StackGuard guard(ProgNode::interpreter->CallStack()); - // match(antlr::RefAST(_t),FCALL_LIB); - EnvT* newEnv=new EnvT( this, this->libFun);//libFunList[fl->funIx]); - - ProgNode::interpreter->parameter_def_nocheck(this->getFirstChild(), newEnv); - -- auto_ptr guardEnv( newEnv); -- -- assert( dynamic_cast(ProgNode::interpreter->CallStackBack()) != NULL); -- EnvUDT* callStackBack = static_cast(ProgNode::interpreter->CallStackBack()); -+ Guard guardEnv( newEnv); - - // // push id.pro onto call stack - // ProgNode::interpreter->CallStack().push_back(newEnv); - // make the call -- BaseGDL* res=static_cast(newEnv->GetPro())->Fun()(newEnv); -+ BaseGDL* res=this->libFun->Fun()(newEnv); - // *** MUST always return a defined expression - assert( res != NULL); - // throw GDLException( _t, ""); - -+ assert( dynamic_cast(ProgNode::interpreter->CallStackBack()) != NULL); -+ EnvUDT* callStackBack = static_cast(ProgNode::interpreter->CallStackBack()); - if( callStackBack->Contains( res)) -- return res = res->Dup(); -+ return res->Dup(); - - // static DSub* scopeVarfetchPro = libFunList[ LibFunIx("SCOPE_VARFETCH")]; - // if( scopeVarfetchPro == newEnv->GetPro()) -@@ -3179,7 +3307,7 @@ - ProgNodeP _t = this->getFirstChild(); - - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - _t = _t->getNextSibling(); - //match(antlr::RefAST(_t),IDENTIFIER); -@@ -3211,7 +3339,7 @@ - // match(antlr::RefAST(_t),MFCALL); - ProgNodeP _t = this->getFirstChild(); - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - ProgNodeP mp = _t->getNextSibling(); - // match(antlr::RefAST(_t),IDENTIFIER); -@@ -3242,7 +3370,7 @@ - ProgNodeP _t = this->getFirstChild(); - - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - _t = _t->getNextSibling(); - //match(antlr::RefAST(_t),IDENTIFIER); -@@ -3271,7 +3399,7 @@ - // match(antlr::RefAST(_t),MFCALL_PARENT); - ProgNodeP _t = this->getFirstChild(); - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - _t = _t->getNextSibling(); - ProgNodeP parent = _t; -@@ -3303,7 +3431,7 @@ - // match(antlr::RefAST(_t),MFCALL_PARENT); - ProgNodeP _t = this->getFirstChild(); - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - _t = _t->getNextSibling(); - ProgNodeP parent = _t; -@@ -3337,7 +3465,7 @@ - // match(antlr::RefAST(_t),MFCALL_PARENT); - ProgNodeP _t = this->getFirstChild(); - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - _t = _t->getNextSibling(); - ProgNodeP parent = _t; -@@ -3392,27 +3520,35 @@ - } - - assert( fcallNodeFunIx == -1); -+ // 1st try arrayexpr - try{ -- BaseGDL** res = fcallNode->FCALLNode::EvalRefCheck( rEval); -- fcallNodeFunIx = fcallNode->funIx; -- } catch( GDLException& ex) -+ rEval = arrayExprNode->ARRAYEXPRNode::Eval(); -+ assert( rEval != NULL); -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -+ return NULL; -+ } -+ catch( GDLException& ex) - { -- // keep FCALL if already compiled (but runtime error) -- if(fcallNode->funIx >= 0) -- { -- fcallNodeFunIx = fcallNode->funIx; -- throw ex; -- } -+ if( !ex.GetArrayexprIndexeeFailed()) -+ { -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -+ throw ex; -+ } -+ // then try fcall - try{ -- rEval = arrayExprNode->ARRAYEXPRNode::Eval(); -- assert( rEval != NULL); -- fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -- return NULL; -+ BaseGDL** res = fcallNode->FCALLNode::EvalRefCheck( rEval); -+ fcallNodeFunIx = fcallNode->funIx; - } - catch( GDLException& innerEx) - { -- string msg = "Ambiguous: " + ex.toString() + -- " or: " + innerEx.toString(); -+ // keep FCALL if already compiled (but runtime error) -+ if(fcallNode->funIx >= 0) -+ { -+ fcallNodeFunIx = fcallNode->funIx; -+ throw innerEx; -+ } -+ string msg = "Ambiguous: " + ex.ANTLRException::toString() + -+ " or: " + innerEx.ANTLRException::toString(); - throw GDLException(this,msg,true,false); - } - } -@@ -3452,29 +3588,37 @@ - } - - assert( fcallNodeFunIx == -1); -+ // 1st try arrayexpr - try{ -- BaseGDL** res = fcallNode->FCALLNode::LEval(); -- fcallNodeFunIx = fcallNode->funIx; -+ BaseGDL** res = arrayExprNode->ARRAYEXPRNode::LEval(); -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded - return res; -- } catch( GDLException& ex) -+ } -+ catch( GDLException& ex) - { -- // keep FCALL if already compiled (but runtime error) -- if(fcallNode->funIx >= 0) -- { -+ if( !ex.GetArrayexprIndexeeFailed()) -+ { -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -+ throw ex; -+ } -+ // then try fcall -+ try { -+ BaseGDL** res = fcallNode->FCALLNode::LEval(); - fcallNodeFunIx = fcallNode->funIx; -- throw ex; -- } -- try{ -- BaseGDL** res = arrayExprNode->ARRAYEXPRNode::LEval(); -- fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded - return res; - } - catch( GDLException& innerEx) -- { -- string msg = "Ambiguous: " + ex.toString() + -- " or: " + innerEx.toString(); -- throw GDLException(this,msg,true,false); -- } -+ { -+ // keep FCALL if already compiled (but runtime error) -+ if(fcallNode->funIx >= 0) -+ { -+ fcallNodeFunIx = fcallNode->funIx; -+ throw innerEx; -+ } -+ string msg = "Ambiguous: " + ex.ANTLRException::toString() + -+ " or: " + innerEx.ANTLRException::toString(); -+ throw GDLException(this,msg,true,false); -+ } - } - } - -@@ -3509,27 +3653,39 @@ - } - - assert( fcallNodeFunIx == -1); -+ -+ // 1st try arrayexpr - try{ -- BaseGDL* res = fcallNode->FCALLNode::Eval(); -- fcallNodeFunIx = fcallNode->funIx; -+ BaseGDL* res = arrayExprNode->ARRAYEXPRNode::Eval(); -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded - return res; -- } catch( GDLException& ex) -+ } -+ catch( GDLException& ex) - { -- // keep FCALL if already compiled (but runtime error) -- if(fcallNode->funIx >= 0) -- { -- fcallNodeFunIx = fcallNode->funIx; -- throw ex; -- } -+ // then try fcall -+ // Problem here: we don't know, why arrayexpr failed -+ // if it is just because of the index, we should not -+ // try the function here -+ if( !ex.GetArrayexprIndexeeFailed()) -+ { -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -+ throw ex; -+ } - try{ -- BaseGDL* res = arrayExprNode->ARRAYEXPRNode::Eval(); -- fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -+ BaseGDL* res = fcallNode->FCALLNode::Eval(); -+ fcallNodeFunIx = fcallNode->funIx; - return res; -- } -+ } - catch( GDLException& innerEx) - { -- string msg = "Ambiguous: " + ex.toString() + -- " or: " + innerEx.toString(); -+ // keep FCALL if already compiled (but runtime error) -+ if(fcallNode->funIx >= 0) -+ { -+ fcallNodeFunIx = fcallNode->funIx; -+ throw innerEx; -+ } -+ string msg = "Ambiguous: " + ex.ANTLRException::toString() + -+ " or: " + innerEx.ANTLRException::toString(); - throw GDLException(this,msg,true,false); - } - } -@@ -3545,7 +3701,7 @@ - ProgNodeP _t = mark->getNextSibling(); // skip DOT - - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - ProgNodeP mp2 = _t->getNextSibling(); - //match(antlr::RefAST(_t),IDENTIFIER); -@@ -3570,8 +3726,7 @@ - ProgNode::interpreter->CallStack().push_back(newEnv); - - // make the call -- rEval= -- ProgNode::interpreter-> -+ rEval= ProgNode::interpreter-> - call_fun(static_cast(newEnv->GetPro())->GetTree()); - res = ProgNode::interpreter->CallStackBack()->GetPtrTo( rEval); - return res; // NULL ok, rEval set properly -@@ -3584,7 +3739,7 @@ - _t = mark->getFirstChild(); - - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - - ProgNode::interpreter->r_dot_array_expr(_t, aD.get()); - _t = _t->getNextSibling(); -@@ -3611,7 +3766,7 @@ - ProgNodeP mp2 = _t->getNextSibling(); // interpreter->GetRetTree(); - //match(antlr::RefAST(_t),IDENTIFIER); - -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - newEnv=new EnvUDT( self, mp2, "", true); - -@@ -3639,7 +3794,7 @@ - ProgNodeP _t = mark->getNextSibling(); // skip DOT - - BaseGDL* self=_t->Eval(); //ProgNode::interpreter->expr(_t); -- auto_ptr self_guard(self); -+ Guard self_guard(self); - - ProgNodeP mp2 = _t->getNextSibling(); - //match(antlr::RefAST(_t),IDENTIFIER); -@@ -3679,7 +3834,7 @@ - _t = mark->getFirstChild(); - - SizeT nDot=dot->nDot; -- auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - - ProgNode::interpreter->r_dot_array_expr(_t, aD.get()); - _t = _t->getNextSibling(); -@@ -3730,112 +3885,187 @@ - - BaseGDL* DOTNode::Eval() - { -- BaseGDL* res; -- -- ProgNodeP _t = this->getFirstChild(); -- -- // SizeT nDot=this->nDot; -- -+ BaseGDL* r; -+ // clears aL when destroyed -+ ArrayIndexListGuard guard; -+ - DotAccessDescT aD( nDot+1); - -- //interpreter->r_dot_array_expr(_t, &aD); -- // r_dot_array_expr ///////////////////// -- BaseGDL* r; -- -+ ProgNodeP _t = this->getFirstChild(); - if( _t->getType() == GDLTokenTypes::ARRAYEXPR) - { -- ProgNodeP tIn = _t; -- - _t = _t->getFirstChild(); - -- r = interpreter->r_dot_indexable_expr(_t, &aD); -- -- _t = interpreter->GetRetTree(); -+ // r = interpreter->r_dot_indexable_expr(_t, &aD); -+ // _t = interpreter->GetRetTree(); -+ if( _t->getType() == GDLTokenTypes::EXPR) -+ { -+ r = _t->getFirstChild()->Eval(); -+ aD.SetOwner( true); -+ _t = _t->getNextSibling(); -+ } -+ else if( _t->getType() == GDLTokenTypes::SYSVAR) -+ { -+ r = _t->EvalNC(); -+ _t = _t->getNextSibling(); -+ } -+ else -+ { -+ assert( _t->getType() == GDLTokenTypes::VAR -+ || _t->getType() == GDLTokenTypes::VARPTR); -+ BaseGDL** e = _t->LEval(); -+ if( *e == NULL) -+ { -+ if( _t->getType() == GDLTokenTypes::VAR) -+ throw GDLException( _t, "Variable is undefined: "+ -+ interpreter->CallStackBack()->GetString(_t->GetVarIx()),true,false); -+ else -+ throw GDLException( _t, "Common block variable is undefined: "+ -+ interpreter->CallStackBack()->GetString( /* reference! */ *e),true,false); -+ } -+ r = *e; -+ _t = _t->getNextSibling(); -+ } - -- ArrayIndexListT* aL=interpreter->arrayindex_list(_t); -+ -+ bool handled = false; -+ if( !r->IsAssoc() && r->Type() == GDL_OBJ && r->StrictScalar()) -+ { -+ // check for _overloadBracketsRightSide -+ DObj s = (*static_cast(r))[0]; // is StrictScalar() -+// if( s != 0) // no overloads for null object -+// { -+// DStructGDL* oStructGDL= GDLInterpreter::GetObjHeapNoThrow( s); -+// if( oStructGDL != NULL) // if object not valid -> default behaviour -+// { -+// DStructDesc* desc = oStructGDL->Desc(); -+// -+// DFun* bracketsRightSideOverload = static_cast(desc->GetOperator( OOBracketsRightSide)); -+ DSubUD* bracketsRightSideOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOBracketsRightSide)); -+ if( bracketsRightSideOverload != NULL) -+ { -+ // _overloadBracketsRightSide -+ bool internalDSubUD = bracketsRightSideOverload->GetTree()->IsWrappedNode(); - -- ArrayIndexListGuard guard; -- guard.reset(aL); -+ DObjGDL* self = static_cast(r); -+ Guard selfGuard; -+ if( aD.IsOwner()) -+ { -+ aD.SetOwner( false); -+ // WE are now the proud owner of 'self' -+ selfGuard.Init( self); -+ // so it might be overwritten -+ } -+ else -+ { -+ if( !internalDSubUD) // internal beahve well -+ { -+ self = self->Dup(); // res should be not changeable via SELF -+ selfGuard.Init( self); -+ } -+ } -+ -+ -+ IxExprListT indexList; -+ // uses arrIxListNoAssoc -+ interpreter->arrayindex_list_overload( _t, indexList); -+ ArrayIndexListGuard guard(_t->arrIxListNoAssoc); -+ -+ // hidden SELF is counted as well -+ int nParSub = bracketsRightSideOverload->NPar(); -+ assert( nParSub >= 1); // SELF -+ // indexList.size() > regular paramters w/o SELF -+ if( indexList.size() > nParSub - 1) -+ { -+ indexList.Cleanup(); -+ throw GDLException( this, bracketsRightSideOverload->ObjectName() + -+ ": Incorrect number of arguments.", -+ false, false); -+ } - -- _t = tIn->getNextSibling(); -+ // adds already SELF parameter -+ EnvUDT* newEnv= new EnvUDT( this, bracketsRightSideOverload, &self); -+ // no guarding of newEnv here (no exceptions until push_back()) -+ -+ // parameters -+ for( SizeT p=0; pSetNextParUnchecked( indexList[p]); // takes ownership - -- // check here for object and get struct -- //structR=dynamic_cast(r); -- // this is much faster than a dynamic_cast -- if( r->Type() != GDL_STRUCT) --// else --// structR = NULL; --// if( structR == NULL) -- { -- bool isObj = interpreter->CallStackBack()->IsObject(); -- if( isObj) -- { -- DStructGDL* oStruct = interpreter->ObjectStructCheckAccess( r, tIn); -+ StackGuard stackGuard(interpreter->CallStack()); -+ interpreter->CallStack().push_back( newEnv); -+ -+ // make the call, return the result -+ BaseGDL* res = interpreter->call_fun(static_cast(newEnv->GetPro())->GetTree()); - -- if( aD.IsOwner()) delete r; -- aD.SetOwner( false); // object struct, not owned -+ if( selfGuard.Get() != NULL && self != selfGuard.Get()) -+ { -+ // always put out warning first, in case of a later crash -+ Warning( "WARNING: " + bracketsRightSideOverload->ObjectName() + -+ ": Assignment to SELF detected (GDL session still ok)."); -+ // assignment to SELF -> self was deleted and points to new variable -+ // which it owns -+ selfGuard.Release(); -+ if( static_cast(self) != NullGDL::GetSingleInstance()) -+ selfGuard.Reset(self); -+ } - -- aD.ADRoot( oStruct, guard.release()); -- } -- else -- { -- throw GDLException( tIn, "Expression must be a" -- " STRUCT in this context: "+interpreter->Name(r),true,false); -- } -+ aD.SetOwner( true); // aD owns res here -+ interpreter->SetRootR( this, &aD, res, NULL); -+ handled = true; -+ } - } -- else -+ if( !handled) - { -- if( r->IsAssoc()) -- throw GDLException( tIn, "File expression not allowed " -- "in this context: "+interpreter->Name(r),true,false); -+ // regular (non-object) case -+ ArrayIndexListT* aL = interpreter->arrayindex_list(_t); -+ -+ guard.reset(aL); - -- DStructGDL* structR = static_cast(r); -- aD.ADRoot( structR, guard.release()); -+ // check here for object and get struct -+ //structR=dynamic_cast(r); -+ // this is much faster than a dynamic_cast -+ interpreter->SetRootR( this, &aD, r, aL); - } -+ _t = this->getFirstChild()->getNextSibling(); - } -- else -+ else // ! ARRAYEXPR - // case EXPR: - // case SYSVAR: - // case VAR: - // case VARPTR: - { -- r=interpreter->r_dot_indexable_expr(_t, &aD); -- _t = interpreter->GetRetTree(); -+// r=interpreter->r_dot_indexable_expr(_t, &aD); -+// _t = interpreter->GetRetTree(); -+ if( _t->getType() == GDLTokenTypes::EXPR) -+ { -+ r = _t->getFirstChild()->Eval(); -+ aD.SetOwner( true); -+ _t = _t->getNextSibling(); -+ } -+ else if( _t->getType() == GDLTokenTypes::SYSVAR) -+ { -+ r = _t->EvalNC(); -+ _t = _t->getNextSibling(); -+ } -+ else -+ { -+ assert( _t->getType() == GDLTokenTypes::VAR || _t->getType() == GDLTokenTypes::VARPTR); -+ BaseGDL** e = _t->LEval(); -+ if( *e == NULL) -+ { -+ if( _t->getType() == GDLTokenTypes::VAR) -+ throw GDLException( _t, "Variable is undefined: "+ -+ interpreter->CallStackBack()->GetString(_t->GetVarIx()),true,false); -+ else -+ throw GDLException( _t, "Common block variable is undefined: "+ -+ interpreter->CallStackBack()->GetString( /* reference */ *e),true,false); -+ } -+ r = *e; -+ _t = _t->getNextSibling(); -+ } - -- // check here for object and get struct -- // this is much faster than a dynamic_cast -- if( r->Type() != GDL_STRUCT) --// else --// structR = NULL; --// if( structR == NULL) -- { -- bool isObj = interpreter->CallStackBack()->IsObject(); -- if( isObj) // memeber access to object? -- { -- DStructGDL* oStruct = interpreter->ObjectStructCheckAccess( r, _t); -- // oStruct cannot be "Assoc_" -- if( aD.IsOwner()) delete r; -- aD.SetOwner( false); // object structs are never owned -- aD.ADRoot( oStruct); -- } -- else -- { -- throw GDLException( _t, "Expression must be a" -- " STRUCT in this context: "+interpreter->Name(r),true,false); -- } -- } -- else -- { -- if( r->IsAssoc()) -- { -- throw GDLException( _t, "File expression not allowed " -- "in this context: "+interpreter->Name(r),true,false); -- } -- DStructGDL* structR = static_cast(r); -- aD.ADRoot(structR); -- } -+ interpreter->SetRootR( this, &aD, r, NULL); - } --///////// - - for (; _t != NULL;) { - interpreter->tag_array_expr(_t, &aD); // nDot times -@@ -3858,25 +4088,33 @@ - - BaseGDL* r; - Guard rGuard; -- if( NonCopyNode(_t->getType())) -- { -+ try{ -+ if( NonCopyNode(_t->getType())) -+ { - r=_t->EvalNC(); - //r=indexable_expr(_t); -- } -- else if( _t->getType() == GDLTokenTypes::FCALL_LIB) -- { -+ } -+ else if( _t->getType() == GDLTokenTypes::FCALL_LIB) -+ { - // better than Eval(): no copying here if not necessary -- r=ProgNode::interpreter->lib_function_call(_t); -+ // r=ProgNode::interpreter->lib_function_call(_t); -+ r = static_cast(_t)->EvalFCALL_LIB(); - - if( !ProgNode::interpreter->CallStack().back()->Contains( r)) -- rGuard.Reset( r); // guard if no global data -+ rGuard.Init( r); // guard if no global data -+ } -+ else -+ { -+ r=_t->Eval(); -+ rGuard.Init( r); -+ } - } -- else -+ catch( GDLException& ex) - { -- r=ProgNode::interpreter->indexable_tmp_expr(_t); -- rGuard.Reset( r); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; - } -- -+ - ProgNodeP ixListNode = _t->getNextSibling(); - - if( r->Type() == GDL_OBJ && r->StrictScalar()) -@@ -3892,17 +4130,17 @@ - // DStructDesc* desc = oStructGDL->Desc(); - // - // DFun* bracketsRightSideOverload = static_cast(desc->GetOperator( OOBracketsRightSide)); -- DFun* bracketsRightSideOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOBracketsRightSide)); -+ DSubUD* bracketsRightSideOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOBracketsRightSide)); - if( bracketsRightSideOverload != NULL) - { - // _overloadBracketsRightSide -- BaseGDL* self = rGuard.Get(); -+ DObjGDL* self = static_cast(rGuard.Get()); - if( self == NULL) - { -- self = r->Dup(); // not set -> not owner -+ self = static_cast(r->Dup()); // not set -> not owner - rGuard.Reset( self); - } -- // we are now the proud owner of 'self' -+ // we are now the proud owner of 'self' - - IxExprListT indexList; - // uses arrIxListNoAssoc -@@ -3943,7 +4181,7 @@ - // assignment to SELF -> self was deleted and points to new variable - // which it owns - rGuard.Release(); -- if( self != NullGDL::GetSingleInstance()) -+ if( static_cast(self) != NullGDL::GetSingleInstance()) - rGuard.Reset(self); - } - -@@ -3974,7 +4212,8 @@ - } - else if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- s=ProgNode::interpreter->lib_function_call(_t); -+// s=ProgNode::interpreter->lib_function_call(_t); -+ s = static_cast(_t)->EvalFCALL_LIB(); - if( !ProgNode::interpreter->CallStack().back()->Contains( s)) - exprList.push_back( s); - assert(s != NULL); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/prognodeexpr.hpp gdl/src/prognodeexpr.hpp ---- gdl-0.9.3/src/prognodeexpr.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/prognodeexpr.hpp 2013-07-08 12:39:22.728383252 -0600 -@@ -19,6 +19,7 @@ - #define prognodeexpr_hpp__ - - #include "prognode.hpp" -+#include "dpro.hpp" - - - class UnaryExpr: public DefaultNode -@@ -58,8 +59,8 @@ - public: - BinaryExprNC( const RefDNode& refNode); - -- void AdjustTypesNC( std::auto_ptr& g1, BaseGDL*& e1, -- std::auto_ptr& g2, BaseGDL*& e2); -+ void AdjustTypesNC( Guard& g1, BaseGDL*& e1, -+ Guard& g2, BaseGDL*& e2); - // for overloaded operators - void SetupGuards( Guard& g1, BaseGDL*& e1, - Guard& g2, BaseGDL*& e2); -@@ -110,9 +111,13 @@ - - class FCALL_LIB_DIRECTNode: public LeafNode - { -+ LibFunDirect libFunDirectFun; - public: - FCALL_LIB_DIRECTNode( const RefDNode& refNode): LeafNode( refNode) -- {} -+ { -+ assert( this->libFun != NULL); -+ libFunDirectFun = static_cast(this->libFun)->FunDirect(); -+ } - BaseGDL** LEval(); - BaseGDL* Eval(); - }; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/prognode.hpp gdl/src/prognode.hpp ---- gdl-0.9.3/src/prognode.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/prognode.hpp 2013-07-31 09:41:44.215244736 -0600 -@@ -30,6 +30,11 @@ - RC_ABORT, // checked as retCode >= RC_RETURN - }; - -+class EnvT; -+typedef void (*LibPro)(EnvT*); -+typedef BaseGDL* (*LibFun)(EnvT*); -+typedef BaseGDL* (*LibFunDirect)(BaseGDL* param,bool canGrab); -+ - class ProgNode; - typedef ProgNode* ProgNodeP; - -@@ -86,17 +91,19 @@ - ProgNodeP down; - ProgNodeP right; - -- static void AdjustTypes(std::auto_ptr& a, -- std::auto_ptr& b); -+ static void AdjustTypes(Guard& a, -+ Guard& b); - // for overloaded operators -- static void AdjustTypesObj(std::auto_ptr& a, -- std::auto_ptr& b); -+ static void AdjustTypesObj(Guard& a, -+ Guard& b); - - BaseGDL* cData; // constant data - DVar* var; // ptr to variable - -- DLibFun* libFun; -- DLibPro* libPro; -+ DLibFun* libFun; -+ DLibPro* libPro; -+ LibFun libFunFun; -+ LibPro libProPro; - - union { - int initInt; // for c-i not actually used -@@ -114,9 +121,12 @@ - }; - - void SetType( int tt, const std::string& txt) { ttype = tt; text = txt;} -- -+ - static ProgNodeP GetNULLProgNodeP(); - -+public: -+ int GetVarIx() const { return varIx;} -+ - private: - // from DNode (see there) - int lineNumber; -@@ -318,6 +328,7 @@ - friend class ARRAYEXPR_FCALLNode; - friend class EXPRNode; - friend class SYSVARNode; -+ friend class DOTNode; - }; - - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/prognode_lexpr.cpp gdl/src/prognode_lexpr.cpp ---- gdl-0.9.3/src/prognode_lexpr.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/prognode_lexpr.cpp 2013-07-31 09:41:44.223244708 -0600 -@@ -55,7 +55,7 @@ - ProgNodeP _t = this->getFirstChild(); - BaseGDL* e1=interpreter->expr(_t); - _t = interpreter->GetRetTree(); -- std::auto_ptr e1_guard(e1); -+ Guard e1_guard(e1); - if( e1->True()) - { - return _t->LExpr( right); //l_expr(_t, right); -@@ -71,24 +71,56 @@ - - BaseGDL** ARRAYEXPRNode::LExpr( BaseGDL* right) // 'right' is not owned - //case ARRAYEXPR: -- { -- //res=l_array_expr(_t, right); -- if( right == NULL) -- throw GDLException( this, "Indexed expression not allowed in this context.", -- true,false); -+ { -+ //res=l_array_expr(_t, right); -+ if( right == NULL) -+ throw GDLException( this, "Indexed expression not allowed in this context.", -+ true,false); - -- ArrayIndexListT* aL; -- ArrayIndexListGuard guard; -+ ArrayIndexListT* aL; -+ ArrayIndexListGuard guard; -+ BaseGDL** res; -+// try{ -+// res=interpreter->l_indexable_expr( this->getFirstChild()); -+ res = this->getFirstChild()->LEval(); // throws -+ if( *res == NULL) -+ { // ERROR -+ // check not needed for SYSVAR -+ ProgNodeP _t = this->getFirstChild(); -+ assert( _t->getType() != GDLTokenTypes::SYSVAR); -+ if( _t->getType() == GDLTokenTypes::VARPTR) -+ { -+ GDLException ex( _t, "Common block variable is undefined: "+ -+ interpreter->CallStackBack()->GetString( *res),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ if( _t->getType() == GDLTokenTypes::VAR) -+ { -+ GDLException ex( _t, "Variable is undefined: "+ -+ interpreter->CallStackBack()->GetString(_t->varIx),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ GDLException ex( _t, "Variable is undefined: "+interpreter->Name(res),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+// } -+// catch( GDLException& ex) -+// { -+// ex.SetArrayexprIndexeeFailed( true); -+// throw ex; -+// } - -- BaseGDL** res=interpreter->l_indexable_expr( this->getFirstChild()); -- if( (*res)->IsAssoc()) -- aL=interpreter->arrayindex_list( this->getFirstChild()->getNextSibling()); -- else -- { -- if( (*res)->Type() == GDL_OBJ && (*res)->StrictScalar()) -- { -- // check for _overloadBracketsLeftSide -- DObj s = (*static_cast(*res))[0]; // is StrictScalar() -+ if( (*res)->IsAssoc()) -+ aL=interpreter->arrayindex_list( this->getFirstChild()->getNextSibling()); -+ else -+ { -+ if( (*res)->Type() == GDL_OBJ && (*res)->StrictScalar()) -+ { -+ // check for _overloadBracketsLeftSide -+ DObj s = (*static_cast(*res))[0]; // is StrictScalar() - // if( s != 0) // no overloads for null object - // { - // DStructGDL* oStructGDL= GDLInterpreter::GetObjHeapNoThrow( s); -@@ -96,98 +128,151 @@ - // { - // DStructDesc* desc = oStructGDL->Desc(); - // DPro* bracketsLeftSideOverload = static_cast(desc->GetOperator( OOBracketsLeftSide)); -- DPro* bracketsLeftSideOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOBracketsLeftSide)); -- if( bracketsLeftSideOverload != NULL) -- { -- bool internalDSubUD = bracketsLeftSideOverload->GetTree()->IsWrappedNode(); -- -- // _overloadBracketsLeftSide -- IxExprListT indexList; -- interpreter->arrayindex_list_overload( this->getFirstChild()->getNextSibling(), indexList); -- ArrayIndexListGuard guard(this->getFirstChild()->getNextSibling()->arrIxListNoAssoc); -- -- // hidden SELF is counted as well -- int nParSub = bracketsLeftSideOverload->NPar(); -- assert( nParSub >= 1); // SELF -+ DSubUD* bracketsLeftSideOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOBracketsLeftSide)); -+ if( bracketsLeftSideOverload != NULL) -+ { -+ bool internalDSubUD = bracketsLeftSideOverload->GetTree()->IsWrappedNode(); -+ -+ // _overloadBracketsLeftSide -+ IxExprListT indexList; -+ interpreter->arrayindex_list_overload( this->getFirstChild()->getNextSibling(), indexList); -+ ArrayIndexListGuard guard(this->getFirstChild()->getNextSibling()->arrIxListNoAssoc); -+ -+ // hidden SELF is counted as well -+ int nParSub = bracketsLeftSideOverload->NPar(); -+ assert( nParSub >= 1); // SELF - // int indexListSizeDebug = indexList.size(); -- // indexList.size() + OBJREF + RVALUE > regular paramters w/o SELF -- if( (indexList.size() + 2) > nParSub - 1) -- { -- indexList.Cleanup(); -- throw GDLException( this, bracketsLeftSideOverload->ObjectName() + -- ": Incorrect number of arguments.", -- false, false); -- } -- -- BaseGDL* self; -- Guard selfGuard; -- if( internalDSubUD) -- { -- self = (*res); // internal subroutines behave well -- } -- else -- { -- self = (*res)->Dup(); // res should be not changeable via SELF -- selfGuard.Reset( self); -- } -- -- // adds already SELF parameter -- EnvUDT* newEnv= new EnvUDT( this, bracketsLeftSideOverload, &self); -+ // indexList.size() + OBJREF + RVALUE > regular paramters w/o SELF -+ if( (indexList.size() + 2) > nParSub - 1) -+ { -+ indexList.Cleanup(); -+ throw GDLException( this, bracketsLeftSideOverload->ObjectName() + -+ ": Incorrect number of arguments.", -+ false, false); -+ } -+ -+ DObjGDL* self; -+ Guard selfGuard; -+ if( internalDSubUD) -+ { -+ self = static_cast(*res); // internal subroutines behave well -+ } -+ else -+ { -+ self = static_cast(*res)->Dup(); // res should be not changeable via SELF -+ selfGuard.Reset( self); -+ } -+ -+ // adds already SELF parameter -+ EnvUDT* newEnv= new EnvUDT( this, bracketsLeftSideOverload, &self); - // Guard newEnvGuard( newEnv); -- -- // parameters -- newEnv->SetNextParUnchecked( res); // OBJREF parameter -- // Dup() here is not optimal -- // avoid at least for internal overload routines (which do/must not change RVALUE) -- if( internalDSubUD) -- newEnv->SetNextParUnchecked( &right); // RVALUE parameter, as reference to prevent cleanup in newEnv -- else -- newEnv->SetNextParUnchecked( right->Dup()); // RVALUE parameter, as value -- // pass as reference would be more efficient, but as the data might -- // be deleted in bracketsLeftSideOverload it is not possible. -- // BaseGDL* rightCopy = right; -- // newEnv->SetNextParUnchecked( &rightCopy); // RVALUE parameter -- for( SizeT p=0; pSetNextParUnchecked( indexList[p]); // takes ownership -- -- StackGuard stackGuard(interpreter->CallStack()); -- interpreter->CallStack().push_back( newEnv); -- -- // make the call -- interpreter->call_pro(static_cast(newEnv->GetPro())->GetTree()); -- -- if( !internalDSubUD && self != selfGuard.Get()) -- { -- // always put out warning first, in case of a later crash -- Warning( "WARNING: " + bracketsLeftSideOverload->ObjectName() + -- ": Assignment to SELF detected (GDL session still ok)."); -- // assignment to SELF -> self was deleted and points to new variable -- // which it owns -- selfGuard.Release(); -- if( self != NullGDL::GetSingleInstance()) -- selfGuard.Reset(self); -- } -- -- return res; -- } --// } --// } -+ -+ // parameters -+ newEnv->SetNextParUnchecked( res); // OBJREF parameter -+ // Dup() here is not optimal -+ // avoid at least for internal overload routines (which do/must not change RVALUE) -+ if( internalDSubUD) -+ newEnv->SetNextParUnchecked( &right); // RVALUE parameter, as reference to prevent cleanup in newEnv -+ else -+ newEnv->SetNextParUnchecked( right->Dup()); // RVALUE parameter, as value -+ // pass as reference would be more efficient, but as the data might -+ // be deleted in bracketsLeftSideOverload it is not possible. -+ // BaseGDL* rightCopy = right; -+ // newEnv->SetNextParUnchecked( &rightCopy); // RVALUE parameter -+ for( SizeT p=0; pSetNextParUnchecked( indexList[p]); // takes ownership -+ -+ StackGuard stackGuard(interpreter->CallStack()); -+ interpreter->CallStack().push_back( newEnv); -+ -+ // make the call -+ interpreter->call_pro(static_cast(newEnv->GetPro())->GetTree()); -+ -+ if( !internalDSubUD && self != selfGuard.Get()) -+ { -+ // always put out warning first, in case of a later crash -+ Warning( "WARNING: " + bracketsLeftSideOverload->ObjectName() + -+ ": Assignment to SELF detected (GDL session still ok)."); -+ // assignment to SELF -> self was deleted and points to new variable -+ // which it owns -+ selfGuard.Release(); -+ if( static_cast(self) != NullGDL::GetSingleInstance()) -+ selfGuard.Reset(self); - } -- aL=interpreter->arrayindex_list_noassoc( this->getFirstChild()->getNextSibling()); -+ -+ return res; - } -- guard.reset(aL); -+// } -+// } -+ } -+ -+// aL=interpreter->arrayindex_list_noassoc( this->getFirstChild()->getNextSibling()); -+ { -+// IxExprListT cleanupList; // for cleanup -+ IxExprListT ixExprList; -+ SizeT nExpr; -+ BaseGDL* s; -+ -+ ProgNodeP ax = this->getFirstChild()->getNextSibling(); -+ // match(antlr::RefAST(_t),ARRAYIX); -+ ProgNodeP _t = ax->getFirstChild(); -+ -+ aL = ax->arrIxListNoAssoc; -+ assert( aL != NULL); -+ -+ nExpr = aL->NParam(); -+ if( nExpr == 0) -+ { -+ aL->Init(); -+ } -+ else -+ { -+ IxExprListT* cleanupList = aL->GetCleanupIx(); // for cleanup -+ -+ while( true) { -+ assert( _t != NULL); -+ if( NonCopyNode( _t->getType())) -+ { -+ s= _t->EvalNC(); //indexable_expr(_t); -+ } -+ else if( _t->getType() == GDLTokenTypes::FCALL_LIB) -+ { -+// s = interpreter->lib_function_call(_t); -+ s = static_cast(_t)->EvalFCALL_LIB(); -+ -+ if( !interpreter->CallStackBack()->Contains( s)) -+ cleanupList->push_back( s); -+ } -+ else -+ { -+ s=_t->Eval(); //indexable_tmp_expr(_t); -+ cleanupList->push_back( s); -+ } -+ -+ ixExprList.push_back( s); -+ if( ixExprList.size() == nExpr) -+ break; // allows some manual tuning - -- try { -- aL->AssignAt( *res, right); -- } -- catch( GDLException& ex) -- { -- ex.SetErrorNodeP( this); -- throw ex; -- } -- //_retTree = _t->getNextSibling(); -- return res; -+ _t = _t->getNextSibling(); - } -+ -+ aL->Init( ixExprList);//, &cleanupList); -+ } -+ } -+ } -+ guard.reset(aL); -+ -+ try { -+ aL->AssignAt( *res, right); -+ } -+ catch( GDLException& ex) -+ { -+ ex.SetErrorNodeP( this); -+ throw ex; -+ } -+ //_retTree = _t->getNextSibling(); -+ return res; -+} - // default ...Grab version - - BaseGDL** SYSVARNode::LExpr( BaseGDL* right) -@@ -198,12 +283,12 @@ - true,false); - - BaseGDL** res=this->LEval(); //l_sys_var(this); -- std::auto_ptr conv_guard; //( rConv); -+ Guard conv_guard; //( rConv); - BaseGDL* rConv = right; - if( !(*res)->EqType( right)) - { - rConv = right->Convert2( (*res)->Type(), BaseGDL::COPY); -- conv_guard.reset( rConv); -+ conv_guard.Reset( rConv); - } - if( right->N_Elements() != 1 && ((*res)->N_Elements() != right->N_Elements())) - { -@@ -290,26 +375,31 @@ - - assert( fcallNodeFunIx == -1); - try{ -- BaseGDL** res = fcallNode->FCALLNode::LExpr( right); -- fcallNodeFunIx = fcallNode->funIx; -- return res; -- } catch( GDLException& ex) -+ BaseGDL** res = arrayExprNode->ARRAYEXPRNode::LExpr( right); -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -+ return res; -+ } -+ catch( GDLException& ex) - { -- // keep FCALL if already compiled (but runtime error) -- if(fcallNode->funIx >= 0) -+ if( !ex.GetArrayexprIndexeeFailed()) - { -- fcallNodeFunIx = fcallNode->funIx; -+ fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded - throw ex; - } - try{ -- BaseGDL** res = arrayExprNode->ARRAYEXPRNode::LExpr( right); -- fcallNodeFunIx = -2; // mark as ARRAYEXPR succeeded -- return res; -- } -+ BaseGDL** res = fcallNode->FCALLNode::LExpr( right); -+ fcallNodeFunIx = fcallNode->funIx; -+ return res; -+ } // keep FCALL if already compiled (but runtime error) - catch( GDLException& innerEx) - { -- std::string msg = "Ambiguous: " + ex.toString() + -- " or: " + innerEx.toString(); -+ if(fcallNode->funIx >= 0) -+ { -+ fcallNodeFunIx = fcallNode->funIx; -+ throw innerEx; -+ } -+ std::string msg = "Ambiguous: " + ex.ANTLRException::toString() + -+ " or: " + innerEx.ANTLRException::toString(); - throw GDLException(this,msg,true,false); - } - } -@@ -333,10 +423,195 @@ - ProgNodeP _t = this->getFirstChild(); - - //SizeT nDot = tIn->nDot; -- std::auto_ptr aD( new DotAccessDescT(nDot+1)); -+ Guard aD( new DotAccessDescT(nDot+1)); - -- interpreter->l_dot_array_expr(_t, aD.get()); -- _t = interpreter->GetRetTree(); -+ //interpreter->l_dot_array_expr(_t, aD.get()); -+ -+ ArrayIndexListT* aL; -+ BaseGDL** rP; -+ if( _t->getType() == GDLTokenTypes::ARRAYEXPR) -+ { -+// rP=l_indexable_expr(_t->getFirstChild()); -+ rP = _t->getFirstChild()->LEval(); // throws -+ if( *rP == NULL) -+ { // ERROR -+ BaseGDL** res = rP; -+ ProgNodeP _t = _t->getFirstChild(); -+ // check not needed for SYSVAR -+ assert( _t->getType() != GDLTokenTypes::SYSVAR); -+ if( _t->getType() == GDLTokenTypes::VARPTR) -+ { -+ GDLException ex( _t, "Common block variable is undefined: "+ -+ interpreter->CallStackBack()->GetString( *res),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ if( _t->getType() == GDLTokenTypes::VAR) -+ { -+ GDLException ex( _t, "Variable is undefined: "+ -+ interpreter->CallStackBack()->GetString(_t->GetVarIx()),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ GDLException ex( _t, "Variable is undefined: "+interpreter->Name(res),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ -+// aL=arrayindex_list(_t->getFirstChild()->getNextSibling()); -+ bool handled = false; -+ if( !(*rP)->IsAssoc() && (*rP)->Type() == GDL_OBJ && (*rP)->StrictScalar()) -+ { -+ -+ // check for _overloadBracketsLeftSide -+ DObj s = (*static_cast(*rP))[0]; // is StrictScalar() -+ DSubUD* bracketsLeftSideOverload = static_cast(GDLInterpreter::GetObjHeapOperator( s, OOBracketsLeftSide)); -+ if( bracketsLeftSideOverload != NULL) -+ { -+ bool internalDSubUD = bracketsLeftSideOverload->GetTree()->IsWrappedNode(); -+ -+ // _overloadBracketsLeftSide -+ IxExprListT indexList; -+ interpreter->arrayindex_list_overload( _t->getFirstChild()->getNextSibling(), indexList); -+ ArrayIndexListGuard guard(_t->getFirstChild()->getNextSibling()->arrIxListNoAssoc); -+ -+ // hidden SELF is counted as well -+ int nParSub = bracketsLeftSideOverload->NPar(); -+ assert( nParSub >= 1); // SELF -+ -+ // indexList.size() + OBJREF + RVALUE > regular paramters w/o SELF -+ if( (indexList.size() + 2) > nParSub - 1) -+ { -+ indexList.Cleanup(); -+ throw GDLException( this, bracketsLeftSideOverload->ObjectName() + -+ ": Incorrect number of arguments.", -+ false, false); -+ } -+ -+ DObjGDL* self; -+ Guard selfGuard; -+ if( internalDSubUD) -+ { -+ self = static_cast(*rP); // internal subroutines behave well -+ } -+ else -+ { -+ self = static_cast(*rP)->Dup(); // res should be not changeable via SELF -+ selfGuard.Reset( self); -+ } -+ -+ // adds already SELF parameter -+ EnvUDT* newEnv= new EnvUDT( this, bracketsLeftSideOverload, &self); -+ // Guard newEnvGuard( newEnv); -+ -+ // parameters -+ // special: we are in dot access here -+ // signal to _overloadBracketsLeftSide by setting OBJREF to NULL -+ BaseGDL* returnOBJREF = NULL; -+ newEnv->SetNextParUnchecked( &returnOBJREF); // OBJREF parameter -+ // Dup() here is not optimal -+ // avoid at least for internal overload routines (which do/must not change RVALUE) -+ -+ BaseGDL* rValueNull = NULL; -+ newEnv->SetNextParUnchecked( rValueNull); // RVALUE parameter NULL, as value -+// if( internalDSubUD) -+// newEnv->SetNextParUnchecked( &right); // RVALUE parameter, as reference to prevent cleanup in newEnv -+// else -+// newEnv->SetNextParUnchecked( right->Dup()); // RVALUE parameter, as value -+ -+ // pass as reference would be more efficient, but as the data might -+ // be deleted in bracketsLeftSideOverload it is not possible. -+ // BaseGDL* rightCopy = right; -+ // newEnv->SetNextParUnchecked( &rightCopy); // RVALUE parameter -+ -+// // signal dot access: -+// // set ISRANGE[0] from 0/1 to 2/3 -+// assert( indexList.size() > 0); -+// assert( indexList[0]->Type() == GDL_LONG); -+// assert( indexList[0]->N_Elements() > 0); -+// *(static_cast(indexList))[0] += 2; -+ -+ for( SizeT p=0; pSetNextParUnchecked( indexList[p]); // takes ownership -+ -+ StackGuard stackGuard(interpreter->CallStack()); -+ interpreter->CallStack().push_back( newEnv); -+ -+ // make the call -+ interpreter->call_pro(static_cast(newEnv->GetPro())->GetTree()); -+ -+ if( !internalDSubUD && self != selfGuard.Get()) -+ { -+ // always put out warning first, in case of a later crash -+ Warning( "WARNING: " + bracketsLeftSideOverload->ObjectName() + -+ ": Assignment to SELF detected (GDL session still ok)."); -+ // assignment to SELF -> self was deleted and points to new variable -+ // which it owns -+ selfGuard.Release(); -+ if( static_cast(self) != NullGDL::GetSingleInstance()) -+ selfGuard.Reset(self); -+ } -+ -+ if( returnOBJREF == NULL || returnOBJREF->Type() != GDL_PTR) -+ GDLException ex( _t, "OBJREF must return a PTR to the STRUCT to access.",true,false); -+ -+ DPtr vID = (*static_cast(returnOBJREF))[0]; -+ delete returnOBJREF; -+ -+ BaseGDL* structToAccess = interpreter->GetHeap( vID); -+ -+ interpreter->SetRootL( _t, aD.get(), structToAccess, NULL); -+ handled = true; -+ } -+ } // if( (*rP)->Type() == GDL_OBJ && (*rP)->StrictScalar()) -+ if( !handled) -+ { -+ // regular (non-object) case -+ aL=interpreter->arrayindex_list( _t->getFirstChild()->getNextSibling()); -+ interpreter->SetRootL( _t, aD.get(), *rP, aL); -+ } -+ } -+ else -+ // case ARRAYEXPR_MFCALL: -+ // case DEREF: -+ // case EXPR: -+ // case FCALL: -+ // case FCALL_LIB: -+ // case MFCALL: -+ // case MFCALL_PARENT: -+ // case SYSVAR: -+ // case VAR: -+ // case VARPTR: -+ { -+// rP=l_indexable_expr(_t); -+ rP = _t->LEval(); // throws -+ if( *rP == NULL) -+ { // ERROR -+ BaseGDL** res = rP; -+ // check not needed for SYSVAR -+ assert( _t->getType() != GDLTokenTypes::SYSVAR); -+ if( _t->getType() == GDLTokenTypes::VARPTR) -+ { -+ GDLException ex( _t, "Common block variable is undefined: "+ -+ interpreter->CallStackBack()->GetString( *res),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ if( _t->getType() == GDLTokenTypes::VAR) -+ { -+ GDLException ex( _t, "Variable is undefined: "+ -+ interpreter->CallStackBack()->GetString(_t->GetVarIx()),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ GDLException ex( _t, "Variable is undefined: "+interpreter->Name(res),true,false); -+ ex.SetArrayexprIndexeeFailed( true); -+ throw ex; -+ } -+ interpreter->SetRootL( _t, aD.get(), *rP, NULL); -+ } -+ -+ _t = _t->getNextSibling(); - for( int d=0; dgetType() == ARRAYEXPR || _t->getType() == EXPR || -@@ -361,13 +636,17 @@ - ProgNodeP _t = _t->getFirstChild(); - if( NonCopyNode(_t->getType())) - { -- BaseGDL* e1=interpreter->indexable_expr(_t); -- _t = interpreter->GetRetTree(); -+// BaseGDL* e1=interpreter->indexable_expr(_t); -+// _t = interpreter->GetRetTree(); -+ BaseGDL* e1 = _t->EvalNC(); -+ _t = _t->getNextSibling(); - } - else if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- BaseGDL* e1=interpreter->lib_function_call(_t); -- _t = interpreter->GetRetTree(); -+// BaseGDL* e1=interpreter->lib_function_call(_t); -+// _t = interpreter->GetRetTree(); -+ BaseGDL* e1 = static_cast(_t)->EvalFCALL_LIB(); -+ _t = _t->getNextSibling(); - if( !interpreter->CallStackBack()->Contains( e1)) - GDLDelete(e1); // guard if no global data - } -@@ -393,9 +672,11 @@ - // case INC: - // case DOT: - // case QUESTION: -- BaseGDL* e1=interpreter->indexable_tmp_expr(_t); -- _t = interpreter->GetRetTree(); -+// BaseGDL* e1=interpreter->indexable_tmp_expr(_t); -+// _t = interpreter->GetRetTree(); -+ BaseGDL* e1 = _t->Eval(); //lib_function_call_retnew(_t); - GDLDelete(e1); -+ _t = _t->getNextSibling(); - } - //SetRetTree( tIn->getNextSibling()); - return _t->LExpr( right); //l_expr(_t, right); -@@ -408,13 +689,17 @@ - - if( NonCopyNode(_t->getType())) - { -- BaseGDL* e1=interpreter->indexable_expr(_t); -- _t = interpreter->GetRetTree(); -+// BaseGDL* e1=interpreter->indexable_expr(_t); -+// _t = interpreter->GetRetTree(); -+ BaseGDL* e1 = _t->EvalNC(); -+ _t = _t->getNextSibling(); - } - else if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- BaseGDL* e1=interpreter->lib_function_call(_t); -- _t = interpreter->GetRetTree(); -+// BaseGDL* e1=interpreter->lib_function_call(_t); -+// _t = interpreter->GetRetTree(); -+ BaseGDL* e1 = static_cast(_t)->EvalFCALL_LIB(); -+ _t = _t->getNextSibling(); - if( !interpreter->CallStackBack()->Contains( e1)) - GDLDelete(e1); // guard if no global data - } -@@ -440,9 +725,11 @@ - // case INC: - // case DOT: - // case QUESTION: -- BaseGDL* e1=interpreter->indexable_tmp_expr(_t); -- _t = interpreter->GetRetTree(); -+// BaseGDL* e1=interpreter->indexable_tmp_expr(_t); -+// _t = interpreter->GetRetTree(); -+ BaseGDL* e1 = _t->Eval(); //lib_function_call_retnew(_t); - GDLDelete(e1); -+ _t = _t->getNextSibling(); - } - ProgNodeP l = _t; - BaseGDL** res; -@@ -478,12 +765,16 @@ - { - ProgNodeP _t = this->getFirstChild(); - -+ BaseGDL** res; - if( _t->getType() == GDLTokenTypes::FCALL_LIB) - { -- BaseGDL* e1=interpreter->lib_function_call(_t); -- _t = interpreter->GetRetTree(); -- if( !interpreter->CallStackBack()->Contains( e1)) -- GDLDelete(e1); -+// BaseGDL* e1=interpreter->lib_function_call(_t); -+// _t = interpreter->GetRetTree(); -+ BaseGDL* e1 = static_cast(_t)->EvalFCALL_LIB(); -+ _t = _t->getNextSibling(); -+ res =_t->LEval(); //l_function_call(_t); -+ if( *res != e1 && !interpreter->CallStackBack()->Contains( e1)) -+ GDLDelete(e1); - } - else - { -@@ -512,9 +803,13 @@ - // case INC: - // case DOT: - // case QUESTION: -- BaseGDL* e1=interpreter->tmp_expr(_t); -- _t = interpreter->GetRetTree(); -- GDLDelete(e1); -+ -+// BaseGDL* e1=interpreter->tmp_expr(_t); -+ BaseGDL* e1 = _t->Eval(); -+ _t =_t->getNextSibling(); -+ res =_t->LEval(); //l_function_call(_t); -+ if( *res != e1) -+ GDLDelete(e1); - } - - // switch ( _t->getType()) { -@@ -538,7 +833,7 @@ - // // case MFCALL: - // // case MFCALL_PARENT: - // { -- BaseGDL** res=_t->LEval(); //l_function_call(_t); -+// BaseGDL** res=_t->LEval(); //l_function_call(_t); - //_retTree = tIn->getNextSibling(); - //_t = _retTree; - // break; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/pythongdl.cpp gdl/src/pythongdl.cpp ---- gdl-0.9.3/src/pythongdl.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/pythongdl.cpp 2013-07-31 09:41:44.234244670 -0600 -@@ -375,7 +375,7 @@ - else - e = new EnvUDT( NULL, sub); - -- auto_ptr< EnvBaseT> e_guard( e); -+ Guard< EnvBaseT> e_guard( e); - - // copy arguments - success = CopyArgFromPython( parRef, kwRef, *e, argTuple, kwDict); -@@ -391,7 +391,7 @@ - } - - BaseGDL* retValGDL = NULL; -- auto_ptr retValGDL_guard; -+ Guard retValGDL_guard; - if( functionCall) - { - if( libCall) -@@ -401,7 +401,7 @@ - retValGDL = interpreter->call_fun(static_cast - (static_cast(e) - ->GetPro())->GetTree()); -- retValGDL_guard.reset( retValGDL); -+ retValGDL_guard.Reset( retValGDL); - } - else - { -@@ -438,8 +438,8 @@ - - ret: - // free GDL parameters and keywords -- Purge( parRef); -- Purge( kwRef); -+ PurgeContainer( parRef); -+ PurgeContainer( kwRef); - - // restore old signal handlers - PyOS_setsig(SIGINT,oldControlCHandler); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/read.cpp gdl/src/read.cpp ---- gdl-0.9.3/src/read.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/read.cpp 2013-07-08 12:39:22.745383050 -0600 -@@ -299,13 +299,12 @@ - throw GDLException( e->CallingNode(), "Parameter undefined: "+ - e->GetParString(0)); - -- // auto_ptr guard; -+ // Guard guard; - stringstream is; - -- DStringGDL* iStr = dynamic_cast(p); -- if( iStr == NULL) -+ if( p->Type() != GDL_STRING) - { -- iStr = static_cast(p->Convert2( GDL_STRING, BaseGDL::COPY)); -+ DStringGDL* iStr = static_cast(p->Convert2( GDL_STRING, BaseGDL::COPY)); - - SizeT nStr = iStr->N_Elements(); - for( SizeT i = 0; i < nStr; i++) -@@ -315,6 +314,7 @@ - } - else - { -+ DStringGDL* iStr = static_cast(p); - SizeT nStr = iStr->N_Elements(); - for( SizeT i = 0; i < nStr; i++) - is << (*iStr)[ i] << '\n'; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/specializations.hpp gdl/src/specializations.hpp ---- gdl-0.9.3/src/specializations.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/specializations.hpp 2013-07-31 09:41:44.236244663 -0600 -@@ -18,6 +18,9 @@ - - // basic_op.cpp - -+template<> -+SizeT Data_::N_Elements() const; -+ - template<> - BaseGDL* Data_::EqOp( BaseGDL*); - template<> -@@ -67,22 +70,24 @@ - void Data_::Inc(); - template<> - void Data_::Inc(); --template<> --Data_* Data_::AndOp( BaseGDL* r); -+// template<> -+// Data_* Data_::AndOp( BaseGDL* r); - template<> - Data_* Data_::AndOpInv( BaseGDL* r); --template<> --Data_* Data_::AndOp( BaseGDL* r); -+// template<> -+// Data_* Data_::AndOp( BaseGDL* r); - template<> - Data_* Data_::AndOpInv( BaseGDL* r); --template<> --Data_* Data_::AndOp( BaseGDL* r); --template<> --Data_* Data_::AndOp( BaseGDL* r); --template<> --Data_* Data_::AndOp( BaseGDL* r); --template<> --Data_* Data_::AndOp( BaseGDL* r); -+// template<> -+// Data_* Data_::AndOp( BaseGDL* r); -+// template<> -+// Data_* Data_::AndOp( BaseGDL* r); -+// template<> -+// Data_* Data_::AndOp( BaseGDL* r); -+// template<> -+// Data_* Data_::AndOp( BaseGDL* r); -+// template<> -+// Data_* Data_::AndOp( BaseGDL* r); - template<> - Data_* Data_::OrOp( BaseGDL* r); - template<> -@@ -339,9 +344,9 @@ - template<> - Data_* Data_::PowInv( BaseGDL* r); - template<> --Data_* Data_::MatrixOp( BaseGDL* r,bool t,bool tr, bool s); -+Data_* Data_::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose); - template<> --Data_* Data_::MatrixOp( BaseGDL* ,bool t,bool tr,bool s); -+Data_* Data_::MatrixOp( BaseGDL* r, bool atranspose, bool btranspose); - template<> - Data_* Data_::LogNeg(); - template<> -@@ -393,15 +398,15 @@ - template<> - Data_::Ty Data_::max() const;*/ - template<> --int Data_::Scalar2index( SizeT& st) const; -+int Data_::Scalar2Index( SizeT& st) const; - template<> --int Data_::Scalar2index( SizeT& st) const; -+int Data_::Scalar2Index( SizeT& st) const; - template<> --int Data_::Scalar2index( SizeT& st) const; -+int Data_::Scalar2Index( SizeT& st) const; - template<> --int Data_::Scalar2index( SizeT& st) const; -+int Data_::Scalar2Index( SizeT& st) const; - template<> --int Data_::Scalar2index( SizeT& st) const; -+int Data_::Scalar2Index( SizeT& st) const; - template<> - bool Data_::True(); - template<> -@@ -642,29 +647,38 @@ - template<> SizeT Data_:: - OFmtI( std::ostream* os, SizeT offs, SizeT r, int w, int d, char f, - BaseGDL::IOMode oMode); -- -- --template<> --void Data_< SpDString>::Construct(); --template<> --void Data_< SpDComplex>::Construct(); -+template<> SizeT Data_:: -+OFmtCal( std::ostream* os, SizeT offs, SizeT r, int w, int d, char f, -+ BaseGDL::Cal_IOMode cMode); -+// template<> -+// void Data_< SpDString>::Construct(); -+// template<> -+// void Data_< SpDComplex>::Construct(); -+// template<> -+// void Data_< SpDComplexDbl>::Construct(); -+template<> -+void Data_< SpDPtr>::Construct(); -+template<> -+void Data_< SpDObj>::Construct(); -+// template<> -+// void Data_< SpDString>::ConstructTo0(); -+// template<> -+// void Data_< SpDComplex>::ConstructTo0(); -+// template<> -+// void Data_< SpDComplexDbl>::ConstructTo0(); -+// template<> -+// void Data_< SpDString>::Destruct(); -+// template<> -+// void Data_< SpDComplex>::Destruct(); -+// template<> -+// void Data_< SpDComplexDbl>::Destruct(); - template<> --void Data_< SpDComplexDbl>::Construct(); -+void Data_< SpDPtr>::Destruct(); - template<> --void Data_< SpDString>::ConstructTo0(); --template<> --void Data_< SpDComplex>::ConstructTo0(); --template<> --void Data_< SpDComplexDbl>::ConstructTo0(); --template<> --void Data_< SpDString>::Destruct(); --template<> --void Data_< SpDComplex>::Destruct(); --template<> --void Data_< SpDComplexDbl>::Destruct(); -+void Data_< SpDObj>::Destruct(); - - // GetAsIndex/GetAsIndexStrict --template<> -+ template<> - SizeT Data_::GetAsIndex( SizeT i) const; - template<> - SizeT Data_::GetAsIndexStrict( SizeT i) const; -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/str.cpp gdl/src/str.cpp ---- gdl-0.9.3/src/str.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/str.cpp 2013-07-08 12:39:22.749383003 -0600 -@@ -1,3 +1,4 @@ -+ - /*************************************************************************** - str.cpp - basic string manipulation functions - ------------------- -@@ -295,8 +296,23 @@ - // int ok0 = wordexp( sEsc.c_str(), &p, 0); - if( ok0 == 0) - { -+ // cout<< p.we_wordc<<"word count\n"; - if( p.we_wordc > 0) -- s = p.we_wordv[0]; -+ { -+ // s=""; -+ string ss= p.we_wordv[0]; -+ for(int i=1,ind=s.find(" "); i -+// template -+// typename Sp::Ty Data_::B1() -+// { -+// std::cout << "is_integer\n"; -+// return Sp::zero; -+// } -+// template -+// template -+// typename std::enable_if::value, typename U::Ty>::type -+// Data_::Test1() -+// { -+// dd[0]++; -+// dd[0]--; -+// std::cout << "is_integer\n"; -+// return Sp::zero; -+// } -+// template -+// template -+// typename std::enable_if::value, typename U::Ty>::type -+// Data_::Test1() -+// { -+// std::cout << "is_float\n"; -+// return Sp::zero; -+// } -+// template -+// template -+// typename std::enable_if::value, typename U::Ty>::type -+// Data_::Test1() -+// { -+// std::cout << "is_complex\n"; -+// return Sp::zero; -+// } -+// template -+// template -+// typename std::enable_if::value, typename U::Ty>::type -+// Data_::Test1() -+// { -+// std::cout << "is_other\n"; -+// return Sp::zero; -+// } -+ -+template -+template -+typename U::template IfInteger::type -+Data_::Test2() -+{ -+ dd[0]++; -+ dd[0]--; -+ std::cout << "is_integer\n"; -+ return true; -+} -+template -+template -+typename U::template IfFloat::type -+Data_::Test2() -+{ -+ std::cout << "is_float\n"; -+ return true; -+} -+template -+template -+typename U::template IfComplex::type -+Data_::Test2() -+{ -+ std::cout << "is_complex\n"; -+ return true; -+} -+template -+template -+typename U::template IfOther::type -+Data_::Test2() -+{ -+ std::cout << "is_other\n"; -+ return false; -+} -+ -+ -+ -+ -+ -Only in gdl-0.9.3/src: .#tmp_scratch.cpp -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/typedefs.hpp gdl/src/typedefs.hpp ---- gdl-0.9.3/src/typedefs.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/typedefs.hpp 2013-07-31 09:41:44.237244659 -0600 -@@ -51,22 +51,28 @@ - #include - // #include // memcopy - #include // memcopy --#include -+// #include - #include - #include - #include - #include --// #include -+#include - --// undef for releases (should not give diagnostics) --// define for the CVS (where the default sizes can easily be adjusted) --//#define GDL_CVS_VERSION --#undef GDL_CVS_VERSION -+#undef USE_MPFR - --#ifdef GDL_CVS_VERSION --#include -+#ifdef USE_MPFR -+#include "mpreal.h" - #endif - -+// // undef for releases (should not give diagnostics) -+// // define for the CVS (where the default sizes can easily be adjusted) -+// #define GDL_CVS_VERSION -+// //#undef GDL_CVS_VERSION -+// // ? -+// #ifdef GDL_CVS_VERSION -+// #include -+// #endif -+ - //#define TRACE_OMP_CALLS - #undef TRACE_OMP_CALLS - -@@ -79,6 +85,7 @@ - // SA: fixing bug no. 3296360 - typedef unsigned long long int SizeT; - typedef long long int RangeT; -+typedef long long int OMPInt; - - const SizeT MAXRANK=8; // arrays are limited to 8 dimensions - const std::string MAXRANK_STR("8"); // for use in strings (error messages) -@@ -110,6 +117,7 @@ - #ifdef _MSC_VER - typedef __int64 DLong64; - typedef unsigned __int64 DULong64; -+ - #else - //typedef long int DLong64; - //typedef unsigned long int DULong64; -@@ -117,6 +125,19 @@ - typedef unsigned long long int DULong64; - #endif - -+#ifdef USE_MPFR -+ -+typedef __int128 DLong128; -+typedef unsigned __int128 DULong128; -+ -+typedef long double DLDouble; -+typedef std::complex DComplexLDbl; -+ -+ -+typedef mpfr::mpreal DArbitrary; -+#endif -+ -+ - typedef short DInt; - typedef unsigned short DUInt; - typedef int DLong; -@@ -126,16 +147,18 @@ - typedef std::string DString; - typedef SizeT DPtr; // ptr to heap - typedef DPtr DObj; // ptr to object heap --typedef std::complex DComplex; --typedef std::complex DComplexDbl; -- -+typedef std::complex DComplex; -+typedef std::complex DComplexDbl; - - // list of identifiers (used in several places) --typedef std::deque IDList; --typedef std::deque StrArr; -+typedef std::vector IDList; -+typedef std::vector StrArr; -+ -+// for dpro -+typedef std::vector KeyVarListT; - - // used by file.cpp and in other places --typedef std::deque FileListT; -+typedef std::vector FileListT; - - //typedef std::valarray AllIxT; - -@@ -186,6 +209,18 @@ - - return -1; - } -+// TODO: make a template -+inline int FindInKeyVarListT(KeyVarListT& idL,const std::string& s) -+{ -+// int ix=0; -+ for(KeyVarListT::iterator i=idL.begin(); i != idL.end(); ++i)//, ++ix) -+ if( *i==s) -+ { -+ return i - idL.begin(); -+ } -+ -+ return -1; -+} - - // as auto_ptr is obsoleted Guard offers an alternative - template -@@ -194,6 +229,16 @@ - private: - T* guarded; - -+ Guard& operator=( Guard& r) -+ { -+ if( &r == this) return; -+ delete guarded; -+ guarded = r.guarded; -+ r.guarded = NULL; -+ return *this; -+ } -+ -+ - public: - Guard(): guarded( NULL) - {} -@@ -210,15 +255,37 @@ - delete guarded; - guarded = newGuarded; - } -+ // for compatibiltiy with replaced auto_ptr -+ void reset( T* newGuarded) -+ { -+ delete guarded; -+ guarded = newGuarded; -+ } - void Release() - { - guarded = NULL; - } -- T* Get() -+ T* release() -+ { -+ T* g = guarded; -+ guarded = NULL; -+ return g; -+ } -+ T* Get() const -+ { -+ return guarded; -+ } -+ // for compatibiltiy with replaced auto_ptr -+ T* get() const - { - return guarded; - } -- bool IsNull() -+ // for compatibiltiy with replaced auto_ptr -+ T* operator->() const -+ { -+ return guarded; -+ } -+ bool IsNull() const - { - return guarded == NULL; - } -@@ -229,6 +296,9 @@ - } - }; - -+ -+ -+ - // like auto_ptr but for arrays (delete[] is used upon destruction) - template - class ArrayGuard -@@ -352,388 +422,6 @@ - T* Release() { T* r=container; container=NULL; return r;} - }; - --// #define GDLARRAY_CACHE --#undef GDLARRAY_CACHE -- --#define GDLARRAY_DEBUG --// #undef GDLARRAY_DEBUG -- --// const SizeT smallArraySize = 27; --// const SizeT maxArrayCache = 1000 * 1000; // ComplexDbl is 16 bytes -- --template --class GDLArray --{ --private: -- enum GDLArrayConstants -- { -- smallArraySize = 27, -- maxCache = 1000 * 1000 // ComplexDbl is 16 bytes -- }; -- -- typedef T Ty; -- --#ifdef GDLARRAY_CACHE -- -- static SizeT cacheSize; -- static T* cache; -- static T* Cached( SizeT newSize); --#endif -- -- T scalar[ smallArraySize]; -- T* buf; -- SizeT sz; -- --public: -- GDLArray() throw() : buf( NULL), sz( 0) {} -- --#ifndef GDLARRAY_CACHE -- -- GDLArray( const GDLArray& cp) : sz( cp.size()) -- { -- try { -- buf = (cp.size() > smallArraySize) ? new T[ cp.size()] : scalar; -- } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } --/*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- std::memcpy(buf,cp.buf,sz*sizeof(T)); -- --// for( SizeT i=0; i smallArraySize) ? new T[ s] : scalar; -- } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } -- } -- -- GDLArray( T val, SizeT s) : sz( s) -- { -- try { -- buf = (s > smallArraySize) ? new T[ s] : scalar; -- } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } --/*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- for( SizeT i=0; i smallArraySize ) ? new T[ s]: scalar; -- } -- catch ( std::bad_alloc& ) { ThrowGDLException ( "Array requires more memory than available" ); } --/*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- -- std::memcpy(buf,arr,sz*sizeof(T)); --// for( SizeT i=0; i= sz) -- assert( ix < sz); -- return buf[ ix]; -- } -- const T& operator[]( SizeT ix) const throw() -- { --// if( ix >= sz) // debug -- assert( ix < sz); -- return buf[ ix]; -- } -- --// private: // disable --// only used (indirect) by DStructGDL::DStructGDL(const DStructGDL& d_) --void InitFrom( const GDLArray& right ) --{ --// // assert( sz == right.size()); --// if ( sz != right.size() ) --// ThrowGDLException ( "GDLArray::operator= operands have not same size (this: " + i2s ( sz ) +", right: " + i2s ( right.size() ) + ")"); -- assert( &right != this); -- assert ( sz == right.size() ); -- std::memcpy(buf,right.buf,sz*sizeof(T)); --} -- --GDLArray& operator= ( const GDLArray& right ) --{ --// if ( sz != right.size() ) --// ThrowGDLException ( "GDLArray::operator= operands have not same size (this: " + i2s ( sz ) +", right: " + i2s ( right.size() ) + ")"); -- -- assert( this != &right); -- assert( sz == right.size()); --// if ( &right != this ) -- { --// if ( sz == right.size() ) -- { -- /*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) -- { -- #pragma omp for*/ -- for ( SizeT i=0; ismallArraySize ) ? new T[ sz] : scalar; -- /*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) -- { -- #pragma omp for*/ -- for ( SizeT i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- for( SizeT i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- for( SizeT i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- for( SizeT i=0; i= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- for( SizeT i=0; i smallArraySize ) -- { -- try -- { -- buf = new T[ newSz]; -- } -- catch ( std::bad_alloc& ) -- { -- ThrowGDLException ( "Array requires more memory than available" ); -- } -- } -- else -- { --// default constructed instances have buf == NULL and size == 0 --// make sure buf is set corectly if such instances are resized -- buf = scalar; -- } -- sz = newSz; --// assert ( newSz > sz ); --// if ( newSz > smallArraySize ) --// { --// try --// { --// T* newBuf = new T[ newSz]; --// /*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --// { --// #pragma omp for*/ --// for ( SizeT i=0; i buf[ i]) res = buf[ i]; --// return res; --// } --// T max() const --// { --// T res = buf[ 0]; --// for( SizeT i=1; i --inline void GDLArray::InitFrom( const GDLArray& right ) --{ -- assert( &right != this); -- assert ( sz == right.size() ); -- for ( SizeT i=0; i --inline GDLArray::GDLArray( const GDLArray& cp) : sz( cp.size()) -- { -- try { -- buf = (cp.size() > smallArraySize) ? new Ty[ cp.size()] : scalar; -- } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } --/*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- for( SizeT i=0; i --inline GDLArray::GDLArray( const Ty* arr, SizeT s) : sz( s) -- { -- try { -- buf = (s > smallArraySize) ? new Ty[ s]: scalar; -- } catch (std::bad_alloc&) { ThrowGDLException("Array requires more memory than available"); } --/*#pragma omp parallel if (sz >= CpuTPOOL_MIN_ELTS && (CpuTPOOL_MAX_ELTS == 0 || CpuTPOOL_MAX_ELTS <= sz)) --{ --#pragma omp for*/ -- for( SizeT i=0; i --// GDLArray pow(const GDLArray& left, --// const GDLArray& right) --// { --// GDLArray res( left.size); -- --// for( SizeT i=0; i --// GDLArray pow(const GDLArray left, const Ty& right); --// template --// GDLArray pow(const Ty& left, const GDLArray& right); - - // this data structure is optimized for list sizes < ExprListDefaultLength - // ExprListDefaultLength should be set such that it will probably never exceed -@@ -811,23 +499,26 @@ - // - // GDLGuard< gsl_matrix> gsl_matrix_guard( matrix, gsl_matrix_free); - // (of course no explicit call to the gsl-cleanup function must be done anymore) --template< typename GSLType, typename cleanupReturnType=void> -+template< typename GSLType, typename cleanupReturnType=void, typename cleanupArgType=GSLType> - class GDLGuard - { - GSLType* gslObject; - -- cleanupReturnType (*gslDestructor)(GSLType*); -+ // note: cleanupArgType must be GSLType, -+ // except for free( void*) with GSLType==void* -+ // where it must be void -+ cleanupReturnType (*gslDestructor)(cleanupArgType*); - - GDLGuard() {} - - public: - GDLGuard( void (*d)(GSLType*)): gslObject( NULL), gslDestructor(d) {} -- GDLGuard( GSLType* o, cleanupReturnType (*d)(GSLType*)): gslObject( o), gslDestructor(d) {} -+ GDLGuard( GSLType* o, cleanupReturnType (*d)(cleanupArgType*)): gslObject( o), gslDestructor(d) {} - ~GDLGuard() - { -- (*gslDestructor)( gslObject); -+ (*gslDestructor)( (cleanupArgType*)gslObject); - } -- void Set( GSLType* o) -+ void Init( GSLType* o) - { - assert( gslObject == NULL); - gslObject = o; -@@ -851,4 +542,74 @@ - // } - // }; - -+ -+class FreeListT -+{ -+ typedef void* PType; -+ PType* freeList; -+ SizeT sz; -+ SizeT endIx; -+ -+public: -+ FreeListT(): freeList(NULL), sz(0), endIx(0) {} -+ -+ SizeT size() const { return endIx;} -+ void resize( SizeT s) { endIx = s;} -+ PType pop_back() { assert(endIx > 0); return freeList[endIx--];} -+// PType back() const { assert(endIx > 0); assert( freeList != NULL); return freeList[endIx];} -+ void push_back( PType p) { assert( endIx < (sz-1)); assert( freeList != NULL); freeList[++endIx] = p;} -+ -+ char* Init( SizeT s, char* res, SizeT sizeOfType) -+ { -+ endIx = s; -+ -+ //freeList[0] = res; // the ptr to free (not implemented) -+ for( size_t i=1; i<=endIx; ++i) -+ { -+ freeList[ i] = res; -+ res += sizeOfType; -+ } -+ return res; -+ } -+// PType& operator[]( SizeT i) -+// { -+// return freeList[ i]; -+// } -+// PType operator[]( SizeT i) const -+// { -+// return freeList[ i+1]; -+// } -+ -+ void reserve( SizeT s) -+ { -+ assert( endIx == 0); -+ -+ // alloc one more -+ if( ++s == sz) -+ return; -+ -+ free( freeList); -+ freeList = (PType*) malloc( s * sizeof(PType)); -+ if( freeList == NULL) // error -+ { -+ freeList = (PType*) malloc( sz * sizeof(PType)); -+ if( freeList == NULL) -+ { -+ std::cerr << "% Error allocating free list. Probably already too late. Sorry.\n" -+ "Try to save what to save and immediately exit GDL session."< FreeListT; -+ - #endif -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/typetraits.cpp gdl/src/typetraits.cpp ---- gdl-0.9.3/src/typetraits.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/typetraits.cpp 2013-03-21 14:04:04.000000000 -0600 -@@ -26,10 +26,6 @@ - const DType SpDByte::t=GDL_BYTE; // type ID - const string SpDByte::str("BYTE"); // type string - const DByte SpDByte::zero=0; --const bool SpDByte::IS_INTEGER=true; --const bool SpDByte::IS_SIGNED=false; --const bool SpDByte::IS_NUMERIC=true; --const bool SpDByte::IS_COMPLEX=false; - BaseGDL* SpDByte::GetTag() const { return new SpDByte(*this);} - DType SpDByte::Type() const { return t;} - const std::string& SpDByte::TypeStr() const { return str;} -@@ -37,10 +33,6 @@ - const DType SpDInt::t=GDL_INT; // type ID - const string SpDInt::str("INT"); // type string - const DInt SpDInt::zero=0; --const bool SpDInt::IS_INTEGER=true; --const bool SpDInt::IS_SIGNED=true; --const bool SpDInt::IS_NUMERIC=true; --const bool SpDInt::IS_COMPLEX=false; - BaseGDL* SpDInt::GetTag() const { return new SpDInt(*this);} - DType SpDInt::Type() const { return t;} - const std::string& SpDInt::TypeStr() const { return str;} -@@ -48,10 +40,6 @@ - const DType SpDUInt::t=GDL_UINT; // type ID - const string SpDUInt::str("UINT"); // type string - const DUInt SpDUInt::zero=0; --const bool SpDUInt::IS_INTEGER=true; --const bool SpDUInt::IS_SIGNED=false; --const bool SpDUInt::IS_NUMERIC=true; --const bool SpDUInt::IS_COMPLEX=false; - BaseGDL* SpDUInt::GetTag() const { return new SpDUInt(*this);} - DType SpDUInt::Type() const { return t;} - const std::string& SpDUInt::TypeStr() const { return str;} -@@ -60,10 +48,6 @@ - const DType SpDLong::t=GDL_LONG; // type ID - const string SpDLong::str("LONG"); // type string - const DLong SpDLong::zero=0; --const bool SpDLong::IS_INTEGER=true; --const bool SpDLong::IS_SIGNED=true; --const bool SpDLong::IS_NUMERIC=true; --const bool SpDLong::IS_COMPLEX=false; - BaseGDL* SpDLong::GetTag() const { return new SpDLong(*this);} - DType SpDLong::Type() const { return t;} - const std::string& SpDLong::TypeStr() const { return str;} -@@ -71,10 +55,6 @@ - const DType SpDULong::t=GDL_ULONG; // type ID - const string SpDULong::str("ULONG"); // type string - const DULong SpDULong::zero=0; --const bool SpDULong::IS_INTEGER=true; --const bool SpDULong::IS_SIGNED=false; --const bool SpDULong::IS_NUMERIC=true; --const bool SpDULong::IS_COMPLEX=false; - BaseGDL* SpDULong::GetTag() const { return new SpDULong(*this);} - DType SpDULong::Type() const { return t;} - const std::string& SpDULong::TypeStr() const { return str;} -@@ -82,10 +62,6 @@ - const DType SpDLong64::t=GDL_LONG64; // type ID - const string SpDLong64::str("LONG64"); // type string - const DLong64 SpDLong64::zero=0; --const bool SpDLong64::IS_INTEGER=true; --const bool SpDLong64::IS_SIGNED=true; --const bool SpDLong64::IS_NUMERIC=true; --const bool SpDLong64::IS_COMPLEX=false; - BaseGDL* SpDLong64::GetTag() const { return new SpDLong64(*this);} - DType SpDLong64::Type() const { return t;} - const std::string& SpDLong64::TypeStr() const { return str;} -@@ -93,10 +69,6 @@ - const DType SpDULong64::t=GDL_ULONG64; // type ID - const string SpDULong64::str("ULONG64"); // type string - const DULong64 SpDULong64::zero=0; --const bool SpDULong64::IS_INTEGER=true; --const bool SpDULong64::IS_SIGNED=false; --const bool SpDULong64::IS_NUMERIC=true; --const bool SpDULong64::IS_COMPLEX=false; - BaseGDL* SpDULong64::GetTag() const { return new SpDULong64(*this);} - DType SpDULong64::Type() const { return t;} - const std::string& SpDULong64::TypeStr() const { return str;} -@@ -104,10 +76,6 @@ - const DType SpDFloat::t=GDL_FLOAT; // type ID - const string SpDFloat::str("FLOAT"); // type string - const DFloat SpDFloat::zero=0.0; --const bool SpDFloat::IS_INTEGER=false; --const bool SpDFloat::IS_SIGNED=true; --const bool SpDFloat::IS_NUMERIC=true; --const bool SpDFloat::IS_COMPLEX=false; - BaseGDL* SpDFloat::GetTag() const { return new SpDFloat(*this);} - DType SpDFloat::Type() const { return t;} - const std::string& SpDFloat::TypeStr() const { return str;} -@@ -115,10 +83,6 @@ - const DType SpDDouble::t=GDL_DOUBLE; // type ID - const string SpDDouble::str("DOUBLE"); // type string - const DDouble SpDDouble::zero=0.0; --const bool SpDDouble::IS_INTEGER=false; --const bool SpDDouble::IS_SIGNED=true; --const bool SpDDouble::IS_NUMERIC=true; --const bool SpDDouble::IS_COMPLEX=false; - BaseGDL* SpDDouble::GetTag() const { return new SpDDouble(*this);} - DType SpDDouble::Type() const { return t;} - const std::string& SpDDouble::TypeStr() const { return str;} -@@ -126,10 +90,6 @@ - const DType SpDString::t=GDL_STRING; // type ID - const string SpDString::str("STRING"); // type string - const DString SpDString::zero(""); // zero string --const bool SpDString::IS_INTEGER=false; --const bool SpDString::IS_SIGNED=false; --const bool SpDString::IS_NUMERIC=false; --const bool SpDString::IS_COMPLEX=false; - BaseGDL* SpDString::GetTag() const { return new SpDString(*this);} - DType SpDString::Type() const { return t;} - const std::string& SpDString::TypeStr() const { return str;} -@@ -137,10 +97,6 @@ - const DType SpDStruct::t=GDL_STRUCT; // type ID - const string SpDStruct::str("STRUCT"); // type string - const SpDStruct::Ty SpDStruct::zero=0; // zero struct, special meaning --const bool SpDStruct::IS_INTEGER=false; --const bool SpDStruct::IS_SIGNED=false; --const bool SpDStruct::IS_NUMERIC=false; --const bool SpDStruct::IS_COMPLEX=false; - BaseGDL* SpDStruct::GetTag() const - { - SpDStruct* newTag = new SpDStruct(*this); -@@ -153,10 +109,6 @@ - const DType SpDPtr::t=GDL_PTR; // type ID - const string SpDPtr::str("POINTER"); // type string - const DPtr SpDPtr::zero=0; // zero ptr --const bool SpDPtr::IS_INTEGER=false; --const bool SpDPtr::IS_SIGNED=false; --const bool SpDPtr::IS_NUMERIC=false; --const bool SpDPtr::IS_COMPLEX=false; - BaseGDL* SpDPtr::GetTag() const { return new SpDPtr(*this);} - DType SpDPtr::Type() const { return t;} - const std::string& SpDPtr::TypeStr() const { return str;} -@@ -164,10 +116,6 @@ - const DType SpDObj::t=GDL_OBJ; // type ID - const string SpDObj::str("OBJREF"); // type string - const DObj SpDObj::zero=0; // zero ptr/obj --const bool SpDObj::IS_INTEGER=false; --const bool SpDObj::IS_SIGNED=false; --const bool SpDObj::IS_NUMERIC=false; --const bool SpDObj::IS_COMPLEX=false; - BaseGDL* SpDObj::GetTag() const { return new SpDObj(*this);} - DType SpDObj::Type() const { return t;} - const std::string& SpDObj::TypeStr() const { return str;} -@@ -175,10 +123,6 @@ - const DType SpDComplex::t=GDL_COMPLEX; // type ID - const string SpDComplex::str("COMPLEX"); // type string - const DComplex SpDComplex::zero(0.0,0.0); --const bool SpDComplex::IS_INTEGER=false; --const bool SpDComplex::IS_SIGNED=true; --const bool SpDComplex::IS_NUMERIC=true; --const bool SpDComplex::IS_COMPLEX=true; - BaseGDL* SpDComplex::GetTag() const { return new SpDComplex(*this);} - DType SpDComplex::Type() const { return t;} - const std::string& SpDComplex::TypeStr() const { return str;} -@@ -186,10 +130,6 @@ - const DType SpDComplexDbl::t=GDL_COMPLEXDBL; // type ID - const string SpDComplexDbl::str("DCOMPLEX"); // type string - const DComplexDbl SpDComplexDbl::zero(0.0,0.0); --const bool SpDComplexDbl::IS_INTEGER=false; --const bool SpDComplexDbl::IS_SIGNED=true; --const bool SpDComplexDbl::IS_NUMERIC=true; --const bool SpDComplexDbl::IS_COMPLEX=true; - BaseGDL* SpDComplexDbl::GetTag() const { return new SpDComplexDbl(*this);} - DType SpDComplexDbl::Type() const { return t;} - const std::string& SpDComplexDbl::TypeStr() const { return str;} -@@ -317,3 +257,89 @@ - SpDComplexDbl::SpDComplexDbl( const dimension& dim_): BaseGDL(dim_) {} - SpDComplexDbl::~SpDComplexDbl() {} - -+ -+ -+ -+/* -+ -+const bool SpDByte::IS_INTEGER=true; -+const bool SpDByte::IS_SIGNED=false; -+const bool SpDByte::IS_NUMERIC=true; -+const bool SpDByte::IS_COMPLEX=false; -+const bool SpDByte::IS_POD=true; -+const bool SpDByte::IS_CONVERTABLE=true; -+ -+const bool SpDInt::IS_INTEGER=true; -+const bool SpDInt::IS_SIGNED=true; -+const bool SpDInt::IS_NUMERIC=true; -+const bool SpDInt::IS_COMPLEX=false; -+const bool SpDInt::IS_POD=true; -+const bool SpDInt::IS_CONVERTABLE=true; -+ -+const bool SpDUInt::IS_INTEGER=true; -+const bool SpDUInt::IS_SIGNED=false; -+const bool SpDUInt::IS_NUMERIC=true; -+const bool SpDUInt::IS_COMPLEX=false; -+ -+const bool SpDLong::IS_INTEGER=true; -+const bool SpDLong::IS_SIGNED=true; -+const bool SpDLong::IS_NUMERIC=true; -+const bool SpDLong::IS_COMPLEX=false; -+ -+const bool SpDULong::IS_INTEGER=true; -+const bool SpDULong::IS_SIGNED=false; -+const bool SpDULong::IS_NUMERIC=true; -+const bool SpDULong::IS_COMPLEX=false; -+ -+const bool SpDLong64::IS_INTEGER=true; -+const bool SpDLong64::IS_SIGNED=true; -+const bool SpDLong64::IS_NUMERIC=true; -+const bool SpDLong64::IS_COMPLEX=false; -+ -+const bool SpDFloat::IS_INTEGER=false; -+const bool SpDFloat::IS_SIGNED=true; -+const bool SpDFloat::IS_NUMERIC=true; -+const bool SpDFloat::IS_COMPLEX=false; -+ -+const bool SpDULong64::IS_INTEGER=true; -+const bool SpDULong64::IS_SIGNED=false; -+const bool SpDULong64::IS_NUMERIC=true; -+const bool SpDULong64::IS_COMPLEX=false; -+ -+const bool SpDDouble::IS_INTEGER=false; -+const bool SpDDouble::IS_SIGNED=true; -+const bool SpDDouble::IS_NUMERIC=true; -+const bool SpDDouble::IS_COMPLEX=false; -+ -+const bool SpDString::IS_INTEGER=false; -+const bool SpDString::IS_SIGNED=false; -+const bool SpDString::IS_NUMERIC=false; -+const bool SpDString::IS_COMPLEX=false; -+ -+const bool SpDStruct::IS_INTEGER=false; -+const bool SpDStruct::IS_SIGNED=false; -+const bool SpDStruct::IS_NUMERIC=false; -+const bool SpDStruct::IS_COMPLEX=false; -+ -+const bool SpDPtr::IS_INTEGER=false; -+const bool SpDPtr::IS_SIGNED=false; -+const bool SpDPtr::IS_NUMERIC=false; -+const bool SpDPtr::IS_COMPLEX=false; -+ -+const bool SpDObj::IS_INTEGER=false; -+const bool SpDObj::IS_SIGNED=false; -+const bool SpDObj::IS_NUMERIC=false; -+const bool SpDObj::IS_COMPLEX=false; -+ -+const bool SpDComplex::IS_INTEGER=false; -+const bool SpDComplex::IS_SIGNED=true; -+const bool SpDComplex::IS_NUMERIC=true; -+const bool SpDComplex::IS_COMPLEX=true; -+ -+const bool SpDComplexDbl::IS_INTEGER=false; -+const bool SpDComplexDbl::IS_SIGNED=true; -+const bool SpDComplexDbl::IS_NUMERIC=true; -+const bool SpDComplexDbl::IS_COMPLEX=true; -+ -+ -+*/ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/typetraits.hpp gdl/src/typetraits.hpp ---- gdl-0.9.3/src/typetraits.hpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/typetraits.hpp 2013-03-25 10:36:38.000000000 -0600 -@@ -25,6 +25,7 @@ - - #include "basegdl.hpp" - #include "dstructdesc.hpp" -+#include "gdlarray.hpp" - - // define type parameterization here - struct SpDByte: public BaseGDL -@@ -36,9 +37,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DByte Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -48,11 +46,32 @@ - static const std::string str; - static const DByte zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = true; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DByte Ty; -+ typedef GDLArray DataT; - -+ template -+ struct IfInteger { typedef ReturnType type; }; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - DType Type() const; - const std::string& TypeStr() const; - -@@ -68,9 +87,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DInt Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -80,11 +96,32 @@ - static const std::string str; - static const DInt zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = true; -+ static const bool IS_SIGNED = true; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; - -+ typedef DInt Ty; -+ typedef GDLArray DataT; -+ -+ template -+ struct IfInteger { typedef ReturnType type; }; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - DType Type() const; - const std::string& TypeStr() const; - -@@ -100,9 +137,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DUInt Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -112,10 +146,32 @@ - static const std::string str; - static const DUInt zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = true; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DUInt Ty; -+ typedef GDLArray DataT; -+ -+ template -+ struct IfInteger { typedef ReturnType type; }; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - - DType Type() const; - const std::string& TypeStr() const; -@@ -132,9 +188,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DLong Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -144,10 +197,32 @@ - static const std::string str; - static const DLong zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = true; -+ static const bool IS_SIGNED = true; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DLong Ty; -+ typedef GDLArray DataT; -+ -+ template -+ struct IfInteger { typedef ReturnType type; }; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - - DType Type() const; - const std::string& TypeStr() const; -@@ -164,9 +239,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DULong Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -176,10 +248,32 @@ - static const std::string str; - static const DULong zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = true; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DULong Ty; -+ typedef GDLArray DataT; -+ -+ template -+ struct IfInteger { typedef ReturnType type; }; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - - DType Type() const; - const std::string& TypeStr() const; -@@ -196,9 +290,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DLong64 Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -208,10 +299,32 @@ - static const std::string str; - static const DLong64 zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = true; -+ static const bool IS_SIGNED = true; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DLong64 Ty; -+ typedef GDLArray DataT; -+ -+ template -+ struct IfInteger { typedef ReturnType type; }; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - - DType Type() const; - const std::string& TypeStr() const; -@@ -228,9 +341,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DULong64 Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -240,10 +350,32 @@ - static const std::string str; - static const DULong64 zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = true; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DULong64 Ty; -+ typedef GDLArray DataT; -+ -+ template -+ struct IfInteger { typedef ReturnType type; }; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - - DType Type() const; - const std::string& TypeStr() const; -@@ -260,9 +392,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DFloat Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -272,11 +401,32 @@ - static const std::string str; - static const DFloat zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = false; -+ static const bool IS_SIGNED = true; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = true; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DFloat Ty; -+ typedef GDLArray DataT; - -+ template -+ struct IfInteger {}; -+ template -+ struct IfFloat { typedef ReturnType type; }; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; -+ - DType Type() const; - const std::string& TypeStr() const; - -@@ -292,9 +442,6 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DDouble Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); -@@ -304,10 +451,32 @@ - static const std::string str; - static const DDouble zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ -+ static const bool IS_INTEGER = false; -+ static const bool IS_SIGNED = true; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = true; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = true; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DDouble Ty; -+ typedef GDLArray DataT; -+ -+ template -+ struct IfInteger {}; -+ template -+ struct IfFloat { typedef ReturnType type; }; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther {}; - - DType Type() const; - const std::string& TypeStr() const; -@@ -324,22 +493,40 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DString Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); - } - -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = false; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = false; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = false; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DString Ty; -+ typedef GDLArray DataT; -+ - static const DType t; - static const std::string str; - static const Ty zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -+ template -+ struct IfInteger {}; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther { typedef ReturnType type; }; - - DType Type() const; - const std::string& TypeStr() const; -@@ -378,23 +565,33 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef char Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return ( this->N_Elements() * desc->NBytes()); - } - -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ -+ static const bool IS_INTEGER = false; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = false; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = false; -+ static const bool IS_CONVERTABLE = false; -+ -+ typedef char Ty; -+ typedef GDLArray DataT; // we are using char here -+ - static const DType t; - static const std::string str; - static const Ty zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -- - DType Type() const; - const std::string& TypeStr() const; - -@@ -411,23 +608,41 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DPtr Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); - } - -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = false; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = false; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = false; // due to ref counting -+ static const bool IS_CONVERTABLE = false; -+ -+ typedef DPtr Ty; -+ typedef GDLArray DataT; // on this level, DPtr is POD -+ -+ template -+ struct IfInteger {}; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther { typedef ReturnType type; }; -+ - static const DType t; - static const std::string str; - static const Ty zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -- - DType Type() const; - const std::string& TypeStr() const; - -@@ -444,23 +659,41 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DObj Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); - } - -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ static const bool IS_INTEGER = false; -+ static const bool IS_SIGNED = false; -+ static const bool IS_NUMERIC = false; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = false; -+ static const bool IS_POD = false; // due to ref counting -+ static const bool IS_CONVERTABLE = false; -+ -+ typedef DObj Ty; -+ typedef GDLArray DataT; // on this level, DObj is POD -+ -+ template -+ struct IfInteger {}; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex {}; -+ template -+ struct IfOther { typedef ReturnType type; }; -+ - static const DType t; - static const std::string str; - static const Ty zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -- - DType Type() const; - const std::string& TypeStr() const; - -@@ -476,23 +709,42 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DComplex Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); - } - -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ -+ static const bool IS_INTEGER = false; -+ static const bool IS_SIGNED = true; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = true; -+ static const bool IS_POD = false; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DComplex Ty; -+ typedef GDLArray DataT; // ATTENTION: srictly complex is non-pod -+ -+ template -+ struct IfInteger {}; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex { typedef ReturnType type; }; -+ template -+ struct IfOther {}; -+ - static const DType t; - static const std::string str; - static const DComplex zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -- - DType Type() const; - const std::string& TypeStr() const; - -@@ -508,23 +760,42 @@ - BaseGDL* GetInstance() const; - BaseGDL* GetEmptyInstance() const; - -- typedef DComplexDbl Ty; -- typedef GDLArray DataT; -- - SizeT NBytes() const - { - return (this->N_Elements() * sizeof( Ty)); - } - -+// static const bool IS_INTEGER; -+// static const bool IS_SIGNED; -+// static const bool IS_NUMERIC; -+// static const bool IS_COMPLEX; -+// static const bool IS_POD; -+// static const bool IS_CONVERTABLE; -+ -+ static const bool IS_SIGNED = true; -+ static const bool IS_NUMERIC = true; -+ static const bool IS_INTEGER = false; -+ static const bool IS_FLOAT = false; -+ static const bool IS_COMPLEX = true; -+ static const bool IS_POD = false; -+ static const bool IS_CONVERTABLE = true; -+ -+ typedef DComplexDbl Ty; -+ typedef GDLArray DataT; // ATTENTION: srictly complex is non-pod -+ -+ template -+ struct IfInteger {}; -+ template -+ struct IfFloat {}; -+ template -+ struct IfComplex { typedef ReturnType type; }; -+ template -+ struct IfOther {}; -+ - static const DType t; - static const std::string str; - static const DComplexDbl zero; - -- static const bool IS_INTEGER; -- static const bool IS_SIGNED; -- static const bool IS_NUMERIC; -- static const bool IS_COMPLEX; -- - DType Type() const; - const std::string& TypeStr() const; - -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/src/widget.cpp gdl/src/widget.cpp ---- gdl-0.9.3/src/widget.cpp 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/src/widget.cpp 2013-03-25 10:36:38.000000000 -0600 -@@ -45,7 +45,7 @@ - treeParser.interactive(theAST); - trAST = treeParser.getAST(); - ProgNodeP progAST = ProgNode::NewProgNode( trAST); -- auto_ptr< ProgNode> progAST_guard( progAST); -+ Guard< ProgNode> progAST_guard( progAST); - - // necessary for correct FOR loop handling - assert( dynamic_cast(caller) != NULL); -@@ -822,7 +822,7 @@ - trAST = treeParser.getAST(); - - ProgNodeP progAST = ProgNode::NewProgNode( trAST); -- auto_ptr< ProgNode> progAST_guard( progAST); -+ Guard< ProgNode> progAST_guard( progAST); - - // necessary for correct FOR loop handling - assert( dynamic_cast(caller) != NULL); -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/templates/cpp gdl/templates/cpp ---- gdl-0.9.3/templates/cpp 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/templates/cpp 2004-12-09 08:10:21.000000000 -0700 -@@ -0,0 +1,16 @@ -+/*************************************************************************** -+ $FILENAME$ - description -+ ------------------- -+ begin : $DATE$ -+ copyright : (C) $YEAR$ by $AUTHOR$ -+ email : $EMAIL$ -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/templates/h gdl/templates/h ---- gdl-0.9.3/templates/h 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/templates/h 2004-12-09 08:10:21.000000000 -0700 -@@ -0,0 +1,16 @@ -+/*************************************************************************** -+ $FILENAME$ - description -+ ------------------- -+ begin : $DATE$ -+ copyright : (C) $YEAR$ by $AUTHOR$ -+ email : $EMAIL$ -+ ***************************************************************************/ -+ -+/*************************************************************************** -+ * * -+ * This program is free software; you can redistribute it and/or modify * -+ * it under the terms of the GNU General Public License as published by * -+ * the Free Software Foundation; either version 2 of the License, or * -+ * (at your option) any later version. * -+ * * -+ ***************************************************************************/ -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/testsuite/benchmark/bench_matrix_multiply.pro gdl/testsuite/benchmark/bench_matrix_multiply.pro ---- gdl-0.9.3/testsuite/benchmark/bench_matrix_multiply.pro 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/testsuite/benchmark/bench_matrix_multiply.pro 2013-05-16 12:36:33.000000000 -0600 -@@ -0,0 +1,125 @@ -+; -+; AC 25 February 2013 -+; -+; First computation is using "#" operator. -+; the 4 computations after are using MATRIX_MULTIPLY() function, -+; eventualy calling Eigen3 code (a message will be issued if not) -+; -+pro BENCH_MATRIX_MULTIPLY, n1, n2, n3, $ -+ small=small, medium=medium, double=double, $ -+ complex=complex, dblecomplex=dblecomplex, $ -+ output_type=output_type, help=help, test=test -+; -+if KEYWORD_SET(help) then begin -+ print, 'pro BENCH_MATRIX_MULTPLY, n1, n2, n3, ' -+ print, ' small=small, medium=medium, double=double, $' -+ print, ' complex=complex, dblecomplex=dblecomplex, $' -+ print, ' output_type=output_type, help=help, test=test' -+ return -+endif -+; -+; Note by AC 28 March 2013 -+; obsoleting code, we don't remove if we have to go back to test -+; related to Eigen3 internal use ... -+; -+;DEFSYSV, '!gdl', exist=it_is_GDL -+; -+; if (it_is_GDL) then begin -+; having_eigen3=EXECUTE("type=MATMUL(/available, quiet=quiet)") -+; if (having_eigen3 EQ 0) then begin -+; print, 'You are trying testing new capabilities (Eigen3 usage)' -+; print, 'on a too OLD GDL version ! Please make tests on CVS version !' -+; return -+; endif -+; endif -+; -+if N_PARAMS() EQ 0 then begin -+ colA=1000 -+ rowA=3000 -+ rowB=751 -+endif -+; -+if N_PARAMS() EQ 1 then begin -+ colA=n1 -+ rowA=n1 -+ rowB=n1 -+endif -+; -+if N_PARAMS() EQ 2 then begin -+ colA=n1 -+ rowA=n2 -+ rowB=n2 -+endif -+if N_PARAMS() EQ 3 then begin -+ colA=n1 -+ rowA=n2 -+ rowB=n3 -+endif -+; -+if KEYWORD_SET(medium) then begin -+ colA=colA/2 -+ rowA=rowA/2 -+ rowB=rowB/2 -+endif -+; -+if KEYWORD_SET(small) then begin -+ colA=colA/4 -+ rowA=rowA/4 -+ rowB=rowB/4 -+endif -+; -+colB=rowA -+; -+known_type=0 -+if KEYWORD_SET(dblecomplex) then begin -+ a=DCOMPLEXARR(colA ,rowA) -+ b=DCOMPLEXARR(colB ,rowB) -+ known_type=1 -+endif -+if KEYWORD_SET(complex) then begin -+ a=COMPLEXARR(colA ,rowA) -+ b=COMPLEXARR(colB ,rowB) -+ known_type=1 -+endif -+if KEYWORD_SET(double) then begin -+ a=RANDOMU(seed, colA, rowA, /DOUBLE) -+ b=RANDOMU(seed, colB, rowB, /DOUBLE) -+ known_type=1 -+endif -+if (known_type EQ 0) then begin -+ a=RANDOMU(seed, colA, rowA) -+ b=RANDOMU(seed, colB, rowB) -+endif -+; -+b_t=TRANSPOSE(b) -+a_t=TRANSPOSE(a) -+; -+HELP, a, b -+; -+txt='Matrix size are : [' +STRING(colA)+','+STRING(rowA) -+txt=txt+'] # ['+STRING(colB)+','+STRING(rowB)+']' -+print, STRCOMPRESS(txt) -+; -+txt_ref='Classic operator #, ' -+txt= 'Matrix_Multiply() , ' -+; -+t0=SYSTIME(1) & z=a # b & print, txt_ref+'a#b :', SYSTIME(1)-t0 -+t0=SYSTIME(1) & z=MATRIX_MULTIPLY(a,b) & print, txt+'a#b :', SYSTIME(1)-t0 -+t0=SYSTIME(1) & z=MATRIX_MULTIPLY(a_t,b,/at) & print, txt+'aT#b :', SYSTIME(1)-t0 -+t0=SYSTIME(1) & z=MATRIX_MULTIPLY(a,b_t,/bt) & print, txt+'a#bT :', SYSTIME(1)-t0 -+t0=SYSTIME(1) & z=MATRIX_MULTIPLY(a_t,b_t,/at,/bt) & print, txt+'aT#bT:', SYSTIME(1)-t0 -+; -+if KEYWORD_SET(test) then STOP -+; -+end -+; -+; ------------------------------ -+; -+pro BENCH_MATRIX_MULTIPLY_ALL, small=small -+; -+BENCH_MATRIX_MULTIPLY -+BENCH_MATRIX_MULTIPLY, /double -+BENCH_MATRIX_MULTIPLY, /complex -+BENCH_MATRIX_MULTIPLY, /dblecomplex -+; -+end -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/testsuite/CMakeLists.txt gdl/testsuite/CMakeLists.txt ---- gdl-0.9.3/testsuite/CMakeLists.txt 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/testsuite/CMakeLists.txt 2013-07-31 09:41:44.406244070 -0600 -@@ -4,6 +4,12 @@ - set(LAUNCH - "#include - #include -+#include -+#include -+#include -+#include -+#include -+#include - int main(int c,char**v) { - char*p; - if(c!=2) return 1; -@@ -13,7 +19,28 @@ - *(p-4)=0; - setenv(\"LC_COLLATE\",\"C\",1); - setenv(\"GDL_PATH\",\"+${BASE_SOURCE}/testsuite/:+${BASE_SOURCE}/src/pro/\",1); --execl(\"${BASE_BINARY}/src/gdl\",\"-quiet\",\"-e\",v[1],(char*)0); -+unsetenv(\"GDL_STARTUP\"); -+unsetenv(\"IDL_STARTUP\"); -+int devnull = open(\"/dev/null\",O_RDONLY); -+dup2(devnull, 0); -+int child_pid = fork(); -+if(child_pid == 0) { -+ execl(\"${BASE_BINARY}/src/gdl\",\"-quiet\",\"-e\",v[1],(char*)0); -+ exit(1); -+} else { -+ sched_yield(); -+ int child_status; -+ waitpid(child_pid, &child_status, 0); -+ if (WEXITSTATUS(child_status) == 77) { -+ printf(\"TEST SKIPPED\"); -+ exit(0); -+ } else if (WIFSIGNALED(child_status)) { -+ printf(\"TEST EXITED FROM SIGNAL %d\", WTERMSIG(child_status)); -+ exit(1); -+ } else { -+ exit(WEXITSTATUS(child_status)); -+ } -+} - } - ") - file(WRITE ${CMAKE_SOURCE_DIR}/testsuite/launchtest.c "${LAUNCH}") -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/testsuite/.#CMakeLists.txt.1.7 gdl/testsuite/.#CMakeLists.txt.1.7 ---- gdl-0.9.3/testsuite/.#CMakeLists.txt.1.7 1969-12-31 17:00:00.000000000 -0700 -+++ gdl/testsuite/.#CMakeLists.txt.1.7 2013-07-08 13:46:24.000000000 -0600 -@@ -0,0 +1,57 @@ -+set(BASE_SOURCE ${CMAKE_SOURCE_DIR}) -+set(BASE_BINARY ${CMAKE_BINARY_DIR}) -+# write the test launcher -+set(LAUNCH -+"#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+int main(int c,char**v) { -+char*p; -+if(c!=2) return 1; -+for(p=v[1];*p;++p); -+if(p-4> values !' -+ nb_errors=nb_errors+1 -+endif -+; -+res1=EXECUTE('HELP, structarray[www].value') -+if (res1 NE 1) then begin -+ message,/continue, ' unexpected badly interpreted Struct indexing ! (case 1)' -+ nb_errors=nb_errors+1 -+endif -+; -+tab=0. -+res2=EXECUTE('tab=structarray[www].value') -+if (res2 NE 1) then begin -+ message,/continue, ' unexpected badly interpreted Struct indexing ! (case 2)' -+ nb_errors=nb_errors+1 -+endif -+; -+if (ARRAY_EQUAL(tab, 1.*[7,8,9]) NE 1) then begin -+ message,/continue, '(2) unexpected results in extracted values !' -+ nb_errors=nb_errors+1 -+endif -+; -+if (nb_errors GT 0) then begin -+ MESSAGE, STRING(nb_errors)+' Errors found', /continue -+endif else begin -+ MESSAGE, ' No Errors found', /continue -+endelse -+; -+if KEYWORD_SET(test) then STOP -+; -+if (nb_errors GT 0) AND ~KEYWORD_SET(no_exit) then EXIT, status=1 -+; -+end -Only in gdl-0.9.3/testsuite: testsuite -diff -ru --unidirectional-new-file --exclude CVS gdl-0.9.3/testsuite/test_suite.pro gdl/testsuite/test_suite.pro ---- gdl-0.9.3/testsuite/test_suite.pro 2012-12-27 09:22:44.000000000 -0700 -+++ gdl/testsuite/test_suite.pro 2013-05-16 12:36:33.000000000 -0600 -@@ -538,8 +538,21 @@ - a = {a0, var1: 0, var2: 0.0d0} - b = {a0, '0L', ' 1.0'} - -- print,'STRUCT: OK' -+; bug tracker ID: 3612104 -+ a=ptrarr(1) -+ a(0)=ptr_new('a') -+ s={a:a} -+ ss={sst:s} -+ if *s.a(0) ne 'a' then begin -+ message, '***STRUCT: ERROR12', /conti -+ exit, status=1 -+ endif -+ if *ss.sst.a(0) ne 'a' then begin -+ message, '***STRUCT: ERROR13', /conti -+ exit, status=1 -+ endif - -+ print,'STRUCT: OK' - end - - pro multi,a,b,c -Only in gdl-0.9.3/testsuite: test_suite.pro.~1.16.~ diff --git a/gdl-python.patch b/gdl-python.patch new file mode 100644 index 0000000..709f8c1 --- /dev/null +++ b/gdl-python.patch @@ -0,0 +1,12 @@ +diff -up gdl-0.9.4/src/pythongdl.cpp.python gdl-0.9.4/src/pythongdl.cpp +--- gdl-0.9.4/src/pythongdl.cpp.python 2013-07-26 03:30:32.000000000 -0600 ++++ gdl-0.9.4/src/pythongdl.cpp 2013-09-30 10:24:27.092666180 -0600 +@@ -373,7 +373,7 @@ PyObject *GDLSub( PyObject *self, PyObje + if( libCall) + e = new EnvT( NULL, sub); + else +- e = new EnvUDT( NULL, sub); ++ e = new EnvUDT( NULL, static_cast(sub)); + + Guard< EnvBaseT> e_guard( e); + diff --git a/gdl.spec b/gdl.spec index 7c548ab..a3af7b2 100644 --- a/gdl.spec +++ b/gdl.spec @@ -1,8 +1,8 @@ %{!?python_sitearch: %global python_sitearch %(%{__python} -c "from distutils.sysconfig import get_python_lib; print get_python_lib(1)")} Name: gdl -Version: 0.9.3 -Release: 10.cvs20130731%{?dist} +Version: 0.9.4 +Release: 1%{?dist} Summary: GNU Data Language Group: Applications/Engineering @@ -12,7 +12,6 @@ Source0: http://downloads.sourceforge.net/gnudatalanguage/%{name}-%{versi Source1: gdl.csh Source2: gdl.sh Source3: makecvstarball -Patch0: gdl-cvs.patch # Build with system antlr library. Request for upstream change here: # https://sourceforge.net/tracker/index.php?func=detail&aid=2685215&group_id=97659&atid=618686 Patch1: gdl-antlr-auto.patch @@ -23,6 +22,9 @@ Patch3: gdl-build.patch # Patch to support plplot's new width() function # https://sourceforge.net/p/gnudatalanguage/patches/70/ Patch4: gdl-plwidth.patch +# Fix python build +# https://sourceforge.net/p/gnudatalanguage/bugs/552/ +Patch5: gdl-python.patch Patch13: gdl-0.9-antlr-cmake.patch BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) @@ -98,7 +100,6 @@ Provides: %{name}-runtime = %{version}-%{release} %prep %setup -q -n %{name}-%{version} -%patch0 -p1 -b .cvs rm -rf src/antlr %patch13 -p1 -b .antlr pushd src @@ -110,8 +111,7 @@ popd %patch2 -p1 -b .shared %patch3 -p1 -b .build %patch4 -p1 -b .plwidth -rm ltmain.sh -rm -r CMakeFiles +%patch5 -p1 -b .python %global cmake_opts \\\ -DWXWIDGETS=ON \\\ @@ -196,6 +196,11 @@ rm -rf $RPM_BUILD_ROOT %changelog +* Mon Sep 30 2013 Orion Poplawski - 0.9.4-1 +- Update to 0.9.4 +- Update build patch - drop automake components +- New python patch to fix python build + * Tue Aug 27 2013 Orion Poplawski - 0.9.3-10.cvs20130804 - Add patch to support new width() method in plplot diff --git a/sources b/sources index 2ad5818..9111d52 100644 --- a/sources +++ b/sources @@ -1 +1 @@ -f4a8f64e90dec5de1c89a2aca42d9e75 gdl-0.9.3.tar.gz +5d8d5783a387cca264fe8edb09e04f10 gdl-0.9.4.tar.gz