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.
This commit is contained in:
bubnikv 2018-05-03 21:45:43 +02:00
parent 81bfd8ce7e
commit 19977edae2
7 changed files with 104 additions and 65 deletions

View File

@ -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)

View File

@ -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 ()

View File

@ -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

View File

@ -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_

View File

@ -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

View File

@ -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 );

View File

@ -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 {
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';
}
};
is $@, "xspp_test_croak_hangs_on_strawberry: exception catched\n", 'croak from inside a C++ exception delivered';
__END__