From 390caa3e51ba28bd5a2c88cb704f5145f4248d2b Mon Sep 17 00:00:00 2001 From: Fabrizio Fabbri Date: Sat, 3 Jun 2017 12:57:17 +0200 Subject: [PATCH] Revert "Revert "Merge branch 'develop' into 'develop'"" This reverts commit cf416f6fd4624a0ea61b8682d308317e2e9cd86f. --- src/c/character.d | 1 + src/c/cinit.d | 7 +++++-- src/c/clos/gfun.d | 1 + src/c/dpp.c | 5 +++++ src/c/error.d | 5 ++++- src/c/file.d | 3 ++- src/c/numbers/ceiling.d | 1 + src/c/numbers/number_compare.d | 4 +++- src/c/numbers/number_equalp.d | 1 + src/c/package.d | 5 ++++- src/c/pathname.d | 1 + src/c/tcp.d | 1 + src/c/threads/process.d | 9 +++++++-- src/c/threads/queue.d | 1 + src/c/typespec.d | 6 +++--- src/c/unicode/ucd_names_char.c | 2 +- src/c/unixsys.d | 6 +++--- src/cmp/cmpmain.lsp | 3 ++- src/cmp/cmptop.lsp | 2 +- src/h/internal.h | 4 +++- 20 files changed, 50 insertions(+), 18 deletions(-) diff --git a/src/c/character.d b/src/c/character.d index 62865a9a9..1717e8ae9 100644 --- a/src/c/character.d +++ b/src/c/character.d @@ -208,6 +208,7 @@ ecl_char_eq(cl_object x, cl_object y) if (ecl_char_eq(ecl_va_arg(ds), c)) { @(return ECL_NIL); } + ecl_va_end(ds); } @(return ECL_T); } @) diff --git a/src/c/cinit.d b/src/c/cinit.d index 076bc1a96..10b822462 100644 --- a/src/c/cinit.d +++ b/src/c/cinit.d @@ -38,6 +38,7 @@ si_safe_eval(cl_narg narg, cl_object form, cl_object env, ...) cl_object err_value; va_list args; va_start(args, env); err_value = va_arg(args, cl_object); + va_end(args); return _ecl_funcall4(@'ext::safe-eval', form, env, err_value); } return _ecl_funcall3(@'ext::safe-eval', form, env); @@ -98,6 +99,7 @@ si_string_to_object(cl_narg narg, cl_object string, ...) cl_object err_value; va_list args; va_start(args, string); err_value = va_arg(args, cl_object); + va_end(args); return _ecl_funcall3(@'si::string-to-object', string, err_value); } return _ecl_funcall2(@'si::string-to-object', string); @@ -110,8 +112,9 @@ si_signal_simple_error(cl_narg narg, cl_object condition, cl_object continuable, cl_object rest; ecl_va_start(args, format_args, narg, 4); rest = cl_grab_rest_args(args); - cl_apply(6, @'si::signal-simple-error', condition, continuable, - format, format_args, rest); + ecl_va_end(args); + return cl_apply(6, @'si::signal-simple-error', condition, continuable, + format, format_args, rest); } extern cl_object diff --git a/src/c/clos/gfun.d b/src/c/clos/gfun.d index e02860a82..b68becda4 100644 --- a/src/c/clos/gfun.d +++ b/src/c/clos/gfun.d @@ -49,6 +49,7 @@ user_function_dispatch(cl_narg narg, ...) fun = fun->instance.slots[fun->instance.length - 1]; output = ecl_apply_from_stack_frame(frame, fun); ecl_stack_frame_close(frame); + ecl_va_end(args); return output; } diff --git a/src/c/dpp.c b/src/c/dpp.c index fcf4b5a67..d6b5d56a6 100755 --- a/src/c/dpp.c +++ b/src/c/dpp.c @@ -764,6 +764,11 @@ put_declaration(void) put_lineno(); fprintf(out, "\t}\n"); } + if (simple_varargs) { + fprintf(out,"\tva_end(%s);\n", rest_var); + } else { + fprintf(out,"\tecl_va_end(%s);\n", rest_var); + } if (key_flag) { put_lineno(); fprintf(out, "\tcl_parse_key(ARGS, %d, KEYS, KEY_VARS, NULL, %d);\n", diff --git a/src/c/error.d b/src/c/error.d index c4cf5cb23..49432bea2 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -125,12 +125,15 @@ void FEerror(const char *s, int narg, ...) { ecl_va_list args; + cl_object rest; ecl_va_start(args, narg, narg, 0); ecl_enable_interrupts(); + rest = cl_grab_rest_args(args); + ecl_va_end(args); funcall(4, @'si::universal-error-handler', ECL_NIL, /* not correctable */ make_constant_base_string(s), /* condition text */ - cl_grab_rest_args(args)); + rest); _ecl_unexpected_return(); } diff --git a/src/c/file.d b/src/c/file.d index 4d28b1e9a..4fb81c896 100755 --- a/src/c/file.d +++ b/src/c/file.d @@ -5328,7 +5328,8 @@ flisten(cl_object stream, FILE *fp) { /* regular file */ ecl_off_t old_pos = ecl_ftello(fp), end_pos; - unlikely_if (ecl_fseeko(fp, 0, SEEK_END) != 0) + unlikely_if (old_pos == -1 || + ecl_fseeko(fp, 0, SEEK_END) != 0) file_libc_error(@[file-error], stream, "Unable to check file position", 0); end_pos = ecl_ftello(fp); diff --git a/src/c/numbers/ceiling.d b/src/c/numbers/ceiling.d index 60d370029..b1b32f120 100644 --- a/src/c/numbers/ceiling.d +++ b/src/c/numbers/ceiling.d @@ -77,6 +77,7 @@ ecl_ceiling2(cl_object x, cl_object y) const cl_env_ptr the_env = ecl_process_env(); cl_object v0, v1; cl_type ty; + v0 = v1 = ECL_NIL; ty = ecl_t_of(y); if (ecl_unlikely(!ECL_REAL_TYPE_P(ty))) { FEwrong_type_nth_arg(@[ceiling],2, y, @[real]); diff --git a/src/c/numbers/number_compare.d b/src/c/numbers/number_compare.d index 88a9d6db7..8293be4ec 100644 --- a/src/c/numbers/number_compare.d +++ b/src/c/numbers/number_compare.d @@ -208,7 +208,9 @@ monotonic(int s, int t, int narg, ecl_va_list nums) #define MONOTONIC(i, j) (cl_narg narg, ...) \ { ecl_va_list nums; ecl_va_start(nums, narg, narg, 0); \ - return monotonic(i, j, narg, nums); } + cl_object result = monotonic(i, j, narg, nums); \ + ecl_va_end(nums); \ + return result; } cl_object @<= MONOTONIC( 1, 0) cl_object @>= MONOTONIC(-1, 0) diff --git a/src/c/numbers/number_equalp.d b/src/c/numbers/number_equalp.d index 3fad40a16..ae9c91a7e 100644 --- a/src/c/numbers/number_equalp.d +++ b/src/c/numbers/number_equalp.d @@ -188,6 +188,7 @@ ecl_number_equalp(cl_object x, cl_object y) if (ecl_number_equalp(numi, ecl_va_arg(numb))) { @(return ECL_NIL); } + ecl_va_end(numb); } @(return ECL_T); @) diff --git a/src/c/package.d b/src/c/package.d index 2e8fe2038..28bab7b73 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -51,12 +51,15 @@ void CEpackage_error(const char *message, const char *continue_message, cl_object package, int narg, ...) { ecl_va_list args; + cl_object arg; ecl_va_start(args, narg, narg, 0); + arg = narg? cl_grab_rest_args(args) : cl_list(1,package); + ecl_va_end(args); si_signal_simple_error(6, @'package-error', make_constant_base_string(continue_message), make_constant_base_string(message), /* format control */ - narg? cl_grab_rest_args(args) : cl_list(1,package), + arg, @':package', package); } diff --git a/src/c/pathname.d b/src/c/pathname.d index a8011a5e9..e27237bb8 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -564,6 +564,7 @@ ecl_parse_namestring(cl_object s, cl_index start, cl_index end, cl_index *ep, if (start == end) { host = device = path = name = type = aux = version = @'nil'; logical = 0; + *ep = end; goto make_it; } /* We first try parsing as logical-pathname. In case of diff --git a/src/c/tcp.d b/src/c/tcp.d index b1849a169..59794554b 100644 --- a/src/c/tcp.d +++ b/src/c/tcp.d @@ -251,6 +251,7 @@ create_server_port(int port) FElibc_error("Accepting requests", 0); #endif /* THREADS */ + close(request); return(conn); } diff --git a/src/c/threads/process.d b/src/c/threads/process.d index 2dee80f55..ca77c83bd 100755 --- a/src/c/threads/process.d +++ b/src/c/threads/process.d @@ -190,7 +190,7 @@ thread_cleanup(void *aux) cl_env_ptr env = process->process.env; /* The following flags will disable all interrupts. */ AO_store_full((AO_t*)&process->process.phase, ECL_PROCESS_EXITING); - ecl_disable_interrupts_env(env); + if (env) ecl_disable_interrupts_env(env); #ifdef HAVE_SIGPROCMASK /* ...but we might get stray signals. */ { @@ -440,6 +440,7 @@ mp_process_preset(cl_narg narg, cl_object process, cl_object function, ...) assert_type_process(process); process->process.function = function; process->process.args = cl_grab_rest_args(args); + ecl_va_end(args); @(return process); } @@ -645,6 +646,7 @@ cl_object mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...) { cl_object process; + cl_object rest; ecl_va_list args; ecl_va_start(args, function, narg, 2); if (narg < 2) @@ -654,8 +656,10 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...) } else { process = mp_make_process(2, @':name', name); } + rest = cl_grab_rest_args(args); + ecl_va_end(args); cl_apply(4, @'mp::process-preset', process, function, - cl_grab_rest_args(args)); + rest); return mp_process_enable(process); } @@ -673,6 +677,7 @@ mp_process_run_function_wait(cl_narg narg, ...) cl_sleep(wait); } } + ecl_va_end(args); @(return process); } diff --git a/src/c/threads/queue.d b/src/c/threads/queue.d index c10f5c444..2c41e4d2f 100755 --- a/src/c/threads/queue.d +++ b/src/c/threads/queue.d @@ -386,5 +386,6 @@ print_lock(char *prefix, cl_object l, ...) fflush(stdout); ecl_giveup_spinlock(&lock); } + va_end(args); } /*#define print_lock(a,b,c) (void)0*/ diff --git a/src/c/typespec.d b/src/c/typespec.d index fa89572b7..ce3a23526 100644 --- a/src/c/typespec.d +++ b/src/c/typespec.d @@ -90,9 +90,9 @@ cl_object ecl_type_error(cl_object function, const char *place, cl_object o, cl_object type) { - si_wrong_type_argument(4, o, type, - (*place? make_constant_base_string(place) : ECL_NIL), - function); + return si_wrong_type_argument(4, o, type, + (*place? make_constant_base_string(place) : ECL_NIL), + function); } /**********************************************************************/ diff --git a/src/c/unicode/ucd_names_char.c b/src/c/unicode/ucd_names_char.c index bb91bd841..0b42db64d 100644 --- a/src/c/unicode/ucd_names_char.c +++ b/src/c/unicode/ucd_names_char.c @@ -514,7 +514,7 @@ static void fill_pair_name(char *buffer, int pair) { if (pair < ECL_UCD_FIRST_PAIR) { - strncat(buffer, ecl_ucd_names_word[pair], ECL_UCD_LARGEST_CHAR_NAME+1); + strncat(buffer, ecl_ucd_names_word[pair], ECL_UCD_LARGEST_CHAR_NAME); /* printf("text=%s\n", ecl_ucd_names_word[pair]); */ diff --git a/src/c/unixsys.d b/src/c/unixsys.d index cbe8c41dc..149b9fe13 100644 --- a/src/c/unixsys.d +++ b/src/c/unixsys.d @@ -104,7 +104,7 @@ from_list_to_execve_argument(cl_object l, char ***environp) cl_object buffer; char **environ; for (p = l; !Null(p); p = ECL_CONS_CDR(p)) { - cl_object s; + cl_object s = ECL_CONS_CAR(p); total_size += s->base_string.fillp + 1; nstrings++; } @@ -515,7 +515,7 @@ si_spawn_subprocess(cl_object command, cl_object argv, cl_object environ, } close(child_stdin); close(child_stdout); - close(child_stderr); + if (!(error == @':output')) close(child_stderr); if (child_pid < 0) { pid = ECL_NIL; @@ -533,7 +533,7 @@ si_spawn_subprocess(cl_object command, cl_object argv, cl_object environ, if (Null(pid)) { if (parent_write) close(parent_write); if (parent_read) close(parent_read); - if (parent_error) close(parent_error); + if (parent_error > 0) close(parent_error); parent_write = 0; parent_read = 0; parent_error = 0; diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index a0d2b2155..5772b5948 100755 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -262,7 +262,7 @@ void ~A(cl_object cblock) * circular chain. This disables the garbage collection of * the library until _ALL_ functions in all modules are unlinked. */ - cl_object current, next = Cblock; + cl_object current = OBJNULL, next = Cblock; ~:{ current = ecl_make_codeblock(); current->cblock.next = next; @@ -313,6 +313,7 @@ extern int ecl_init_module(OBJNULL, ~A); ~A } ECL_CATCH_ALL_END; + return 0; } ") diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 0166f37e9..74b1243cf 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -443,7 +443,7 @@ (wt-nl "volatile cl_object lex" *level* "[" *max-lex* "];")) (unless (eq closure-type 'CLOSURE) - (wt-nl "cl_object " *volatile* "env0;")) + (wt-nl "cl_object " *volatile* "env0 = ECL_NIL;")) (when (plusp *max-env*) ;; Closure structure has to be marked volatile or else GCC may diff --git a/src/h/internal.h b/src/h/internal.h index 30445d42b..3084b9b4e 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -194,6 +194,7 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form, va_list args; \ va_start(args, lastarg); \ frame->frame.base = (cl_object*)args; \ + va_end(args); \ } else { \ frame->frame.base = env->stack_top - narg; \ } @@ -207,7 +208,7 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form, frame->frame.t = t_frame; \ frame->frame.env = env; \ frame->frame.size = narg; \ - if (narg < ECL_C_ARGUMENTS_LIMIT) { \ + if (narg < ECL_C_ARGUMENTS_LIMIT) { \ cl_object *p = frame->frame.base = env->values; \ va_list args; \ va_start(args, lastarg); \ @@ -215,6 +216,7 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form, *p = va_arg(args, cl_object); \ ++p; \ } \ + va_end(args); \ frame->frame.stack = (cl_object*)0x1; \ } else { \ frame->frame.base = env->stack_top - narg; \