Removed the "Broken croak" support, which was useful on broken

64bit Strawberry perl only. We don't use Strawberry perl anymore,
so this has been removed for clarity.

Added a PerlCallback wrapper to call a Perl subroutine from a C++ code.

7 files changed, 104 insertions, 65 deletions

diff --git a/CMakeLists.txt b/CMakeLists.txt
index cb3d6dfd6..e8b2a6faa 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -22,7 +22,6 @@ option(SLIC3R_STATIC 			"Compile Slic3r with static libraries (Boost, TBB, glew)
 option(SLIC3R_GUI    			"Compile Slic3r with GUI components (OpenGL, wxWidgets)" 1)
 option(SLIC3R_PRUSACONTROL		"Compile Slic3r with the PrusaControl prject file format (requires wxWidgets base library)" 1)
 option(SLIC3R_PROFILE 			"Compile Slic3r with an invasive Shiny profiler" 0)
-option(SLIC3R_HAS_BROKEN_CROAK 	"Compile Slic3r for a broken Strawberry Perl 64bit" 0)
 option(SLIC3R_MSVC_COMPILE_PARALLEL "Compile on Visual Studio in parallel" 1)
 
 if (MSVC AND SLIC3R_MSVC_COMPILE_PARALLEL)
diff --git a/xs/CMakeLists.txt b/xs/CMakeLists.txt
index 4f97c0acf..4f44fc7bf 100644
--- a/xs/CMakeLists.txt
+++ b/xs/CMakeLists.txt
@@ -475,10 +475,6 @@ if (SLIC3R_PROFILE)
     add_definitions(-DSLIC3R_PROFILE)
 endif ()
 
-if (SLIC3R_HAS_BROKEN_CROAK)
-    target_compile_definitions(XS PRIVATE -DSLIC3R_HAS_BROKEN_CROAK)
-endif ()
-
 if (CMAKE_BUILD_TYPE MATCHES DEBUG)
     target_compile_definitions(XS PRIVATE -DSLIC3R_DEBUG -DDEBUG -D_DEBUG)
 else ()
diff --git a/xs/src/libslic3r/GCode/CoolingBuffer.cpp b/xs/src/libslic3r/GCode/CoolingBuffer.cpp
index b786f9bce..a15247693 100644
--- a/xs/src/libslic3r/GCode/CoolingBuffer.cpp
+++ b/xs/src/libslic3r/GCode/CoolingBuffer.cpp
@@ -536,7 +536,7 @@ float CoolingBuffer::calculate_layer_slowdown(std::vector<PerExtruderAdjustments
         adj.time_total  = adj.elapsed_time_total();
         // Maximum time for this extruder, when all extrusion moves are slowed down to min_extrusion_speed.
         adj.time_maximum = adj.maximum_time_after_slowdown(true);
-        if (adj.cooling_slow_down_enabled) {
+        if (adj.cooling_slow_down_enabled && adj.lines.size() > 0) {
             by_slowdown_time.emplace_back(&adj);
             if (! m_cooling_logic_proportional)
                 // sorts the lines, also sets adj.time_non_adjustable
diff --git a/xs/src/libslic3r/Utils.hpp b/xs/src/libslic3r/Utils.hpp
index 0066aa5e6..e5157741e 100644
--- a/xs/src/libslic3r/Utils.hpp
+++ b/xs/src/libslic3r/Utils.hpp
@@ -84,6 +84,21 @@ inline T next_highest_power_of_2(T v)
     return ++ v;
 }
 
+class PerlCallback {
+public:
+    PerlCallback(void *sv) : m_callback(nullptr) { this->register_callback(sv); }
+    PerlCallback() : m_callback(nullptr) {}
+    ~PerlCallback() { this->deregister_callback(); }
+    void register_callback(void *sv);
+    void deregister_callback();
+    void call();
+    void call(int i);
+    void call(int i, int j);
+//    void call(const std::vector<int> &ints);
+private:
+    void *m_callback;
+};
+
 } // namespace Slic3r
 
 #endif // slic3r_Utils_hpp_
diff --git a/xs/src/libslic3r/utils.cpp b/xs/src/libslic3r/utils.cpp
index f2415ac07..2978783a6 100644
--- a/xs/src/libslic3r/utils.cpp
+++ b/xs/src/libslic3r/utils.cpp
@@ -1,3 +1,5 @@
+#include "Utils.hpp"
+
 #include <locale>
 #include <ctime>
 
@@ -135,44 +137,6 @@ const std::string& data_dir()
 
 } // namespace Slic3r
 
-#ifdef SLIC3R_HAS_BROKEN_CROAK
-
-// Some Strawberry Perl builds (mainly the latest 64bit builds) have a broken mechanism
-// for emiting Perl exception after handling a C++ exception. Perl interpreter
-// simply hangs. Better to show a message box in that case and stop the application.
-
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#ifdef WIN32
-#include <Windows.h>
-#endif
-
-void confess_at(const char *file, int line, const char *func, const char *format, ...)
-{
-    char dest[1024*8];
-    va_list argptr;
-    va_start(argptr, format);
-    vsprintf(dest, format, argptr);
-    va_end(argptr);
-
-    char filelinefunc[1024*8];
-    sprintf(filelinefunc, "\r\nin function: %s\r\nfile: %s\r\nline: %d\r\n", func, file, line);
-    strcat(dest, filelinefunc);
-    strcat(dest, "\r\n Closing the application.\r\n");
-    #ifdef WIN32
-    ::MessageBoxA(NULL, dest, "Slic3r Prusa Edition", MB_OK | MB_ICONERROR);
-    #endif
-
-    // Give up.
-    printf(dest);
-    exit(-1);
-}
-
-#else
-
 #include <xsinit.h>
 
 void
@@ -202,7 +166,88 @@ confess_at(const char *file, int line, const char *func,
     #endif
 }
 
-#endif
+void PerlCallback::register_callback(void *sv)
+{ 
+    if (! SvROK((SV*)sv) || SvTYPE(SvRV((SV*)sv)) != SVt_PVCV)
+        croak("Not a Callback %_ for PerlFunction", (SV*)sv);
+    if (m_callback)
+        SvSetSV((SV*)m_callback, (SV*)sv);
+    else
+        m_callback = newSVsv((SV*)sv);
+}
+
+void PerlCallback::deregister_callback()
+{
+	if (m_callback) {
+		sv_2mortal((SV*)m_callback);
+		m_callback = nullptr;
+	}
+}
+
+void PerlCallback::call()
+{
+    if (! m_callback)
+        return;
+    dSP;
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    PUTBACK; 
+    perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
+    FREETMPS;
+    LEAVE;
+}
+
+void PerlCallback::call(int i)
+{
+    if (! m_callback)
+        return;
+    dSP;
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    XPUSHs(sv_2mortal(newSViv(i)));
+    PUTBACK; 
+    perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
+    FREETMPS;
+    LEAVE;
+}
+
+void PerlCallback::call(int i, int j)
+{
+    if (! m_callback)
+        return;
+    dSP;
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    XPUSHs(sv_2mortal(newSViv(i)));
+    XPUSHs(sv_2mortal(newSViv(j)));
+    PUTBACK; 
+    perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
+    FREETMPS;
+    LEAVE;
+}
+
+/*
+void PerlCallback::call(const std::vector<int> &ints)
+{
+    if (! m_callback)
+        return;
+    dSP;
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    AV* av = newAV();
+    for (int i : ints)
+        av_push(av, newSViv(i));
+    XPUSHs(av);
+    PUTBACK;
+    perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
+    FREETMPS;
+    LEAVE;
+}
+*/
 
 #ifdef WIN32
     #ifndef NOMINMAX
diff --git a/xs/src/xsinit.h b/xs/src/xsinit.h
index 9cb60384f..01c1293ac 100644
--- a/xs/src/xsinit.h
+++ b/xs/src/xsinit.h
@@ -195,15 +195,6 @@ SV* to_SV(TriangleMesh* THIS);
 
 }
 
