mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

silly "optimization" in (language assembly)

Browse source 
* module/language/assembly.scm (byte-length): Silly, minor tweak: put
  the fixed-length instruction case first.  Seems to shave some 10% off
  the time compiling psyntax.scm (when the whole rest of the system is
  compiled, of course).
This commit is contained in:
Andy Wingo 2011-05-05 10:09:48 +02:00
parent 2d239a78d4
commit 81f529091b
1 changed files with 5 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

10
module/language/assembly.scm
View file

@ -1,6 +1,6 @@
;;; Guile Virtual Machine Assembly ;;; Guile Virtual Machine Assembly
;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -37,8 +37,8 @@
(define (byte-length assembly) (define (byte-length assembly)
(pmatch assembly (pmatch assembly
(,label (guard (not (pair? label))) ((,inst . _) (guard (>= (instruction-length inst) 0))
0) (+ 1 (instruction-length inst)))
((load-number ,str) ((load-number ,str)
(+ 1 *len-len* (string-length str))) (+ 1 *len-len* (string-length str)))
((load-string ,str) ((load-string ,str)
@ -51,8 +51,8 @@
(+ 1 *len-len* (bytevector-length bv))) (+ 1 *len-len* (bytevector-length bv)))
((load-program ,labels ,len ,meta . ,code) ((load-program ,labels ,len ,meta . ,code)
(+ 1 *program-header-len* len (if meta (1- (byte-length meta)) 0))) (+ 1 *program-header-len* len (if meta (1- (byte-length meta)) 0)))
((,inst . _) (guard (>= (instruction-length inst) 0)) (,label (guard (not (pair? label)))
(+ 1 (instruction-length inst))) 0)
(else (error "unknown instruction" assembly)))) (else (error "unknown instruction" assembly))))