/[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.19 by camm, Mon Aug 8 23:01:36 2005 UTC revision 1.20 by camm, Sun Sep 18 01:56:09 2005 UTC
# Line 119  Line 119 
119     (get 'system:aset 'inline-unsafe))     (get 'system:aset 'inline-unsafe))
120  (push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)")  (push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)")
121     (get 'system:aset 'inline-unsafe))     (get 'system:aset 'inline-unsafe))
122  (push '(((array string-char) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")  (push '(((array character) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")
123     (get 'system:aset 'inline-unsafe))     (get 'system:aset 'inline-unsafe))
124  (push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)")  (push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)")
125     (get 'system:aset 'inline-unsafe))     (get 'system:aset 'inline-unsafe))
# Line 142  Line 142 
142  (push '(((array t) fixnum fixnum t) t #.(flags set)  (push '(((array t) fixnum fixnum t) t #.(flags set)
143    "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")    "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")
144     (get 'system:aset 'inline-unsafe))     (get 'system:aset 'inline-unsafe))
145  (push '(((array string-char) fixnum fixnum character) character  (push '(((array character) fixnum fixnum character) character
146          #.(flags rfa set)          #.(flags rfa set)
147    "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")    "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")
148     (get 'system:aset 'inline-unsafe))     (get 'system:aset 'inline-unsafe))
# Line 399  Line 399 
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 character) 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))
# Line 422  Line 422 
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 character) 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)
# Line 448  Line 448 
448  ;   (get 'row-major-aref 'inline-unsafe))  ;   (get 'row-major-aref 'inline-unsafe))
449    
450  ;;CMP-AREF  ;;CMP-AREF
451    (setf (symbol-function 'cmp-aref) (symbol-function 'row-major-aref))
452  (si::putprop 'cmp-aref 'aref-propagator 'type-propagator)  (si::putprop 'cmp-aref 'aref-propagator 'type-propagator)
453  (push '(cmp-aref-inline-types nil #.(flags itf) cmp-aref-inline)  (push '(cmp-aref-inline-types nil #.(flags itf) cmp-aref-inline)
454     (get 'cmp-aref 'inline-always))     (get 'cmp-aref 'inline-always))
455    
456  ;;CMP-ASET  ;;CMP-ASET
457    (setf (symbol-function 'cmp-aset) (symbol-function 'si::aset1))
458  (si::putprop 'cmp-aset 'aref-propagator 'type-propagator)  (si::putprop 'cmp-aset 'aref-propagator 'type-propagator)
459  (push '(cmp-aset-inline-types nil #.(flags itf) cmp-aset-inline)  (push '(cmp-aset-inline-types nil #.(flags itf) cmp-aset-inline)
460     (get 'cmp-aset 'inline-always))     (get 'cmp-aset 'inline-always))
# Line 463  Line 465 
465  ;   (get 'array-dimension 'inline-unsafe))  ;   (get 'array-dimension 'inline-unsafe))
466    
467  ;;CMP-ARRAY-DIMENSION  ;;CMP-ARRAY-DIMENSION
468    (setf (symbol-function 'cmp-array-dimension) (symbol-function 'array-dimension))
469  (push '(cmp-array-dimension-inline-types nil #.(flags itf) cmp-array-dimension-inline)  (push '(cmp-array-dimension-inline-types nil #.(flags itf) cmp-array-dimension-inline)
470     (get 'cmp-array-dimension 'inline-always))     (get 'cmp-array-dimension 'inline-always))
471    
# Line 803  Line 806 
806    
807    
808  ;;FILL-POINTER  ;;FILL-POINTER
809   (push '((t) fixnum #.(flags rfa)"((#0)->st.st_fillp)")   (push '((t) seqind #.(flags rfa)"((#0)->v.v_fillp)")
810     (get 'fill-pointer 'inline-unsafe))     (get 'fill-pointer 'inline-unsafe))
811     (push '((vector) seqind #.(flags rfa)"((#0)->v.v_fillp)")
812       (get 'fill-pointer 'inline-always))
813    
814    ;;ARRAY-HAS-FILL-POINTER-P
815     (push '((t) boolean #.(flags rfa)"((#0)->v.v_hasfillp)")
816       (get 'array-has-fill-pointer-p 'inline-unsafe))
817     (push '((vector) boolean #.(flags rfa)"((#0)->v.v_hasfillp)")
818       (get 'array-has-fill-pointer-p 'inline-always))
819    
820  ;;FIRST  ;;FIRST
821   (push '((t) t #.(flags)"car(#0)")   (push '((t) t #.(flags)"car(#0)")
# Line 877  Line 888 
888  ;;LENGTH  ;;LENGTH
889   (push '((t) seqind #.(flags rfa set)"length(#0)")   (push '((t) seqind #.(flags rfa set)"length(#0)")
890     (get 'length 'inline-always))     (get 'length 'inline-always))
891  (push '(((array t)) seqind #.(flags rfa)"(#0)->v.v_fillp")  (push '((vector) seqind #.(flags rfa)"(#0)->v.v_fillp")
    (get 'length 'inline-unsafe))  
 (push '(((array fixnum)) seqind #.(flags rfa)"(#0)->v.v_fillp")  
    (get 'length 'inline-unsafe))  
 (push '((string) seqind #.(flags rfa)"(#0)->v.v_fillp")  
892     (get 'length 'inline-unsafe))     (get 'length 'inline-unsafe))
893    ;(push '(((array t)) seqind #.(flags rfa)"(#0)->v.v_fillp")
894    ;   (get 'length 'inline-unsafe))
895    ;(push '(((array fixnum)) seqind #.(flags rfa)"(#0)->v.v_fillp")
896    ;   (get 'length 'inline-unsafe))
897    ;(push '((string) seqind #.(flags rfa)"(#0)->v.v_fillp")
898    ;   (get 'length 'inline-unsafe))
899    
900  ;;LIST  ;;LIST
901   (push '(nil t #.(flags)"Cnil")   (push '(nil t #.(flags)"Cnil")
# Line 1170  TRUNCATE_USE_C Line 1183  TRUNCATE_USE_C
1183    "@0;({enum type _tp=type_of(#0);_tp>=t_string && _tp<=t_vector;})")    "@0;({enum type _tp=type_of(#0);_tp>=t_string && _tp<=t_vector;})")
1184     (get 'vectorp 'inline-always))     (get 'vectorp 'inline-always))
1185    
1186    ;;FUNCTIONP
1187     (push '((t) boolean #.(flags)
1188      "@0;({enum type _tp=type_of(#0);_tp>=t_ifun && _tp<=t_closure;})")
1189       (get 'functionp 'inline-always))
1190    
1191    ;;FUNCTIONP
1192     (push '((t) boolean #.(flags)
1193      "@0;({enum type _tp=type_of(#0);_tp>=t_cfun && _tp<=t_closure;})")
1194       (get 'compiled-function-p 'inline-always))
1195    
1196  ;;WRITE-CHAR  ;;WRITE-CHAR
1197   (push '((t) t #.(flags set)   (push '((t) t #.(flags set)
1198    "@0;(writec_stream(char_code(#0),Vstandard_output->s.s_dbind),(#0))")    "@0;(writec_stream(char_code(#0),Vstandard_output->s.s_dbind),(#0))")
# Line 1202  TRUNCATE_USE_C Line 1225  TRUNCATE_USE_C
1225   (push '((t) t #.(flags) "(#0)")   (push '((t) t #.(flags) "(#0)")
1226     (get 'identity 'inline-always))     (get 'identity 'inline-always))
1227    
1228    ;;SI::NEXT-HASH-TABLE-INDEX
1229     (push '((t t) fixnum #.(flags rfa)
1230             "({fixnum _i;for (_i=fix(#1);_i<(#0)->ht.ht_size && (#0)->ht.ht_self[_i].hte_key==OBJNULL;_i++);_i==(#0)->ht.ht_size ? -1 : _i;})")
1231       (get 'si::next-hash-table-index 'inline-unsafe))
1232     (push '((t fixnum) fixnum #.(flags rfa)
1233             "({fixnum _i;for (_i=(#1);_i<(#0)->ht.ht_size && (#0)->ht.ht_self[_i].hte_key==OBJNULL;_i++);_i==(#0)->ht.ht_size ? -1 : _i;})")
1234       (get 'si::next-hash-table-index 'inline-unsafe))
1235    
1236    ;;SI::HASH-ENTRY-BY-INDEX
1237     (push '((t t) t #.(flags) "(#0)->ht.ht_self[fix(#1)].hte_value")
1238       (get 'si::hash-entry-by-index 'inline-unsafe))
1239     (push '((t fixnum) t #.(flags) "(#0)->ht.ht_self[(#1)].hte_value")
1240       (get 'si::hash-entry-by-index 'inline-unsafe))
1241    
1242    ;;SI::HASH-KEY-BY-INDEX
1243     (push '((t t) t #.(flags) "(#0)->ht.ht_self[fix(#1)].hte_key")
1244       (get 'si::hash-key-by-index 'inline-unsafe))
1245     (push '((t fixnum) t #.(flags) "(#0)->ht.ht_self[(#1)].hte_key")
1246       (get 'si::hash-key-by-index 'inline-unsafe))
1247    
1248  ;;GETHASH  ;;GETHASH
1249  (push '((t t *) (values t t) #.(flags)(lambda (key hash &optional default)  (push '((t t *) (values t t) #.(flags)(lambda (key hash &optional default)
1250                                  (let ((*value-to-go* (or                                  (let ((*value-to-go* (or

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20

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