(maxarg (cdr arity)))
(when (eq maxarg 'unevalled)
(signal 'native-ice (list "subr contains unevalled args" subr-name)))
- (if (not (subrp subr-name))
- ;; The primitive got redefined before the compiler is
- ;; invoked! (bug#61917)
- (comp-emit-set-call `(callref funcall
- ,(make-comp-mvar :constant subr-name)
- ,@(cl-loop repeat nargs
- for sp from (comp-sp)
- collect (comp-slot-n sp))))
- (if (eq maxarg 'many)
- ;; callref case.
- (comp-emit-set-call (comp-callref subr-name nargs (comp-sp)))
- ;; Normal call.
- (unless (and (>= maxarg nargs) (<= minarg nargs))
- (signal 'native-ice
- (list "incoherent stack adjustment" nargs maxarg minarg)))
- (let* ((subr-name subr-name)
- (slots (cl-loop for i from 0 below maxarg
- collect (comp-slot-n (+ i (comp-sp))))))
- (comp-emit-set-call (apply #'comp-call (cons subr-name slots)))))))))
+ (if (eq maxarg 'many)
+ ;; callref case.
+ (comp-emit-set-call (comp-callref subr-name nargs (comp-sp)))
+ ;; Normal call.
+ (unless (and (>= maxarg nargs) (<= minarg nargs))
+ (signal 'native-ice
+ (list "incoherent stack adjustment" nargs maxarg minarg)))
+ (let* ((subr-name subr-name)
+ (slots (cl-loop for i from 0 below maxarg
+ collect (comp-slot-n (+ i (comp-sp))))))
+ (comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))))
(eval-when-compile
(defun comp-op-to-fun (x)
(should (subr-native-elisp-p
(symbol-function 'comp-test-48029-nonascii-žžž-f))))
-(comp-deftest 61917-1 ()
- "Verify we can compile calls to redefined primitives with
-dedicated byte-op code."
- (let ((f (lambda (fn &rest args)
- (apply fn args))))
- (advice-add #'delete-region :around f)
- (unwind-protect
- (should (subr-native-elisp-p
- (native-compile
- '(lambda ()
- (delete-region (point-min) (point-max))))))
- (advice-remove #'delete-region f))))
-
\f
;;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests. ;;