sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'wcon-stream-fixes' into 'develop'

Browse source 
Fix encoding issues for msvc

Closes #580, #582, and #581

See merge request embeddable-common-lisp/ecl!220
This commit is contained in:
Daniel Kochmański 2020-08-14 07:01:38 +00:00
commit 57f58eaeee
12 changed files with 180 additions and 140 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -21,6 +21,8 @@ cov-int
msvc/help.doc
msvc/*.c
msvc/*.tmp
msvc/*.bat
msvc/*.lsp
msvc/c/*.[ch]

15
src/c/alloc_2.d
View file

@ -1145,9 +1145,9 @@ static void
wrapped_finalizer(cl_object o, cl_object finalizer);
static void
deferred_finalizer(cl_object o)
deferred_finalizer(cl_object* x)
{
wrapped_finalizer(cl_first(o), cl_second(o));
wrapped_finalizer(x[0], x[1]);
}
void
@ -1155,7 +1155,7 @@ wrapped_finalizer(cl_object o, cl_object finalizer)
{
if (finalizer != ECL_NIL && finalizer != NULL) {
#ifdef ECL_THREADS
const cl_env_ptr the_env = ecl_process_env();
const cl_env_ptr the_env = ecl_process_env_unsafe();
if (!the_env
|| !the_env->own_process
|| the_env->own_process->process.phase < ECL_PROCESS_ACTIVE)
@ -1169,13 +1169,16 @@ wrapped_finalizer(cl_object o, cl_object finalizer)
* the original finalizer is no more registered to o, and if o
* is not anymore reachable it will be colleted. To prevent
* this we need to make this object reachable again after that
* roundtrip and postpone the finalization to the next garbace
* colletion. Given that this is a rare condition one way to
* roundtrip and postpone the finalization to the next garbage
* collection. Given that this is a rare condition one way to
* do that is:
*/
GC_finalization_proc ofn;
void *odata;
GC_REGISTER_FINALIZER_NO_ORDER(cl_list(2,o,finalizer),
cl_object* wrapper = GC_MALLOC(2*sizeof(cl_object));
wrapper[0] = o;
wrapper[1] = finalizer;
GC_REGISTER_FINALIZER_NO_ORDER(wrapper,
(GC_finalization_proc)deferred_finalizer, 0,
&ofn, &odata);
return;

134
src/c/file.d
View file

@ -229,22 +229,6 @@ unknown_column(cl_object strm)
return -1;
}
#if defined(ECL_WSOCK)
static cl_object
not_implemented_get_position(cl_object strm)
{
FEerror("file-position not implemented for stream ~S", 1, strm);
return ECL_NIL;
}
static cl_object
not_implemented_set_position(cl_object strm, cl_object pos)
{
FEerror("file-position not implemented for stream ~S", 1, strm);
return ECL_NIL;
}
#endif
/**********************************************************************
* CLOSED STREAM OPS
*/
@ -3968,8 +3952,8 @@ const struct ecl_file_ops winsock_stream_io_ops = {
winsock_stream_element_type,
not_a_file_stream,
not_implemented_get_position,
not_implemented_set_position,
generic_always_nil, /* get_position */
generic_set_position,
generic_column,
winsock_stream_close
@ -4002,8 +3986,8 @@ const struct ecl_file_ops winsock_stream_output_ops = {
winsock_stream_element_type,
not_a_file_stream,
not_implemented_get_position,
not_implemented_set_position,
generic_always_nil, /* get_position */
generic_set_position,
generic_column,
winsock_stream_close
@ -4036,8 +4020,8 @@ const struct ecl_file_ops winsock_stream_input_ops = {
winsock_stream_element_type,
not_a_file_stream,
not_implemented_get_position,
not_implemented_set_position,
generic_always_nil, /* get_position */
generic_set_position,
unknown_column,
winsock_stream_close
@ -4058,34 +4042,17 @@ wcon_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n)
unlikely_if (strm->stream.byte_stack != ECL_NIL) {
return consume_byte_stack(strm, c, n);
} else {
cl_index len = 0;
cl_env_ptr the_env = ecl_process_env();
HANDLE h = (HANDLE)IO_FILE_DESCRIPTOR(strm);
DWORD nchars;
unsigned char aux[4];
WCHAR waux[1];
for (len = 0; len < n; ) {
int i, ok;
ecl_disable_interrupts_env(the_env);
ok = ReadConsoleW(h, waux, 1, &nchars, NULL);
if (ok) {
nchars = WideCharToMultiByte(GetConsoleCP(), 0, waux, 1, aux, 4, NULL, NULL);
}
ecl_enable_interrupts_env(the_env);
unlikely_if (!ok) {
FEwin32_error("Cannot read from console", 0);
}
for (i = 0; i < nchars; i++) {
if (len < n) {
c[len++] = aux[i];
} else {
strm->stream.byte_stack =
ecl_nconc(strm->stream.byte_stack,
ecl_list1(ecl_make_fixnum(aux[i])));
}
}
int ok;
ecl_disable_interrupts_env(the_env);
ok = ReadConsoleA(h, c, n, &nchars, NULL);
ecl_enable_interrupts_env(the_env);
unlikely_if (!ok) {
FEwin32_error("Cannot read from console", 0);
}
return (len > 0) ? len : EOF;
return (nchars > 0) ? nchars : EOF;
}
}
@ -4094,7 +4061,7 @@ wcon_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n)
{
HANDLE h = (HANDLE)IO_FILE_DESCRIPTOR(strm);
DWORD nchars;
unlikely_if(!WriteConsole(h, c, n, &nchars, NULL)) {
unlikely_if(!WriteConsoleA(h, c, n, &nchars, NULL)) {
FEwin32_error("Cannot write to console.", 0);
}
return nchars;
@ -4158,8 +4125,8 @@ const struct ecl_file_ops wcon_stream_io_ops = {
wcon_stream_element_type,
not_a_file_stream,
not_implemented_get_position,
not_implemented_set_position,
generic_always_nil, /* get_position */
generic_set_position,
generic_column,
generic_close,
@ -4219,6 +4186,67 @@ maybe_make_windows_console_fd(cl_object fname, int desc, enum ecl_smmode smm,
}
return output;
}
cl_object
si_windows_codepage_encoding()
{
/* Mapping from windows codepages to encoding names used by ECL */
DWORD cp = GetConsoleCP();
cl_object encoding;
switch (cp) {
#ifdef ECL_UNICODE
case 437: return ecl_make_keyword("DOS-CP437");
case 708: return ecl_make_keyword("ISO-8859-6");
case 850: return ecl_make_keyword("DOS-CP850");
case 852: return ecl_make_keyword("DOS-CP852");
case 855: return ecl_make_keyword("DOS-CP855");
case 857: return ecl_make_keyword("DOS-CP857");
case 858: return ecl_make_keyword("DOS-CP858");
case 860: return ecl_make_keyword("DOS-CP860");
case 861: return ecl_make_keyword("DOS-CP861");
case 862: return ecl_make_keyword("DOS-CP862");
case 863: return ecl_make_keyword("DOS-CP863");
case 864: return ecl_make_keyword("DOS-CP864");
case 865: return ecl_make_keyword("DOS-CP865");
case 866: return ecl_make_keyword("DOS-CP866");
case 869: return ecl_make_keyword("DOS-CP869");
case 932: return ecl_make_keyword("WINDOWS-CP932");
case 936: return ecl_make_keyword("WINDOWS-CP936");
case 949: return ecl_make_keyword("WINDOWS-CP949");
case 950: return ecl_make_keyword("WINDOWS-CP950");
case 1200: return ecl_make_keyword("UCS-2LE");
case 1201: return ecl_make_keyword("UCS-2BE");
case 1250: return ecl_make_keyword("WINDOWS-CP1250");
case 1251: return ecl_make_keyword("WINDOWS-CP1251");
case 1252: return ecl_make_keyword("WINDOWS-CP1252");
case 1253: return ecl_make_keyword("WINDOWS-CP1253");
case 1254: return ecl_make_keyword("WINDOWS-CP1254");
case 1255: return ecl_make_keyword("WINDOWS-CP1255");
case 1256: return ecl_make_keyword("WINDOWS-CP1256");
case 1257: return ecl_make_keyword("WINDOWS-CP1257");
case 1258: return ecl_make_keyword("WINDOWS-CP1258");
case 12000: return ecl_make_keyword("UCS-4LE");
case 12001: return ecl_make_keyword("UCS-4BE");
case 20932: return ecl_make_keyword("JISX0212");
case 21866: return ecl_make_keyword("KOI8-U");
case 28591: return ecl_make_keyword("ISO-8859-1");
case 28592: return ecl_make_keyword("ISO-8859-2");
case 28593: return ecl_make_keyword("ISO-8859-3");
case 28594: return ecl_make_keyword("ISO-8859-4");
case 28595: return ecl_make_keyword("ISO-8859-5");
case 28596: return ecl_make_keyword("ISO-8859-6");
case 28597: return ecl_make_keyword("ISO-8859-7");
case 28598: return ecl_make_keyword("ISO-8859-8");
case 28599: return ecl_make_keyword("ISO-8859-9");
case 28603: return ecl_make_keyword("ISO-8859-13");
case 28605: return ecl_make_keyword("ISO-8859-15");
case 50220: return ecl_make_keyword("ISO-2022-JP");
case 65001: return ecl_make_keyword("UTF-8");
#endif
/* Nothing we can do here, try our best with :pass-through */
default: return @':pass-through';
}
}
#else
#define maybe_make_windows_console_FILE ecl_make_stream_from_FILE
#define maybe_make_windows_console_fd ecl_make_file_stream_from_fd
@ -5804,11 +5832,15 @@ init_file(void)
cl_object null_stream;
cl_object external_format = ECL_NIL;
#if defined(ECL_MS_WINDOWS_HOST)
/* We start out with :pass-through external format for standard
* input/output for bootstrap reasons (some of the external format
* support is implemented in lisp and not available on start of
* ECL). The correct format is later on set using the encoding
* specified by the current codepage. */
external_format = cl_list(2, @':pass-through', @':crlf');
# ifdef ECL_UNICODE
external_format = cl_list(2, @':latin-1', @':crlf');
flags = 0;
# else
external_format = cl_list(2, @':crlf', @':pass-through');
flags = ECL_STREAM_DEFAULT_FORMAT;
# endif
#else

38
src/c/main.d
View file

@ -454,40 +454,16 @@ struct cl_core_struct cl_core = {
static void
maybe_fix_console_stream(cl_object stream)
{
DWORD cp = GetConsoleCP();
const char *encoding;
cl_object external_format;
int i;
static const struct {
int code;
const char *name;
} known_cp[] = {
{874, "WINDOWS-CP874"},
{932, "WINDOWS-CP932"},
{936, "WINDOWS-CP936"},
{949, "WINDOWS-CP949"},
{950, "WINDOWS-CP950"},
{1200, "WINDOWS-CP1200"},
{1201, "WINDOWS-CP1201"},
{1250, "WINDOWS-CP1250"},
{1251, "WINDOWS-CP1251"},
{1252, "WINDOWS-CP1252"},
{1253, "WINDOWS-CP1253"},
{1254, "WINDOWS-CP1254"},
{1255, "WINDOWS-CP1255"},
{1256, "WINDOWS-CP1256"},
{1257, "WINDOWS-CP1257"},
{1258, "WINDOWS-CP1258"},
{65001, "UTF8"},
{0,"LATIN-1"}
};
if (stream->stream.mode != ecl_smm_io_wcon)
return;
for (i = 0; known_cp[i].code && known_cp[i].code != cp; i++)
{}
external_format = cl_list(2, ecl_make_keyword(known_cp[i].name),
@':crlf');
si_stream_external_format_set(stream, external_format);
external_format = si_windows_codepage_encoding();
if (external_format == @':pass-through')
fprintf(stderr,
"Unsupported codepage %d, input/output encoding may be wrong.\n"
"Use the chcp command to change codepages, e.g. 'chcp 65001' to change to utf-8.\n",
GetConsoleCP());
si_stream_external_format_set(stream, cl_list(2, external_format, @':crlf'));
stream->stream.eof_char = 26;
}
#endif

16
src/c/symbols_list.h
View file

@ -79,6 +79,11 @@ typedef struct {
#else
# define IF_COMPLEX_FLOAT(x) NULL
#endif
#ifdef ECL_MS_WINDOWS_HOST
# define IF_WINDOWS(x) x
#else
# define IF_WINDOWS(x) NULL
#endif
/* XXX When the symbol has the associated function its name must
follow the naming convention, otherwise si:mangle-name will
@ -1811,6 +1816,8 @@ cl_symbols[] = {
{EXT_ "*ACTION-ON-UNDEFINED-VARIABLE*", EXT_SPECIAL, NULL, -1, ECL_NIL},
{SYS_ "WINDOWS-CODEPAGE-ENCODING", SI_ORDINARY, IF_WINDOWS(si_windows_codepage_encoding), 0, OBJNULL},
{EXT_ "SET-BUFFERING-MODE", EXT_ORDINARY, si_set_buffering_mode, 2, OBJNULL},
{KEY_ "NONE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "LINE-BUFFERED", KEYWORD, NULL, -1, OBJNULL},
@ -1923,6 +1930,7 @@ cl_symbols[] = {
{KEY_ "CR", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "LF", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "CRLF", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "UCS-2BE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "UCS-4BE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "UCS-2LE", KEYWORD, NULL, -1, OBJNULL},
@ -2001,7 +2009,7 @@ cl_symbols[] = {
{EXT_ "WHEN-LET", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "WHEN-LET*", EXT_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "HANDLE-SIGNAL", SI_ORDINARY, si_handle_signal, 2, OBJNULL},
{SYS_ "HANDLE-SIGNAL", SI_ORDINARY, si_handle_signal, 1, OBJNULL},
{EXT_ "WITH-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
{EXT_ "WITHOUT-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
@ -2049,11 +2057,7 @@ cl_symbols[] = {
#endif
{SYS_ "RUN-PROGRAM-INNER", SI_ORDINARY, si_run_program_inner, 4, OBJNULL},
{SYS_ "SPAWN-SUBPROCESS", SI_ORDINARY, si_spawn_subprocess, 6, OBJNULL},
#if defined(ECL_MS_WINDOWS_HOST)
{SYS_ "CLOSE-WINDOWS-HANDLE", SI_ORDINARY, si_close_windows_handle, 1, OBJNULL},
#else
{SYS_ "CLOSE-WINDOWS-HANDLE", SI_ORDINARY, NULL, -1, OBJNULL},
#endif
{SYS_ "CLOSE-WINDOWS-HANDLE", SI_ORDINARY, IF_WINDOWS(si_close_windows_handle), 1, OBJNULL},
/* ~ */
{EXT_ "*INVOKE-DEBUGGER-HOOK*", EXT_SPECIAL, NULL, -1, ECL_NIL},

16
src/c/symbols_list2.h
View file

@ -79,6 +79,11 @@ typedef struct {
#else
# define IF_COMPLEX_FLOAT(x) NULL
#endif
#ifdef ECL_MS_WINDOWS_HOST
# define IF_WINDOWS(x) x
#else
# define IF_WINDOWS(x) NULL
#endif
/* XXX When the symbol has the associated function its name must
follow the naming convention, otherwise si:mangle-name will
@ -1811,6 +1816,8 @@ cl_symbols[] = {
{EXT_ "*ACTION-ON-UNDEFINED-VARIABLE*",NULL,-1},
{SYS_ "WINDOWS-CODEPAGE-ENCODING",IF_WINDOWS("si_windows_codepage_encoding"),0},
{EXT_ "SET-BUFFERING-MODE","si_set_buffering_mode",2},
{KEY_ "NONE",NULL,-1},
{KEY_ "LINE-BUFFERED",NULL,-1},
@ -1923,6 +1930,7 @@ cl_symbols[] = {
{KEY_ "CR",NULL,-1},
{KEY_ "LF",NULL,-1},
{KEY_ "CRLF",NULL,-1},
{KEY_ "UCS-2BE",NULL,-1},
{KEY_ "UCS-4BE",NULL,-1},
{KEY_ "UCS-2LE",NULL,-1},
@ -2001,7 +2009,7 @@ cl_symbols[] = {
{EXT_ "WHEN-LET",NULL,-1},
{EXT_ "WHEN-LET*",NULL,-1},
{SYS_ "HANDLE-SIGNAL","si_handle_signal",2},
{SYS_ "HANDLE-SIGNAL","si_handle_signal",1},
{EXT_ "WITH-INTERRUPTS",NULL,-1},
{EXT_ "WITHOUT-INTERRUPTS",NULL,-1},
@ -2049,11 +2057,7 @@ cl_symbols[] = {
#endif
{SYS_ "RUN-PROGRAM-INNER","si_run_program_inner",4},
{SYS_ "SPAWN-SUBPROCESS","si_spawn_subprocess",6},
#if defined(ECL_MS_WINDOWS_HOST)
{SYS_ "CLOSE-WINDOWS-HANDLE","si_close_windows_handle",1},
#else
{SYS_ "CLOSE-WINDOWS-HANDLE",NULL,-1},
#endif
{SYS_ "CLOSE-WINDOWS-HANDLE",IF_WINDOWS("si_close_windows_handle"),1},
/* ~ */
{EXT_ "*INVOKE-DEBUGGER-HOOK*",NULL,-1},

4
src/c/threads/process.d
View file

@ -394,6 +394,10 @@ ecl_import_current_thread(cl_object name, cl_object bindings)
* we can safely store pointers to memory allocated by the gc there. */
memset(env_aux, 0, sizeof(*env_aux));
env_aux->disable_interrupts = 1;
env_aux->interrupt_struct = ecl_alloc_unprotected(sizeof(*env_aux->interrupt_struct));
env_aux->interrupt_struct->pending_interrupt = ECL_NIL;
env_aux->interrupt_struct->signal_queue_spinlock = ECL_NIL;
env_aux->interrupt_struct->signal_queue = ECL_NIL;
ecl_set_process_env(env_aux);
ecl_init_env(env_aux);

43
src/c/unixint.d
View file

@ -324,7 +324,7 @@ unblock_signal(cl_env_ptr the_env, int signal)
ecl_def_ct_base_string(str_ignore_signal,"Ignore signal",13,static,const);
static void
handle_signal_now(cl_object signal_code, cl_object process)
handle_signal_now(cl_object signal_code)
{
switch (ecl_t_of(signal_code)) {
case t_fixnum:
@ -354,9 +354,9 @@ handle_signal_now(cl_object signal_code, cl_object process)
}
cl_object
si_handle_signal(cl_object signal_code, cl_object process)
si_handle_signal(cl_object signal_code)
{
handle_signal_now(signal_code, process);
handle_signal_now(signal_code);
@(return)
}
@ -364,7 +364,7 @@ static void
handle_all_queued(cl_env_ptr env)
{
while (env->interrupt_struct->pending_interrupt != ECL_NIL) {
handle_signal_now(pop_signal(env), env->own_process);
handle_signal_now(pop_signal(env));
}
}
@ -519,7 +519,7 @@ handle_or_queue(cl_env_ptr the_env, cl_object signal_code, int code)
else {
if (code) unblock_signal(the_env, code);
si_trap_fpe(@'last', ECL_T); /* Clear FPE exception flag */
handle_signal_now(signal_code, the_env->own_process);
handle_signal_now(signal_code);
}
}
@ -555,7 +555,7 @@ handler_fn_prototype(evil_signal_handler, int sig, siginfo_t *siginfo, void *dat
signal_object = ecl_gethash_safe(ecl_make_fixnum(sig),
cl_core.known_signals,
ECL_NIL);
handle_signal_now(signal_object, the_env->own_process);
handle_signal_now(signal_object);
errno = old_errno;
}
@ -651,10 +651,9 @@ asynchronous_signal_servicing_thread()
cl_core.known_signals,
ECL_NIL);
if (!Null(signal_code)) {
mp_process_run_function(4, @'si::handle-signal',
mp_process_run_function(3, @'si::handle-signal',
@'si::handle-signal',
signal_code,
signal_thread_msg.process);
signal_code);
}
}
# if defined(ECL_USE_MPROTECT)
@ -773,7 +772,7 @@ handler_fn_prototype(fpe_signal_handler, int sig, siginfo_t *info, void *data)
*/
si_trap_fpe(@'last', ECL_T); /* Clear FPE exception flag */
unblock_signal(the_env, code);
handle_signal_now(condition, the_env->own_process);
handle_signal_now(condition);
/* We will not reach past this point. */
}
@ -1152,43 +1151,43 @@ _ecl_w32_exception_filter(struct _EXCEPTION_POINTERS* ep)
/* Catch all arithmetic exceptions */
case EXCEPTION_INT_DIVIDE_BY_ZERO:
feclearexcept(FE_ALL_EXCEPT);
handle_signal_now(@'division-by-zero', the_env->own_process);
handle_signal_now(@'division-by-zero');
return EXCEPTION_CONTINUE_EXECUTION;
case EXCEPTION_INT_OVERFLOW:
feclearexcept(FE_ALL_EXCEPT);
handle_signal_now(@'arithmetic-error', the_env->own_process);
handle_signal_now(@'arithmetic-error');
return EXCEPTION_CONTINUE_EXECUTION;
case EXCEPTION_FLT_DIVIDE_BY_ZERO:
feclearexcept(FE_ALL_EXCEPT);
handle_signal_now(@'floating-point-overflow', the_env->own_process);
handle_signal_now(@'floating-point-overflow');
return EXCEPTION_CONTINUE_EXECUTION;
case EXCEPTION_FLT_OVERFLOW:
feclearexcept(FE_ALL_EXCEPT);
handle_signal_now(@'floating-point-overflow', the_env->own_process);
handle_signal_now(@'floating-point-overflow');
return EXCEPTION_CONTINUE_EXECUTION;
case EXCEPTION_FLT_UNDERFLOW:
feclearexcept(FE_ALL_EXCEPT);
handle_signal_now(@'floating-point-underflow', the_env->own_process);
handle_signal_now(@'floating-point-underflow');
return EXCEPTION_CONTINUE_EXECUTION;
case EXCEPTION_FLT_INEXACT_RESULT:
feclearexcept(FE_ALL_EXCEPT);
handle_signal_now(@'floating-point-inexact', the_env->own_process);
handle_signal_now(@'floating-point-inexact');
return EXCEPTION_CONTINUE_EXECUTION;
case EXCEPTION_FLT_DENORMAL_OPERAND:
case EXCEPTION_FLT_INVALID_OPERATION:
feclearexcept(FE_ALL_EXCEPT);
handle_signal_now(@'floating-point-invalid-operation', the_env->own_process);
handle_signal_now(@'floating-point-invalid-operation');
return EXCEPTION_CONTINUE_EXECUTION;
case EXCEPTION_FLT_STACK_CHECK:
handle_signal_now(@'arithmetic-error', the_env->own_process);
handle_signal_now(@'arithmetic-error');
return EXCEPTION_CONTINUE_EXECUTION;
/* Catch segmentation fault */
case EXCEPTION_ACCESS_VIOLATION:
handle_signal_now(@'ext::segmentation-violation', the_env->own_process);
handle_signal_now(@'ext::segmentation-violation');
return EXCEPTION_CONTINUE_EXECUTION;
/* Catch illegal instruction */
case EXCEPTION_ILLEGAL_INSTRUCTION:
handle_signal_now(@'ext::illegal-instruction', the_env->own_process);
handle_signal_now(@'ext::illegal-instruction');
return EXCEPTION_CONTINUE_EXECUTION;
/* Do not catch anything else */
default:
@ -1204,9 +1203,9 @@ static cl_object
W32_handle_in_new_thread(cl_object signal_code)
{
int outside_ecl = ecl_import_current_thread(@'si::handle-signal', ECL_NIL);
mp_process_run_function(4, @'si::handle-signal',
mp_process_run_function(3, @'si::handle-signal',
@'si::handle-signal',
signal_code, ECL_NIL);
signal_code);
if (outside_ecl) ecl_release_current_thread();
}

17
src/cmp/cmpos-features.lsp
View file

@ -17,7 +17,13 @@
(defun run-and-collect (command args &optional file)
(handler-case
(let ((lines (collect-lines (si:run-program-inner command args :default t))))
(let ((output-stream (si:run-program-inner command args :default t))
lines)
#+msvc
(si::stream-external-format-set
output-stream
(list (si::windows-codepage-encoding) :crlf))
(setf lines (collect-lines output-stream))
(cond ((null file)
lines)
((probe-file file)
@ -147,12 +153,3 @@ we are currently using with ECL."
(defun update-compiler-features (&rest args)
(setf *compiler-features* (apply #'gather-system-features args)))
#+ecl-min
(update-compiler-features
:executable
#+(or windows cygwin mingw32) "build:ecl_min.exe"
#-(or windows cygwin mingw32) "build:ecl_min")
#+ecl-min
(format t ";;; System features: ~A~%" *compiler-features*)

7
src/cmp/cmpos-run.lsp
View file

@ -55,6 +55,9 @@
#+(and ecl-min (not cygwin))
(multiple-value-bind (output-stream return-status pid)
(si:run-program-inner program args :default nil)
#+msvc
(si::stream-external-format-set output-stream
(list (si::windows-codepage-encoding) :crlf))
(setf output (collect-lines output-stream))
(multiple-value-setq (return-status result)
(si:waitpid pid t)))
@ -62,7 +65,9 @@
;; quoting of arguments ...
#+(and (not ecl-min) (not cygwin))
(multiple-value-bind (output-stream return-status process-obj)
(ext:run-program program args :wait nil)
(ext:run-program program args :wait nil
#+msvc :external-format
#+msvc (list (si::windows-codepage-encoding) :crlf))
(setf output (collect-lines output-stream))
(multiple-value-setq (return-status result)
(ext:external-process-wait process-obj t)))

23
src/compile.lsp.in
View file

@ -21,6 +21,23 @@
;;;
(load "bare.lsp" :verbose nil)
;;;
;;; * External formats. These come at the very beginning since msvc needs
;;; them to compile correctly.
;;;
#+UNICODE
(load "ext:encodings;generate.lisp")
;;;
;;; * Find out what features are supported by the C compiler we are using
;;;
(progn
(c::update-compiler-features
:executable
#+(or windows cygwin mingw32) "build:ecl_min.exe"
#-(or windows cygwin mingw32) "build:ecl_min")
(format t "~&;;; System features: ~A~%" c::*compiler-features*))
;;;
;;; * Complain about functions which are not in the core
;;;
@ -312,12 +329,6 @@
:prefix "EXT"
:builtin #+:BUILTIN-RT t #-:BUILTIN-RT nil)
;;;
;;; * External formats
;;;
#+UNICODE
(load "ext:encodings;generate.lisp")
;;;
;;; * Package locks
;;;

5
src/h/external.h
View file

@ -718,6 +718,9 @@ extern ECL_API cl_object si_do_write_sequence(cl_object string, cl_object stream
extern ECL_API cl_object si_do_read_sequence(cl_object string, cl_object stream, cl_object start, cl_object end);
extern ECL_API cl_object si_file_column(cl_object strm);
extern ECL_API cl_object cl_interactive_stream_p(cl_object strm);
#if defined(ECL_MS_WINDOWS_HOST)
extern ECL_API cl_object si_windows_codepage_encoding();
#endif
extern ECL_API cl_object si_set_buffering_mode(cl_object strm, cl_object mode);
extern ECL_API cl_object si_stream_external_format_set(cl_object strm, cl_object format);
@ -1930,7 +1933,7 @@ extern ECL_API cl_object si_copy_file(cl_object orig, cl_object end);
#define ecl_enable_interrupts() ecl_enable_interrupts_env(&cl_env)
#define ECL_PSEUDO_ATOMIC_ENV(env,stmt) (ecl_disable_interrupts_env(env),(stmt),ecl_enable_interrupts_env(env))
#define ECL_PSEUDO_ATOMIC(stmt) (ecl_disable_interrupts(),(stmt),ecl_enable_interrupts())
extern ECL_API cl_object si_handle_signal(cl_object signal, cl_object process);
extern ECL_API cl_object si_handle_signal(cl_object signal);
extern ECL_API cl_object si_get_signal_handler(cl_object signal);
extern ECL_API cl_object si_set_signal_handler(cl_object signal, cl_object handler);
extern ECL_API cl_object si_catch_signal(cl_narg narg, cl_object signal, cl_object state, ...);