(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED "27-Jul-90 07:54:13" |{DSK}<usr>local>lde>loops>src>SYSTEM>LOOPS-PATCH.;2|
 3635   

      |changes| |to:|  (VARS LOOPS-PATCHCOMS)

      |previous| |date:| "27-Jun-88 12:03:25" |{DSK}<usr>local>lde>loops>src>SYSTEM>LOOPS-PATCH.;1|
)


; Copyright (c) 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT LOOPS-PATCHCOMS)

(RPAQQ LOOPS-PATCHCOMS ((* |;;;| "Some simple optimizations missing from the compiler.") (* |;;| "") (* |;;| "Shift by a constant.") (* |;;| "Unfortunately, these cause the compiler to generate spurious warning messages about \"Unknown function IL:LLSH1 called from ...\"  It's not often you come across a place where COMPILER-LET is really needed.") (VARIABLES XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION*) (FUNCTIONS LRSH1 LRSH8 LLSH1 LLSH8) (OPTIMIZERS (LRSH :OPTIMIZED-BY RIGHT-SHIFT-BY-CONSTANT) (LLSH :OPTIMIZED-BY LEFT-SHIFT-BY-CONSTANT)) (* |;;| "")))



(* |;;;| "Some simple optimizations missing from the compiler.")





(* |;;| "")





(* |;;| "Shift by a constant.")





(* |;;| 
"Unfortunately, these cause the compiler to generate spurious warning messages about \"Unknown function IL:LLSH1 called from ...\"  It's not often you come across a place where COMPILER-LET is really needed."
)



(CL:DEFVAR XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION* NIL "Marker used for informing the shift-by-constant optimizers that they are in the shift function, and should not optimize.")

(CL:DEFUN LRSH1 (XCL-USER::X) (CL:COMPILER-LET ((XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION* T)) (LRSH XCL-USER::X 1)))

(CL:DEFUN LRSH8 (XCL-USER::X) (CL:COMPILER-LET ((XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION* T)) (LRSH XCL-USER::X 8)))

(CL:DEFUN LLSH1 (XCL-USER::X) (CL:COMPILER-LET ((XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION* T)) (LLSH XCL-USER::X 1)))

(CL:DEFUN LLSH8 (XCL-USER::X) (CL:COMPILER-LET ((XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION* T)) (LLSH XCL-USER::X 8)))

(DEFOPTIMIZER LRSH RIGHT-SHIFT-BY-CONSTANT (XCL-USER::X XCL-USER::N &ENVIRONMENT XCL-USER::ENV) (CL:IF (AND (CL:CONSTANTP XCL-USER::N) (NOT XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION*)) (LET ((XCL-USER::SHIFT-FACTOR (CL:EVAL XCL-USER::N))) (COND ((NOT (CL:NUMBERP XCL-USER::SHIFT-FACTOR)) (CL:ERROR "Non-numeric arg to ~S, ~S" (QUOTE LRSH) XCL-USER::SHIFT-FACTOR)) ((= XCL-USER::SHIFT-FACTOR 0) XCL-USER::X) ((< XCL-USER::SHIFT-FACTOR 0) (BQUOTE (LLSH (\\\, XCL-USER::X) (\\\, (- XCL-USER::SHIFT-FACTOR))))) ((< XCL-USER::SHIFT-FACTOR 8) (BQUOTE (LRSH (LRSH1 (\\\, XCL-USER::X)) (\\\, (CL:1- XCL-USER::SHIFT-FACTOR))))) (T (BQUOTE (LRSH (LRSH8 (\\\, XCL-USER::X)) (\\\, (- XCL-USER::SHIFT-FACTOR 8))))))) (QUOTE COMPILER:PASS)))

(DEFOPTIMIZER LLSH LEFT-SHIFT-BY-CONSTANT (XCL-USER::X XCL-USER::N &ENVIRONMENT XCL-USER::ENV) (CL:IF (AND (CL:CONSTANTP XCL-USER::N) (NOT XCL-USER::*IGNORE-SHIFT-BY-CONSTANT-OPTIMIZATION*)) (LET ((XCL-USER::SHIFT-FACTOR (CL:EVAL XCL-USER::N))) (COND ((NOT (CL:NUMBERP XCL-USER::SHIFT-FACTOR)) (CL:ERROR "Non-numeric arg to ~S, ~S" (QUOTE LLSH) XCL-USER::SHIFT-FACTOR)) ((= XCL-USER::SHIFT-FACTOR 0) XCL-USER::X) ((< XCL-USER::SHIFT-FACTOR 0) (BQUOTE (LRSH (\\\, XCL-USER::X) (\\\, (- XCL-USER::SHIFT-FACTOR))))) ((< XCL-USER::SHIFT-FACTOR 8) (BQUOTE (LLSH (LLSH1 (\\\, XCL-USER::X)) (\\\, (CL:1- XCL-USER::SHIFT-FACTOR))))) (T (BQUOTE (LLSH (LLSH8 (\\\, XCL-USER::X)) (\\\, (- XCL-USER::SHIFT-FACTOR 8))))))) (QUOTE COMPILER:PASS)))



(* |;;| "")


(PUTPROPS LOOPS-PATCH COPYRIGHT ("Venue & Xerox Corporation" 1988 1990))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP