[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: byte-code optimizations
From: |
Paul Pogonyshev |
Subject: |
Re: byte-code optimizations |
Date: |
Sun, 19 Sep 2004 14:15:11 -0200 |
User-agent: |
KMail/1.4.3 |
Stefan wrote:
> > + ;; dup varbind-X [car/cdr ...] unbind-1 --> [car/cdr ...]
>
> I get the same optimization result by adding
>
> car/cdr/equal/nth unbind --> unbind car/cdr/equal/nth
>
> Problem is that such an optimization is only safe if car/cdr/... is not
> affected by the bound thing. If the `unbind' unbinds a variable, then
> I think it's always safe. So I've added to the lapcode optimizer some
> logic to keep track of the specpdl stack so that I can distinguish an
> unbind that terminates a varbind from one that terminates an
> unwind-protect.
Seems like you are trying to solve this problem (in comment):
(defconst byte-after-unbind-ops
'(byte-constant byte-dup
byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
byte-eq byte-not
byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
byte-interactive-p)
;; How about other side-effect-free-ops? Is it safe to move an
;; error invocation (such as from nth) out of an unwind-protect?
;; No, it is not, because the unwind-protect forms can alter
;; the inside of the object to which nth would apply.
;; For the same reason, byte-equal was deleted from this list.
"Byte-codes that can be moved past an unbind.")
If you can properly track `unwind-protect' unbinds, then your
optimization is probably better.
> Better yet: you also get the exact same result code (without any lapcode
> optimization) if you use
>
> (defsubst* cddr (x) (cdr (cdr x)))
>
> I.e. using the `defubst*' (from CL).
Is there a reason to use `defsubst' then? Do `defsubst' and
`defsubst*' differ in result? (Frankly speaking, I cannot read
it.)
RMS wrote:
> In other words, it squeezes the unnecessary binding out of each
> `c[ad][ad]r'. Three commands per each substitution.
>
> I see, those wasteful operations come from defsubst expansion. Can
> you generalize your optimization so it is not limited to car and cdr
> operations in the middle? It ought to be simple to handle many other
> cases, as long as there are no jumps inside.
My latest version is below. I generalized it (skips all byte-codes
in `byte-compile-side-effect-free-dynamically-safe-ops' plus
`byte-varref' which reference another variable. I also implemented
the `binding-is-magic' property suggested in TODO section and a few
other generalizations.
However, we (actually Stefan) need to decide whether we want to try
optimizing unbinds without visible bindings. I.e. I'm optimizing
varbind-X ... unbind-N --> discard ... unbind-(N-1)
while Stefan suggests a more general
... unbind-1 --> unbind-1 ...
which is then followuped by other (existing) optimizations.
Paul
--- byte-opt.el 22 Mar 2004 13:21:08 -0200 1.75
+++ byte-opt.el 19 Sep 2004 14:00:27 -0200
@@ -1467,6 +1467,33 @@ of FORM by signalling the error at compi
byte-member byte-assq byte-quo byte-rem)
byte-compile-side-effect-and-error-free-ops))
+(defconst byte-compile-side-effect-free-dynamically-safe-ops
+ '(;; Same as `byte-compile-side-effect-free-ops' but without
+ ;; `byte-varref', `byte-symbol-value' and certain editing
+ ;; primitives.
+ byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp
+ byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
+ byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
+ byte-point-min byte-following-char byte-preceding-char
+ byte-eolp byte-eobp byte-bolp byte-bobp
+ ;;
+ byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
+ byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
+ byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
+ byte-plus byte-max byte-min byte-mult byte-char-after
+ byte-string= byte-string< byte-nthcdr byte-elt
+ byte-member byte-assq byte-quo byte-rem))
+
+(put 'debug-on-error 'binding-is-magic t)
+(put 'debug-on-abort 'binding-is-magic t)
+(put 'debug-on-next-call 'binding-is-magic t)
+(put 'inhibit-quit 'binding-is-magic t)
+(put 'quit-flag 'binding-is-magic t)
+(put 't 'binding-is-magic t)
+(put 'nil 'binding-is-magic t)
+(put 'gc-cons-threshold 'binding-is-magic t)
+(put 'track-mouse 'binding-is-magic t)
+
;; This crock is because of the way DEFVAR_BOOL variables work.
;; Consider the code
;;
@@ -1871,6 +1898,55 @@ If FOR-EFFECT is non-nil, the return val
(setq lap (delq lap0 lap))))
(setq keep-going t))
;;
+ ;; varbind-X [car/cdr/ ...] unbind-1 --> discard [car/cdr/ ...]
+ ;; varbind-X [car/cdr/ ...] unbind-N
+ ;; --> discard [car/cdr/ ...] unbind-(N-1)
+ ;;
+ ((and (eq 'byte-varbind (car lap1))
+ (not (get (cadr lap1) 'binding-is-magic)))
+ (setq tmp (cdr rest))
+ (while
+ (or
+ (memq (caar (setq tmp (cdr tmp)))
+ byte-compile-side-effect-free-dynamically-safe-ops)
+ (and (eq (caar tmp) 'byte-varref)
+ (not (eq (cadr (car tmp)) (cadr lap1))))))
+ (when (eq 'byte-unbind (caar tmp))
+ ;; Avoid evalling this crap when not logging anyway
+ (when (memq byte-optimize-log '(t lap))
+ (let ((format-string)
+ (args))
+ (if (and (= (aref byte-stack+-info (symbol-value (car
lap0)))
+ 1)
+ (memq (car lap0) side-effect-free))
+ (setq format-string
+ " %s %s [car/cdr/ ...] %s\t-->\t[car/cdr/ ...]"
+ args (list lap0 lap1 (car tmp)))
+ (setq format-string
+ " %s [car/cdr/ ...] %s\t-->\t%s [car/cdr/ ...]"
+ args (list lap1 (car tmp) (cons 'byte-discard 0))))
+ (when (> (cdar tmp) 1)
+ (setq format-string (concat format-string " %s"))
+ (nconc args (list (cons 'byte-unbind (1- (cdar tmp))))))
+ (apply 'byte-compile-log-lap-1 format-string args)))
+ ;; Do the real work
+ (if (and (= (aref byte-stack+-info (symbol-value (car lap0)))
+ 1)
+ (memq (car lap0) side-effect-free))
+ ;; Optimization: throw const/dup/... varbind right away.
+ (progn
+ (setcar rest (nth 2 rest))
+ (setcdr rest (nthcdr 3 rest)))
+ (setcar lap1 'byte-discard)
+ (setcdr lap1 0))
+ (if (= (cdar tmp) 1)
+ (progn
+ ;; Throw away unbind-1
+ (setcar tmp (nth 1 tmp))
+ (setcdr tmp (nthcdr 2 tmp)))
+ (setcdr (car tmp) (1- (cdar tmp))))
+ (setq keep-going t)))
+ ;;
;; X: varref-Y ... varset-Y goto-X -->
;; X: varref-Y Z: ... dup varset-Y goto-Z
;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
- byte-code optimizations, Paul Pogonyshev, 2004/09/18
- Re: byte-code optimizations, Stefan, 2004/09/18
- Re: byte-code optimizations, Richard Stallman, 2004/09/19
- Re: byte-code optimizations,
Paul Pogonyshev <=
- Re: byte-code optimizations, Richard Stallman, 2004/09/21
- Re: byte-code optimizations, Paul Pogonyshev, 2004/09/21
- Re: byte-code optimizations, Stefan Monnier, 2004/09/21
- Re: byte-code optimizations, Miles Bader, 2004/09/21
- Re: byte-code optimizations, Paul Pogonyshev, 2004/09/21
- Re: byte-code optimizations, Miles Bader, 2004/09/21
- Re: byte-code optimizations, Paul Pogonyshev, 2004/09/21
- Re: byte-code optimizations, Richard Stallman, 2004/09/22
- Re: byte-code optimizations, Paul Pogonyshev, 2004/09/22
Re: byte-code optimizations, Richard Stallman, 2004/09/18