From: Paul Pogonyshev <pogonyshev@gmx.net>
Cc: emacs-devel@gnu.org
Subject: Re: byte-code optimizations
Date: Sun, 19 Sep 2004 14:15:11 -0200 [thread overview]
Message-ID: <200409191412.50820.pogonyshev@gmx.net> (raw)
In-Reply-To: <m14qlvmknm.fsf-monnier+emacs@gnu.org>
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.)
next prev parent reply other threads:[~2004-09-19 16:15 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-09-18 13:52 byte-code optimizations Paul Pogonyshev
2004-09-18 20:26 ` Stefan
2004-09-19 11:00 ` Richard Stallman
2004-09-19 16:15 ` Paul Pogonyshev [this message]
2004-09-21 18:31 ` Richard Stallman
2004-09-22 0:42 ` Paul Pogonyshev
2004-09-21 21:05 ` Stefan Monnier
2004-09-21 21:15 ` Miles Bader
2004-09-22 3:31 ` Paul Pogonyshev
2004-09-21 22:57 ` Miles Bader
2004-09-22 3:25 ` Paul Pogonyshev
2004-09-22 18:20 ` Richard Stallman
2004-09-23 0:33 ` Paul Pogonyshev
2004-09-18 22:55 ` Richard Stallman
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=200409191412.50820.pogonyshev@gmx.net \
--to=pogonyshev@gmx.net \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.