-#ifdef SLIC3R_HAS_BROKEN_CROAK
-#undef croak
-#ifdef _MSC_VER
-    #define croak(...) confess_at(__FILE__, __LINE__, __FUNCTION__, __VA_ARGS__)
-#else
-    #define croak(...) confess_at(__FILE__, __LINE__, __func__, __VA_ARGS__)
-#endif
-#endif
-
 // Defined in wxPerlIface.cpp
 // Return a pointer to the associated wxWidgets object instance given by classname.
 extern void* wxPli_sv_2_object( pTHX_ SV* scalar, const char* classname );
diff --git a/xs/t/22_exception.t b/xs/t/22_exception.t
index c7df42670..fead8ddee 100644
--- a/xs/t/22_exception.t
+++ b/xs/t/22_exception.t
@@ -6,16 +6,9 @@ use warnings;
 use Slic3r::XS;
 use Test::More tests => 1;
 
-if ($ENV{SLIC3R_HAS_BROKEN_CROAK}) 
-{
-    ok 1, 'SLIC3R_HAS_BROKEN_CROAK set, croaks and confesses from a C++ code will lead to an application exit!';
-}
-else
-{
-    eval {
-        Slic3r::xspp_test_croak_hangs_on_strawberry();
-    };
-    is $@, "xspp_test_croak_hangs_on_strawberry: exception catched\n", 'croak from inside a C++ exception delivered';
-}
+eval {
+    Slic3r::xspp_test_croak_hangs_on_strawberry();
+};
+is $@, "xspp_test_croak_hangs_on_strawberry: exception catched\n", 'croak from inside a C++ exception delivered';
 
 __END__