Associates the function with the current load file, if any."
(fset sym newdef))
-(defun byte-code-function-p (exp)
- "T if OBJECT is a byte-compiled function object."
- (and (consp exp)
- (let ((rest (cdr (cdr exp)))
+(defun byte-code-function-p (object)
+ "Return t if OBJECT is a byte-compiled function object."
+ (and (consp object)
+ (let ((rest (cdr (cdr object)))
elt)
(if (stringp (car rest))
(setq rest (cdr rest)))
(throw 'tag t))
(setq rest (cdr rest)))))))
+;; (symbol-plist 'cyclic-function-indirection)
+(put 'cyclic-function-indirection
+ 'error-conditions
+ '(cyclic-function-indirection error)
+(put 'cyclic-function-indirection
+ 'error-message
+ "Symbol's chain of function indirections contains a loop")
+
+;; The following function definition is a direct translation of its
+;; C definition in emacs-20.4/src/data.c.
+(defun indirect-function (object)
+ "Return the function at the end of OBJECT's function chain.
+If OBJECT is a symbol, follow all function indirections and return the final
+function binding.
+If OBJECT is not a symbol, just return it.
+Signal a void-function error if the final symbol is unbound.
+Signal a cyclic-function-indirection error if there is a loop in the
+function chain of symbols."
+ (let* ((hare object)
+ (tortoise hare))
+ (catch 'found
+ (while t
+ (or (symbolp hare) (throw 'found hare))
+ (or (fboundp hare) (signal 'void-function (cons object nil)))
+ (setq hare (symbol-function hare))
+ (or (symbolp hare) (throw 'found hare))
+ (or (fboundp hare) (signal 'void-function (cons object nil)))
+ (setq hare (symbol-function hare))
+
+ (setq tortoise (symbol-function tortoise))
+
+ (if (eq hare tortoise)
+ (signal 'cyclic-function-indirection (cons object nil)))))
+ hare))
+
;;; Emulate all functions and macros of emacs-20.3/lisp/byte-run.el.
;;; (note: jwz's original compiler and XEmacs compiler have some more
;;; macros; they are "nuked" by rms in FSF version.)
(mnames '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
(wnames '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
- days dd yyyy mm HH MM SS)
+ days dd yyyy lyear mm HH MM SS)
(if (consp low)
(setq low (car low)))
(or (integerp high)
(if (= high 1)
(setq low (+ 65536 low)))
(setq mm 0)
- (setq uru (and (zerop (% yyyy 4))
- (or (not (zerop (% yyyy 100)))
- (zerop (% yyyy 400)))))
+ (setq lyear (and (zerop (% yyyy 4))
+ (or (not (zerop (% yyyy 100)))
+ (zerop (% yyyy 400)))))
(while (> (- dd (nth mm mdays)) 0)
- (if (and (eq mm 1) uru)
+ (if (and (= mm 1) lyear)
(setq dd (- dd 29))
(setq dd (- dd (nth mm mdays))))
(setq mm (1+ mm)))
ct2 (- ct2 65536)))
(list ct1 ct2 0)))
+;;; @@ Floating point numbers.
+;;;
+
+(defalias 'numberp 'integerp)
+
+(defun abs (arg)
+ "Return the absolute value of ARG."
+ (if (< arg 0) (- arg) arg))
+
;;; @ Basic lisp subroutines.
;;;