comparison lisp/emacs-lisp/bytecomp.el @ 46003:503e1f14ba3d

(byte-compile-callargs-warn): Check for `noruntime' even if the function has a known sig. (byte-compile-file, byte-compile-output-docform): Don't hard code point-min = 1.

46002:6f298513c731

;; Maintainer: FSF
;; Keywords: lisp

;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.98 $")

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

	   (car form) ncall
	   (if (= 1 ncall) "" "s")
	   (if (< ncall (car sig))
	       "requires"
	     "accepts only")
	   (byte-compile-arglist-signature-string sig)))
      (or (and (fboundp (car form))	; might be a subr or autoload.
	       (not (get (car form) 'byte-compile-noruntime)))
	  (eq (car form) byte-compile-current-form) ; ## this doesn't work
						    ; with recursion.
	  ;; It's a currently-undefined function.
	  ;; Remember number of args in call.
	  (let ((cons (assq (car form) byte-compile-unresolved-functions))
		(n (length (cdr form))))
	    (if cons
		(or (memq n (cdr cons))
		    (setcdr cons (cons n (cdr cons))))
		(setq byte-compile-unresolved-functions
		      (cons (list (car form) n)
			    byte-compile-unresolved-functions))))))))

;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))

		    ;; hard-links continue to point to the old file (this makes
		    ;; it possible for installed files to share disk space with
		    ;; the build tree, without causing problems when emacs-lisp
		    ;; files in the build tree are recompiled).
		    (delete-file target-file))
		  (write-region 1 (point-max) target-file))
	      ;; This is just to give a better error message than write-region
	      (signal 'file-error
		      (list "Opening output file"
			    (if (file-exists-p target-file)
				"cannot overwrite file"

		;; for make-docfile's sake.
		(insert "\n")
		(setq position
		      (byte-compile-output-as-comment
		       (nth (nth 1 info) form) nil))
		(setq position (position-bytes position))
		;; If the doc string starts with * (a user variable),
		;; negate POSITION.
		(if (and (stringp (nth (nth 1 info) form))
			 (> (length (nth (nth 1 info) form)) 0)
			 (eq (aref (nth (nth 1 info) form) 0) ?*))

	     (cond ((and (numberp specindex) (= index specindex))
		    (let ((position
			   (byte-compile-output-as-comment
			    (cons (car form) (nth 1 form))
			    t)))
		      (setq position (position-bytes position))
		      (princ (format "(#$ . %d) nil" position) outbuffer)
		      (setq form (cdr form))
		      (setq index (1+ index))))
		   ((= index (nth 1 info))
		    (if position

	 ;; a number or symbol - ie not some big sequence.  The return value
	 ;; isn't returned, but it would be a shame if some textually large
	 ;; constant was not optimized away because we chose to return it.
	 (and (not (assq nil byte-compile-constants)) ; Nil is often there.
	      (let ((tmp (reverse byte-compile-constants)))
		(while (and tmp (not (or (symbolp (car (car tmp)))
					 (numberp (car (car tmp))))))
		  (setq tmp (cdr tmp)))
		(car (car tmp)))))))
  (byte-compile-out 'byte-return 0)
  (setq byte-compile-output (nreverse byte-compile-output))
  (if (memq byte-optimize '(t byte))
      (setq byte-compile-output
	    (byte-optimize-lapcode byte-compile-output for-effect)))

46003:503e1f14ba3d

;; Maintainer: FSF
;; Keywords: lisp

;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.99 $")

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

	   (car form) ncall
	   (if (= 1 ncall) "" "s")
	   (if (< ncall (car sig))
	       "requires"
	     "accepts only")
	   (byte-compile-arglist-signature-string sig))))
    ;; Check to see if the function will be available at runtime
    ;; and/or remember its arity if it's unknown.
    (or (and (or sig (fboundp (car form))) ; might be a subr or autoload.
	     (not (get (car form) 'byte-compile-noruntime)))
	(eq (car form) byte-compile-current-form) ; ## this doesn't work
					; with recursion.
	;; It's a currently-undefined function.
	;; Remember number of args in call.
	(let ((cons (assq (car form) byte-compile-unresolved-functions))
	      (n (length (cdr form))))
	  (if cons
	      (or (memq n (cdr cons))
		  (setcdr cons (cons n (cdr cons))))
	    (setq byte-compile-unresolved-functions
		  (cons (list (car form) n)
			byte-compile-unresolved-functions)))))))

;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))

		    ;; hard-links continue to point to the old file (this makes
		    ;; it possible for installed files to share disk space with
		    ;; the build tree, without causing problems when emacs-lisp
		    ;; files in the build tree are recompiled).
		    (delete-file target-file))
		  (write-region (point-min) (point-max) target-file))
	      ;; This is just to give a better error message than write-region
	      (signal 'file-error
		      (list "Opening output file"
			    (if (file-exists-p target-file)
				"cannot overwrite file"

		;; for make-docfile's sake.
		(insert "\n")
		(setq position
		      (byte-compile-output-as-comment
		       (nth (nth 1 info) form) nil))
		(setq position (- (position-bytes position) (point-min) -1))
		;; If the doc string starts with * (a user variable),
		;; negate POSITION.
		(if (and (stringp (nth (nth 1 info) form))
			 (> (length (nth (nth 1 info) form)) 0)
			 (eq (aref (nth (nth 1 info) form) 0) ?*))

	     (cond ((and (numberp specindex) (= index specindex))
		    (let ((position
			   (byte-compile-output-as-comment
			    (cons (car form) (nth 1 form))
			    t)))
		      (setq position (- (position-bytes position) (point-min) -1))
		      (princ (format "(#$ . %d) nil" position) outbuffer)
		      (setq form (cdr form))
		      (setq index (1+ index))))
		   ((= index (nth 1 info))
		    (if position

	 ;; a number or symbol - ie not some big sequence.  The return value
	 ;; isn't returned, but it would be a shame if some textually large
	 ;; constant was not optimized away because we chose to return it.
	 (and (not (assq nil byte-compile-constants)) ; Nil is often there.
	      (let ((tmp (reverse byte-compile-constants)))
		(while (and tmp (not (or (symbolp (caar tmp))
					 (numberp (caar tmp)))))
		  (setq tmp (cdr tmp)))
		(caar tmp))))))
  (byte-compile-out 'byte-return 0)
  (setq byte-compile-output (nreverse byte-compile-output))
  (if (memq byte-optimize '(t byte))
      (setq byte-compile-output
	    (byte-optimize-lapcode byte-compile-output for-effect)))