Removed inliner for ASH, as well as for C-INLINE forms, which are now a braced statement

src/CHANGELOG

@@ -60,6 +60,8 @@ ECL 1.0:
 
 * Bugs fixed:
 
+ - Remove ancient, bogus optimizers for: ASH, LDB.
+
  - MINGW's compiler is broken: it does not accept directories with trailing
    slashes as an argument to "-I". We include a hack in cmpmain.lsp for that.
 

src/cmp/cmpfun.lsp

@@ -201,30 +201,6 @@
 		 (6 (list 'CDDR (cons 'CDDDDR (cdr args))))
 		 (7 (list 'CDDDR (cons 'CDDDDR (cdr args))))))))
 
-;----------------------------------------------------------------------
-
-(defun co1ash (args)
-  (let ((shamt (second args)) type fun)
-    (when (cond ((and (constantp shamt)
-		      (sys::fixnump (setq shamt (eval shamt))))
-		 (setq fun (if (< shamt 0) 'SHIFT>> 'SHIFT<<)))
-		((and (consp shamt)
-		      (eq (car shamt) 'THE)
-		      (or (subtypep (setq type (second shamt))
-				    '(INTEGER 0 100))
-			  (and (boundp 'SYS::*ASH->>*) sys::*ash->>*
-			       (subtypep type '(INTEGER -100 0)))))
-		 (setq fun
-		       ;; it had to be a (the type..)
-		       (cond ((subtypep type '(INTEGER 0 100))
-			      'SHIFT<<)
-			     ((subtypep type '(INTEGER -100 0))
-			      'SHIFT>>)))))
-      (c1expr (cons fun args)))))
-
-(setf (symbol-function 'shift<<) #'ash)
-(setf (symbol-function 'shift>>) #'ash)
-
 ;;----------------------------------------------------------------------
 ;; We transform BOOLE into the individual operations, which have
 ;; inliners
@@ -358,7 +334,6 @@
 (put-sysprop 'nth 'C1CONDITIONAL 'co1nth)
 (put-sysprop 'nthcdr 'C1CONDITIONAL 'co1nthcdr)
 
-(put-sysprop 'ash 'C1CONDITIONAL 'co1ash)
 (put-sysprop 'coerce 'C1CONDITIONAL 'co1coerce)
 (put-sysprop 'cons 'C1CONDITIONAL 'co1cons)
 (put-sysprop 'ldb 'C1CONDITIONAL 'co1ldb)

src/cmp/cmpinline.lsp

@@ -70,28 +70,22 @@
 		(arg-locs (inline-args args))
 		(loc (inline-function fname arg-locs return-type)))
 	   (if loc
-	       (progn
-		 ;; If there are side effects, we may not move the C form
-		 ;; around and we have to save its value in a variable.
-		 ;; We use a variable of type out-type to save the value
-		 ;; if (return-type >= out-type)
-		 ;; then
-		 ;;   coerce the value to out-type
-		 ;; otherwise
-		 ;;   save the value without coercion and return the
-		 ;;   variable tagged with and-type,
-		 ;;   so that whoever uses it may coerce it to such type
-		 (when (and (consp loc)
-			    (eq (first loc) 'C-INLINE)
-			    (not (all-locations (rest forms)))
-			    (or (need-to-protect (rest forms))
-				(fifth loc))) ; side effects?
-		   (let* ((and-type (type-and return-type (loc-type loc)))
-			  (out-rep-type (loc-representation-type loc))
-			  (var (make-lcl-var :rep-type out-rep-type :type and-type)))
-		     (wt-nl "{" (rep-type-name out-rep-type) " " var "= " loc ";")
-		     (incf *inline-blocks*)
-		     (setq loc var)))
+	       ;; If there are side effects, we may not move the C form
+	       ;; around and we have to save its value in a variable.
+	       ;; We use a variable of type out-type to save the value
+	       ;; if (return-type >= out-type)
+	       ;; then
+	       ;;   coerce the value to out-type
+	       ;; otherwise
+	       ;;   save the value without coercion and return the
+	       ;;   variable tagged with and-type,
+	       ;;   so that whoever uses it may coerce it to such type
+	       (let* ((and-type (type-and return-type (loc-type loc)))
+		      (out-rep-type (loc-representation-type loc))
+		      (var (make-lcl-var :rep-type out-rep-type :type and-type)))
+		 (wt-nl "{" (rep-type-name out-rep-type) " " var "= " loc ";")
+		 (incf *inline-blocks*)
+		 (setq loc var)
 		 (push (list (loc-type loc) loc) locs))
 	       ;; FIXME! Why is (make-temp-var) before rebinding of *temp*???
 	       (let* ((temp (make-temp-var))

src/cmp/sysfun.lsp

@@ -846,7 +846,7 @@
 (proclaim-function logbitp (t t) t :predicate t :no-side-effects t)
 (def-inline logbitp :always ((integer -29 29) fixnum) :bool "(#1 >> #0) & 1")
 
-(proclaim-function ash (t t) t)
+(proclaim-function ash (integer integer) t)
 (proclaim-function logcount (t) t)
 (proclaim-function integer-length (t) fixnum)
 (proclaim-function si:bit-array-op (*) t)