/[gcl]/gcl/cmpnew/gcl_cmpopt.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpopt.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by camm, Fri Dec 17 21:29:29 2004 UTC revision 1.12 by camm, Tue Dec 21 04:49:47 2004 UTC
# Line 237  Line 237 
237     (get 'system:svset 'inline-unsafe))     (get 'system:svset 'inline-unsafe))
238    
239  ;;*  ;;*
240  (si::putprop '* t 'result-type-from-bounded-args)  (si::putprop '* 'super-range 'result-type-from-bounded-args)
241  (push '((t t) t #.(flags ans)"number_times(#0,#1)")  (push '((t t) t #.(flags ans)"number_times(#0,#1)")
242     (get '* 'inline-always))     (get '* 'inline-always))
243  (push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)*(double)(#1)")  (push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)*(double)(#1)")
# Line 253  Line 253 
253     (get '* 'inline-always))     (get '* 'inline-always))
254    
255  ;;ASH  ;;ASH
256  (si::putprop 'ash '(fixnum (integer #.most-negative-fixnum #.(integer-length most-positive-fixnum))) 'result-type-from-bounded-args)  (si::putprop 'ash 'ash-propagator 'result-type-from-bounded-args)
257  (push '(((integer 0 0) t) fixnum #.(flags rfa)"0")  (push '(((integer 0 0) t) fixnum #.(flags rfa)"0")
258     (get 'ash 'inline-always))     (get 'ash 'inline-always))
259  (push '((fixnum (integer 0 #.(integer-length most-positive-fixnum))) fixnum #.(flags)"((#0)<<(#1))")  (push '((fixnum (integer 0 #.(integer-length most-positive-fixnum))) fixnum #.(flags)"((#0)<<(#1))")
# Line 266  Line 266 
266    
267    
268  ;;+  ;;+
269  (si::putprop '+ t 'result-type-from-bounded-args)  (si::putprop '+ 'super-range 'result-type-from-bounded-args)
270  (push '((t t) t #.(flags ans)"number_plus(#0,#1)")  (push '((t t) t #.(flags ans)"number_plus(#0,#1)")
271     (get '+ 'inline-always))     (get '+ 'inline-always))
272  (push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)+(double)(#1)")  (push '((fixnum-float fixnum-float) short-float #.(flags)"(double)(#0)+(double)(#1)")
# Line 282  Line 282 
282     (get '+ 'inline-always))     (get '+ 'inline-always))
283    
284  ;;-  ;;-
285  (si::putprop '- t 'result-type-from-bounded-args)  (si::putprop '- 'super-range 'result-type-from-bounded-args)
286  (push '((t) t #.(flags ans)"number_negate(#0)")  (push '((t) t #.(flags ans)"number_negate(#0)")
287     (get '- 'inline-always))     (get '- 'inline-always))
288  (push '(((integer #.(1+ most-negative-fixnum) #.most-positive-fixnum)) fixnum #.(flags)"-(#0)")  (push '(((integer #.(1+ most-negative-fixnum) #.most-positive-fixnum)) fixnum #.(flags)"-(#0)")
# Line 798  type_of(#0)==t_bitvector") Line 798  type_of(#0)==t_bitvector")
798  ; (push '((fixnum fixnum) fixnum #.(flags rfa)  ; (push '((fixnum fixnum) fixnum #.(flags rfa)
799  ;  "@01;(#0>=0&&(#1)>0?(#0)/(#1):ifloor(#0,#1))")  ;  "@01;(#0>=0&&(#1)>0?(#0)/(#1):ifloor(#0,#1))")
800  ;   (get 'floor 'inline-always))  ;   (get 'floor 'inline-always))
801   (push '((fixnum fixnum) fixnum #.(flags rfa set)  (si::putprop 'floor 'floor-propagator 'result-type-from-bounded-args)
802    "@01;({fixnum _t=(#0)/(#1);((#1)<0  && (#0)<=0) || ((#1)>0 && (#0)>=0) || ((#1)*_t == (#0)) ? _t : _t - 1;})")  (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa set)
803             "@01;({fixnum _t=(#0)/(#1);_t=((#0)<=0 && (#1)<=0) || ((#0)>=0 && (#1)>=0) || ((#1)*_t==(#0)) ? _t : _t-1;$1((#0)-_t*(#1))$ _t;})")
804     (get 'floor 'inline-always))     (get 'floor 'inline-always))
805    
806    ;;CEILING
807    (si::putprop 'ceiling 'floor-propagator 'result-type-from-bounded-args)
808    (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa set)
809             "@01;({fixnum _t=(#0)/(#1);_t=((#0)<=0 && (#1)>=0) || ((#0)>=0 && (#1)<=0) || ((#1)*_t==(#0)) ? _t : _t+1;$1((#0)-_t*(#1))$ _t;})")
810       (get 'ceiling 'inline-always))
811    
812    
813  ;;FOURTH  ;;FOURTH
814   (push '((t) t #.(flags)"cadddr(#0)")   (push '((t) t #.(flags)"cadddr(#0)")
815     (get 'fourth 'inline-safe))     (get 'fourth 'inline-safe))
# Line 838  type_of(#0)==t_bitvector") Line 846  type_of(#0)==t_bitvector")
846    
847    
848  ;;LENGTH  ;;LENGTH
849   (push '((t) fixnum #.(flags rfa)"length(#0)")   (push '((t) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"length(#0)")
850     (get 'length 'inline-always))     (get 'length 'inline-always))
851  (push '(((array t)) fixnum #.(flags rfa)"(#0)->v.v_fillp")  (push '(((array t)) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"(#0)->v.v_fillp")
852     (get 'length 'inline-unsafe))     (get 'length 'inline-unsafe))
853  (push '(((array fixnum)) fixnum #.(flags rfa)"(#0)->v.v_fillp")  (push '(((array fixnum)) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"(#0)->v.v_fillp")
854     (get 'length 'inline-unsafe))     (get 'length 'inline-unsafe))
855  (push '((string) fixnum #.(flags rfa)"(#0)->v.v_fillp")  (push '((string) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"(#0)->v.v_fillp")
856     (get 'length 'inline-unsafe))     (get 'length 'inline-unsafe))
857    
858  ;;LIST  ;;LIST
# Line 919  type_of(#0)==t_bitvector") Line 927  type_of(#0)==t_bitvector")
927     (get 'make-list 'inline-always))     (get 'make-list 'inline-always))
928    
929  ;;MAX  ;;MAX
930  (si::putprop 'max t 'result-type-from-bounded-args)  (si::putprop 'max 'super-range 'result-type-from-bounded-args)
931  (push '((t t) t #.(flags set)"@01;(number_compare(#0,#1)>=0?(#0):#1)")  (push '((t t) t #.(flags set)"@01;(number_compare(#0,#1)>=0?(#0):#1)")
932     (get 'max 'inline-always))     (get 'max 'inline-always))
933   (push '((fixnum fixnum) fixnum #.(flags rfa set)"@01;((#0)>=(#1)?(#0):#1)")   (push '((fixnum fixnum) fixnum #.(flags rfa set)"@01;((#0)>=(#1)?(#0):#1)")
934     (get 'max 'inline-always))     (get 'max 'inline-always))
935    
936  ;;MIN  ;;MIN
937  (si::putprop 'min t 'result-type-from-bounded-args)  (si::putprop 'min 'super-range 'result-type-from-bounded-args)
938  (push '((t t) t #.(flags set)"@01;(number_compare(#0,#1)<=0?(#0):#1)")  (push '((t t) t #.(flags set)"@01;(number_compare(#0,#1)<=0?(#0):#1)")
939     (get 'min 'inline-always))     (get 'min 'inline-always))
940  (push '((fixnum fixnum) fixnum #.(flags rfa set)"@01;((#0)<=(#1)?(#0):#1)")  (push '((fixnum fixnum) fixnum #.(flags rfa set)"@01;((#0)<=(#1)?(#0):#1)")
# Line 1117  TRUNCATE_USE_C Line 1125  TRUNCATE_USE_C
1125    
1126  #+  #+
1127  TRUNCATE_USE_C  TRUNCATE_USE_C
1128  (push '((fixnum fixnum) fixnum #.(flags rfa)"(#0)/(#1)")  (si::putprop 'truncate 'floor-propagator 'result-type-from-bounded-args)
1129    (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa)"({fixnum _t=(#0)/(#1);$1(#0)-_t*(#1)$ _t;})")
1130     (get 'truncate 'inline-always))     (get 'truncate 'inline-always))
1131  (push '((fixnum-float) fixnum #.(flags)"(fixnum)(#0)")  (push '((fixnum-float) fixnum #.(flags)"(fixnum)(#0)")
1132     (get 'truncate 'inline-always))     (get 'truncate 'inline-always))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26