From 2f14563e081835deb086bbf2a2bfc20e14af3e67 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 3 Oct 1991 18:27:50 +0000 Subject: [PATCH] Added doc strings for DEFTRANSFORMs. --- compiler/srctran.lisp | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 31d47bd7c..a8e9dab05 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.28 1991/09/03 17:35:19 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.29 1991/10/03 18:27:50 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -63,6 +63,7 @@ ;;; things out. ;;; (deftransform complement ((fun) * * :node node) + "open code" (multiple-value-bind (min max) (function-type-nargs (continuation-type fun)) (cond @@ -76,7 +77,7 @@ '#'(lambda (&rest args) (not (apply fun args)))) (t - (give-up "Can't open-code COMPLEMENT of a non-fixed arg function."))))) + (give-up "Function doesn't have fixed argument count."))))) ;;;; List hackery: @@ -150,6 +151,7 @@ (defvar *extreme-nthcdr-open-code-limit* 20) (deftransform nthcdr ((n l) (unsigned-byte t) * :node node) + "convert NTHCDR to CAxxR" (unless (constant-continuation-p n) (give-up)) (let ((n (continuation-value n))) (when (> n @@ -785,6 +787,7 @@ (deftransform %ldb ((size posn int) (fixnum fixnum integer) (unsigned-byte #.vm:word-bits)) + "convert to inline logical ops" `(logand (ash int (- posn)) (ash ,(1- (ash 1 vm:word-bits)) (- size ,vm:word-bits)))) @@ -792,6 +795,7 @@ (deftransform %mask-field ((size posn int) (fixnum fixnum integer) (unsigned-byte #.vm:word-bits)) + "convert to inline logical ops" `(logand int (ash (ash ,(1- (ash 1 vm:word-bits)) (- size ,vm:word-bits)) @@ -805,6 +809,7 @@ (deftransform %dpb ((new size posn int) * (unsigned-byte #.vm:word-bits)) + "convert to inline logical ops" `(let ((mask (ldb (byte size 0) -1))) (logior (ash (logand new mask) posn) (logand int (lognot (ash mask posn)))))) @@ -812,6 +817,7 @@ (deftransform %dpb ((new size posn int) * (signed-byte #.vm:word-bits)) + "convert to inline logical ops" `(let ((mask (ldb (byte size 0) -1))) (logior (ash (logand new mask) posn) (logand int (lognot (ash mask posn)))))) @@ -819,6 +825,7 @@ (deftransform %deposit-field ((new size posn int) * (unsigned-byte #.vm:word-bits)) + "convert to inline logical ops" `(let ((mask (ash (ldb (byte size 0) -1) posn))) (logior (logand new mask) (logand int (lognot mask))))) @@ -826,6 +833,7 @@ (deftransform %deposit-field ((new size posn int) * (signed-byte #.vm:word-bits)) + "convert to inline logical ops" `(let ((mask (ash (ldb (byte size 0) -1) posn))) (logior (logand new mask) (logand int (lognot mask))))) @@ -870,6 +878,7 @@ ;;; Handle the case of a constant boole-code. ;;; (deftransform boole ((op x y)) + "convert to inline logical ops" (unless (constant-continuation-p op) (give-up "BOOLE code is not a constant.")) (let ((control (continuation-value op))) @@ -897,6 +906,7 @@ ;;; If arg is a constant power of two, turn * into a shift. ;;; (deftransform * ((x y) (integer integer)) + "convert x*2^k to shift" (unless (constant-continuation-p y) (give-up)) (let* ((y (continuation-value y)) (y-abs (abs y)) @@ -924,14 +934,17 @@ `(values (ash x ,shift) (logand x ,mask)))))))) (deftransform floor ((x y) (integer integer)) + "convert division by 2^k to shift" (frob y nil)) (deftransform ceiling ((x y) (integer integer)) + "convert division by 2^k to shift" (frob y t))) ;;; Do the same for mod. ;;; (deftransform mod ((x y) (integer integer)) + "convert remainder mod 2^k to LOGAND" (unless (constant-continuation-p y) (give-up)) (let* ((y (continuation-value y)) (y-abs (abs y)) @@ -946,6 +959,7 @@ ;;; If arg is a constant power of two, turn truncate into a shift and mask. ;;; (deftransform truncate ((x y) (integer integer)) + "convert division by 2^k to shift" (unless (constant-continuation-p y) (give-up)) (let* ((y (continuation-value y)) (y-abs (abs y)) @@ -966,6 +980,7 @@ ;;; And the same for rem. ;;; (deftransform rem ((x y) (integer integer)) + "convert remainder mod 2^k to LOGAND" (unless (constant-continuation-p y) (give-up)) (let* ((y (continuation-value y)) (y-abs (abs y)) @@ -987,6 +1002,7 @@ ;;;; Character operations: (deftransform char-equal ((a b) (base-character base-character)) + "open code" '(let* ((ac (char-code a)) (bc (char-code b)) (sum (logxor ac bc))) @@ -996,6 +1012,7 @@ (and (> sum 161) (< sum 213))))))) (deftransform char-upcase ((x) (base-character)) + "open code" '(let ((n-code (char-code x))) (if (and (> n-code #o140) ; Octal 141 is #\a. (< n-code #o173)) ; Octal 172 is #\z. @@ -1003,6 +1020,7 @@ x))) (deftransform char-downcase ((x) (base-character)) + "open code" '(let ((n-code (char-code x))) (if (and (> n-code 64) ; 65 is #\A. (< n-code 91)) ; 90 is #\Z. @@ -1062,6 +1080,7 @@ ;;; that case, otherwise give an efficency note. ;;; (deftransform eql ((x y)) + "convert to simpler equality predicate" (let ((x-type (continuation-type x)) (y-type (continuation-type y)) (char-type (specifier-type 'character)) @@ -1093,6 +1112,7 @@ ;;; be specified and identical. ;;; (deftransform = ((x y)) + "open code" (let ((x-type (continuation-type x)) (y-type (continuation-type y))) (if (and (numeric-type-p x-type) (numeric-type-p y-type) @@ -1108,7 +1128,7 @@ (and x-complexp (eq x-complexp (numeric-type-complexp y-type))))) '(eql x y) - (give-up "Operands might not be the same type, so can't open code.")))) + (give-up "Operands might not be the same type.")))) ;;; Numeric-Type-Or-Lose -- Interface @@ -1373,6 +1393,7 @@ ;;; (deftransform format ((stream control &rest args) ((or (member t) stream) simple-string &rest t)) + "convert to output primitives" (unless (constant-continuation-p control) (give-up "Control string is not a constant.")) (let* ((control (continuation-value control)) -- GitLab