diff options
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 62 |
1 files changed, 32 insertions, 30 deletions
diff --git a/src/eval.c b/src/eval.c index 1091b082552..37d466f69ed 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -2913,6 +2913,21 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) | |||
| 2913 | } | 2913 | } |
| 2914 | } | 2914 | } |
| 2915 | 2915 | ||
| 2916 | /* Call the compiled Lisp function FUN. If we have not yet read FUN's | ||
| 2917 | bytecode string and constants vector, fetch them from the file first. */ | ||
| 2918 | |||
| 2919 | static Lisp_Object | ||
| 2920 | fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left, | ||
| 2921 | ptrdiff_t nargs, Lisp_Object *args) | ||
| 2922 | { | ||
| 2923 | if (CONSP (AREF (fun, COMPILED_BYTECODE))) | ||
| 2924 | Ffetch_bytecode (fun); | ||
| 2925 | return exec_byte_code (AREF (fun, COMPILED_BYTECODE), | ||
| 2926 | AREF (fun, COMPILED_CONSTANTS), | ||
| 2927 | AREF (fun, COMPILED_STACK_DEPTH), | ||
| 2928 | syms_left, nargs, args); | ||
| 2929 | } | ||
| 2930 | |||
| 2916 | static Lisp_Object | 2931 | static Lisp_Object |
| 2917 | apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) | 2932 | apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) |
| 2918 | { | 2933 | { |
| @@ -2977,9 +2992,6 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 2977 | } | 2992 | } |
| 2978 | else if (COMPILEDP (fun)) | 2993 | else if (COMPILEDP (fun)) |
| 2979 | { | 2994 | { |
| 2980 | ptrdiff_t size = PVSIZE (fun); | ||
| 2981 | if (size <= COMPILED_STACK_DEPTH) | ||
| 2982 | xsignal1 (Qinvalid_function, fun); | ||
| 2983 | syms_left = AREF (fun, COMPILED_ARGLIST); | 2995 | syms_left = AREF (fun, COMPILED_ARGLIST); |
| 2984 | if (FIXNUMP (syms_left)) | 2996 | if (FIXNUMP (syms_left)) |
| 2985 | /* A byte-code object with an integer args template means we | 2997 | /* A byte-code object with an integer args template means we |
| @@ -2991,15 +3003,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 2991 | argument-binding code below instead (as do all interpreted | 3003 | argument-binding code below instead (as do all interpreted |
| 2992 | functions, even lexically bound ones). */ | 3004 | functions, even lexically bound ones). */ |
| 2993 | { | 3005 | { |
| 2994 | /* If we have not actually read the bytecode string | 3006 | return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector); |
| 2995 | and constants vector yet, fetch them from the file. */ | ||
| 2996 | if (CONSP (AREF (fun, COMPILED_BYTECODE))) | ||
| 2997 | Ffetch_bytecode (fun); | ||
| 2998 | return exec_byte_code (AREF (fun, COMPILED_BYTECODE), | ||
| 2999 | AREF (fun, COMPILED_CONSTANTS), | ||
| 3000 | AREF (fun, COMPILED_STACK_DEPTH), | ||
| 3001 | syms_left, | ||
| 3002 | nargs, arg_vector); | ||
| 3003 | } | 3007 | } |
| 3004 | lexenv = Qnil; | 3008 | lexenv = Qnil; |
| 3005 | } | 3009 | } |
| @@ -3068,16 +3072,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 3068 | if (CONSP (fun)) | 3072 | if (CONSP (fun)) |
| 3069 | val = Fprogn (XCDR (XCDR (fun))); | 3073 | val = Fprogn (XCDR (XCDR (fun))); |
| 3070 | else | 3074 | else |
| 3071 | { | 3075 | val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL); |
| 3072 | /* If we have not actually read the bytecode string | ||
| 3073 | and constants vector yet, fetch them from the file. */ | ||
| 3074 | if (CONSP (AREF (fun, COMPILED_BYTECODE))) | ||
| 3075 | Ffetch_bytecode (fun); | ||
| 3076 | val = exec_byte_code (AREF (fun, COMPILED_BYTECODE), | ||
| 3077 | AREF (fun, COMPILED_CONSTANTS), | ||
| 3078 | AREF (fun, COMPILED_STACK_DEPTH), | ||
| 3079 | Qnil, 0, 0); | ||
| 3080 | } | ||
| 3081 | 3076 | ||
| 3082 | return unbind_to (count, val); | 3077 | return unbind_to (count, val); |
| 3083 | } | 3078 | } |
| @@ -3162,9 +3157,6 @@ lambda_arity (Lisp_Object fun) | |||
| 3162 | } | 3157 | } |
| 3163 | else if (COMPILEDP (fun)) | 3158 | else if (COMPILEDP (fun)) |
| 3164 | { | 3159 | { |
| 3165 | ptrdiff_t size = PVSIZE (fun); | ||
| 3166 | if (size <= COMPILED_STACK_DEPTH) | ||
| 3167 | xsignal1 (Qinvalid_function, fun); | ||
| 3168 | syms_left = AREF (fun, COMPILED_ARGLIST); | 3160 | syms_left = AREF (fun, COMPILED_ARGLIST); |
| 3169 | if (FIXNUMP (syms_left)) | 3161 | if (FIXNUMP (syms_left)) |
| 3170 | return get_byte_code_arity (syms_left); | 3162 | return get_byte_code_arity (syms_left); |
| @@ -3207,13 +3199,11 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | |||
| 3207 | 3199 | ||
| 3208 | if (COMPILEDP (object)) | 3200 | if (COMPILEDP (object)) |
| 3209 | { | 3201 | { |
| 3210 | ptrdiff_t size = PVSIZE (object); | ||
| 3211 | if (size <= COMPILED_STACK_DEPTH) | ||
| 3212 | xsignal1 (Qinvalid_function, object); | ||
| 3213 | if (CONSP (AREF (object, COMPILED_BYTECODE))) | 3202 | if (CONSP (AREF (object, COMPILED_BYTECODE))) |
| 3214 | { | 3203 | { |
| 3215 | tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); | 3204 | tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); |
| 3216 | if (!CONSP (tem)) | 3205 | if (! (CONSP (tem) && STRINGP (XCAR (tem)) |
| 3206 | && VECTORP (XCDR (tem)))) | ||
| 3217 | { | 3207 | { |
| 3218 | tem = AREF (object, COMPILED_BYTECODE); | 3208 | tem = AREF (object, COMPILED_BYTECODE); |
| 3219 | if (CONSP (tem) && STRINGP (XCAR (tem))) | 3209 | if (CONSP (tem) && STRINGP (XCAR (tem))) |
| @@ -3221,7 +3211,19 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | |||
| 3221 | else | 3211 | else |
| 3222 | error ("Invalid byte code"); | 3212 | error ("Invalid byte code"); |
| 3223 | } | 3213 | } |
| 3224 | ASET (object, COMPILED_BYTECODE, XCAR (tem)); | 3214 | |
| 3215 | Lisp_Object bytecode = XCAR (tem); | ||
| 3216 | if (STRING_MULTIBYTE (bytecode)) | ||
| 3217 | { | ||
| 3218 | /* BYTECODE must have been produced by Emacs 20.2 or earlier | ||
| 3219 | because it produced a raw 8-bit string for byte-code and now | ||
| 3220 | such a byte-code string is loaded as multibyte with raw 8-bit | ||
| 3221 | characters converted to multibyte form. Convert them back to | ||
| 3222 | the original unibyte form. */ | ||
| 3223 | bytecode = Fstring_as_unibyte (bytecode); | ||
| 3224 | } | ||
| 3225 | |||
| 3226 | ASET (object, COMPILED_BYTECODE, bytecode); | ||
| 3225 | ASET (object, COMPILED_CONSTANTS, XCDR (tem)); | 3227 | ASET (object, COMPILED_CONSTANTS, XCDR (tem)); |
| 3226 | } | 3228 | } |
| 3227 | } | 3229 | } |