/[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.13 by camm, Tue Dec 28 22:24:18 2004 UTC revision 1.14 by camm, Fri Jan 7 17:58:33 2005 UTC
# Line 13  Line 13 
13  ;;       (result-type-from-args rfa)            ;; if passed args of matching  ;;       (result-type-from-args rfa)            ;; if passed args of matching
14  ;;                                              ;; type result is of result type  ;;                                              ;; type result is of result type
15  ;;       (is)                                   ;; extends the `integer stack'.  ;;       (is)                                   ;; extends the `integer stack'.
16    ;;       (inline-types-function itf)))          ;; car of ii is a function returning match info
17  ;    (cond ((member flag v :test 'eq)  ;    (cond ((member flag v :test 'eq)
18  ;  ;
19  ;;;   valid properties are 'inline-always 'inline-safe 'inline-unsafe  ;;;   valid properties are 'inline-always 'inline-safe 'inline-unsafe
# Line 237  Line 238 
238     (get 'system:svset 'inline-unsafe))     (get 'system:svset 'inline-unsafe))
239    
240  ;;*  ;;*
241  (si::putprop '* 'super-range 'result-type-from-bounded-args)  (si::putprop '* 'super-range 'type-propagator)
242  (push '((t t) t #.(flags ans)"number_times(#0,#1)")  (push '((t t) t #.(flags ans)"number_times(#0,#1)")
243     (get '* 'inline-always))     (get '* 'inline-always))
244  (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 254 
254     (get '* 'inline-always))     (get '* 'inline-always))
255    
256  ;;ASH  ;;ASH
257  (si::putprop 'ash 'ash-propagator 'result-type-from-bounded-args)  (si::putprop 'ash 'ash-propagator 'type-propagator)
258  (push '(((integer 0 0) t) fixnum #.(flags rfa)"0")  (push '(((integer 0 0) t) fixnum #.(flags rfa)"0")
259     (get 'ash 'inline-always))     (get 'ash 'inline-always))
260  (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 267 
267    
268    
269  ;;+  ;;+
270  (si::putprop '+ 'super-range 'result-type-from-bounded-args)  (si::putprop '+ 'super-range 'type-propagator)
271  (push '((t t) t #.(flags ans)"number_plus(#0,#1)")  (push '((t t) t #.(flags ans)"number_plus(#0,#1)")
272     (get '+ 'inline-always))     (get '+ 'inline-always))
273  (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 283 
283     (get '+ 'inline-always))     (get '+ 'inline-always))
284    
285  ;;-  ;;-
286  (si::putprop '- 'super-range 'result-type-from-bounded-args)  (si::putprop '- 'super-range 'type-propagator)
287  (push '((t) t #.(flags ans)"number_negate(#0)")  (push '((t) t #.(flags ans)"number_negate(#0)")
288     (get '- 'inline-always))     (get '- 'inline-always))
289  (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 390  Line 391 
391     (get 'append 'inline-always))     (get 'append 'inline-always))
392    
393  ;;AREF  ;;AREF
394   (push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))")  ;(push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))")
395     (get 'aref 'inline-always))  ;   (get 'aref 'inline-always))
396  (push '((t fixnum) t #.(flags ans)"aref1(#0,#1)")  ;(push '((t fixnum) t #.(flags ans)"aref1(#0,#1)")
397     (get 'aref 'inline-always))  ;   (get 'aref 'inline-always))
398  (push '((t t) t #.(flags ans)"aref1(#0,fix(#1))")  ;(push '((t t) t #.(flags ans)"aref1(#0,fix(#1))")
399     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
400  (push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]")  ;(push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]")
401     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
402  (push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")  ;(push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")
403     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
404  (push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]")  ;(push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]")
405     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
406  (push '(((array unsigned-char) fixnum) fixnum #.(flags rfa)"(#0)->ust.ust_self[#1]")  ;(push '(((array unsigned-char) fixnum) fixnum #.(flags rfa)"(#0)->ust.ust_self[#1]")
407     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
408  (push '(((array signed-char) fixnum) fixnum #.(flags rfa)"SIGNED_CHAR((#0)->ust.ust_self[#1])")  ;(push '(((array signed-char) fixnum) fixnum #.(flags rfa)"SIGNED_CHAR((#0)->ust.ust_self[#1])")
409     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
410  (push '(((array unsigned-short) fixnum) fixnum #.(flags rfa)  ;(push '(((array unsigned-short) fixnum) fixnum #.(flags rfa)
411    "((unsigned short *)(#0)->ust.ust_self)[#1]")  ;  "((unsigned short *)(#0)->ust.ust_self)[#1]")
412     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
413  (push '(((array signed-short) fixnum) fixnum #.(flags rfa)"((short *)(#0)->ust.ust_self)[#1]")  ;(push '(((array signed-short) fixnum) fixnum #.(flags rfa)"((short *)(#0)->ust.ust_self)[#1]")
414     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
415  (push '(((array short-float) fixnum) short-float #.(flags rfa)"(#0)->sfa.sfa_self[#1]")  ;(push '(((array short-float) fixnum) short-float #.(flags rfa)"(#0)->sfa.sfa_self[#1]")
416     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
417  (push '(((array long-float) fixnum) long-float #.(flags rfa)"(#0)->lfa.lfa_self[#1]")  ;(push '(((array long-float) fixnum) long-float #.(flags rfa)"(#0)->lfa.lfa_self[#1]")
418     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
419  (push '((t t t) t #.(flags ans)  ;(push '((t t t) t #.(flags ans)
420    "@0;aref(#0,fix(#1)*(#0)->a.a_dims[1]+fix(#2))")  ;  "@0;aref(#0,fix(#1)*(#0)->a.a_dims[1]+fix(#2))")
421     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
422  (push '(((array t) fixnum fixnum) t #.(flags )  ;(push '(((array t) fixnum fixnum) t #.(flags )
423    "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]")  ;  "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]")
424     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
425  (push '(((array string-char) fixnum fixnum) character #.(flags rfa)  ;(push '(((array string-char) fixnum fixnum) character #.(flags rfa)
426    "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]")  ;  "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]")
427     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
428  (push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa)  ;(push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa)
429    "@0;(#0)->fixa.fixa_self[(#1)*(#0)->a.a_dims[1]+#2]")  ;  "@0;(#0)->fixa.fixa_self[(#1)*(#0)->a.a_dims[1]+#2]")
430     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
431  (push '(((array short-float) fixnum fixnum) short-float #.(flags rfa)  ;(push '(((array short-float) fixnum fixnum) short-float #.(flags rfa)
432    "@0;(#0)->sfa.sfa_self[(#1)*(#0)->a.a_dims[1]+#2]")  ;  "@0;(#0)->sfa.sfa_self[(#1)*(#0)->a.a_dims[1]+#2]")
433     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
434  (push '(((array long-float) fixnum fixnum) long-float #.(flags rfa)  ;(push '(((array long-float) fixnum fixnum) long-float #.(flags rfa)
435    "@0;(#0)->lfa.lfa_self[(#1)*(#0)->a.a_dims[1]+#2]")  ;  "@0;(#0)->lfa.lfa_self[(#1)*(#0)->a.a_dims[1]+#2]")
436     (get 'aref 'inline-unsafe))  ;   (get 'aref 'inline-unsafe))
437    
438    
439    ;(si::putprop 'aref 'aref-propagator 'type-propagator)
440    ;(push '((t *) t #.(flags rfba)aref-inline)
441    ;   (get 'aref 'inline-unsafe))
442    ;(push '(((array) *) t #.(flags rfba)aref-inline)
443    ;   (get 'aref 'inline-always))
444    
445    ;;ROW-MAJOR-AREF
446    ;(si::putprop 'row-major-aref 'aref-propagator 'type-propagator)
447    ;(push '(nil nil #.(flags rfba)row-major-aref-inline)
448    ;   (get 'row-major-aref 'inline-unsafe))
449    
450    ;;CMP-AREF
451    (si::putprop 'cmp-aref 'aref-propagator 'type-propagator)
452    (push '(cmp-aref-inline-types nil #.(flags itf) cmp-aref-inline)
453       (get 'cmp-aref 'inline-always))
454    
455    ;;CMP-ASET
456    (si::putprop 'cmp-aset 'aref-propagator 'type-propagator)
457    (push '(cmp-aset-inline-types nil #.(flags itf) cmp-aset-inline)
458       (get 'cmp-aset 'inline-always))
459    
460    
461    ;;ARRAY-DIMENSION
462    ;(push '((t fixnum) fixnum #.(flags rfa)"@01;(type_of(#0)==t_array ? (#0)->a.a_dims[(#1)] : (#0)->v.v_dim)")
463    ;   (get 'array-dimension 'inline-unsafe))
464    
465    ;;CMP-ARRAY-DIMENSION
466    (push '(cmp-array-dimension-inline-types nil #.(flags itf) cmp-array-dimension-inline)
467       (get 'cmp-array-dimension 'inline-always))
468    
469  ;;ARRAY-TOTAL-SIZE  ;;ARRAY-TOTAL-SIZE
470   (push '((t) fixnum #.(flags rfa)"((#0)->st.st_dim)")   (push '((t) fixnum #.(flags rfa)"((#0)->st.st_dim)")
# Line 798  type_of(#0)==t_bitvector") Line 830  type_of(#0)==t_bitvector")
830  ; (push '((fixnum fixnum) fixnum #.(flags rfa)  ; (push '((fixnum fixnum) fixnum #.(flags rfa)
831  ;  "@01;(#0>=0&&(#1)>0?(#0)/(#1):ifloor(#0,#1))")  ;  "@01;(#0>=0&&(#1)>0?(#0)/(#1):ifloor(#0,#1))")
832  ;   (get 'floor 'inline-always))  ;   (get 'floor 'inline-always))
833  (si::putprop 'floor 'floor-propagator 'result-type-from-bounded-args)  (si::putprop 'floor 'floor-propagator 'type-propagator)
834  (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa set)  (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa set)
835           "@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;})")           "@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;})")
836     (get 'floor 'inline-always))     (get 'floor 'inline-always))
837    
838  ;;CEILING  ;;CEILING
839  (si::putprop 'ceiling 'floor-propagator 'result-type-from-bounded-args)  (si::putprop 'ceiling 'floor-propagator 'type-propagator)
840  (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa set)  (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa set)
841           "@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;})")           "@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;})")
842     (get 'ceiling 'inline-always))     (get 'ceiling 'inline-always))
# Line 846  type_of(#0)==t_bitvector") Line 878  type_of(#0)==t_bitvector")
878    
879    
880  ;;LENGTH  ;;LENGTH
881   (push '((t) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"length(#0)")   (push '((t) seqind #.(flags rfa set)"length(#0)")
882     (get 'length 'inline-always))     (get 'length 'inline-always))
883  (push '(((array t)) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"(#0)->v.v_fillp")  (push '(((array t)) seqind #.(flags rfa)"(#0)->v.v_fillp")
884     (get 'length 'inline-unsafe))     (get 'length 'inline-unsafe))
885  (push '(((array fixnum)) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"(#0)->v.v_fillp")  (push '(((array fixnum)) seqind #.(flags rfa)"(#0)->v.v_fillp")
886     (get 'length 'inline-unsafe))     (get 'length 'inline-unsafe))
887  (push '((string) (integer 0 #.(ash most-positive-fixnum -2)) #.(flags rfa)"(#0)->v.v_fillp")  (push '((string) seqind #.(flags rfa)"(#0)->v.v_fillp")
888     (get 'length 'inline-unsafe))     (get 'length 'inline-unsafe))
889    
890  ;;LIST  ;;LIST
# Line 926  type_of(#0)==t_bitvector") Line 958  type_of(#0)==t_bitvector")
958     (get 'make-list 'inline-always))     (get 'make-list 'inline-always))
959    
960  ;;MAX  ;;MAX
961  (si::putprop 'max 'super-range 'result-type-from-bounded-args)  (si::putprop 'max 'super-range 'type-propagator)
962  (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)")
963     (get 'max 'inline-always))     (get 'max 'inline-always))
964   (push '((fixnum fixnum) fixnum #.(flags rfa set)"@01;((#0)>=(#1)?(#0):#1)")   (push '((fixnum fixnum) fixnum #.(flags rfa set)"@01;((#0)>=(#1)?(#0):#1)")
965     (get 'max 'inline-always))     (get 'max 'inline-always))
966    
967  ;;MIN  ;;MIN
968  (si::putprop 'min 'super-range 'result-type-from-bounded-args)  (si::putprop 'min 'super-range 'type-propagator)
969  (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)")
970     (get 'min 'inline-always))     (get 'min 'inline-always))
971  (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 1124  TRUNCATE_USE_C Line 1156  TRUNCATE_USE_C
1156    
1157  #+  #+
1158  TRUNCATE_USE_C  TRUNCATE_USE_C
1159  (si::putprop 'truncate 'floor-propagator 'result-type-from-bounded-args)  (si::putprop 'truncate 'floor-propagator 'type-propagator)
1160  (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa)"({fixnum _t=(#0)/(#1);$1(#0)-_t*(#1)$ _t;})")  (push '((fixnum fixnum) (values fixnum fixnum) #.(flags rfa)"({fixnum _t=(#0)/(#1);$1(#0)-_t*(#1)$ _t;})")
1161     (get 'truncate 'inline-always))     (get 'truncate 'inline-always))
1162  (push '((fixnum-float) fixnum #.(flags)"(fixnum)(#0)")  (push '((fixnum-float) fixnum #.(flags)"(fixnum)(#0)")

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

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