/[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.9 by camm, Tue Nov 30 03:54:40 2004 UTC revision 1.10 by camm, Tue Dec 14 03:34:06 2004 UTC
# Line 6  Line 6 
6  ;; ( arglist result-type flags {string | function})  ;; ( arglist result-type flags {string | function})
7    
8  ;; meaning of the flags slot.  ;; meaning of the flags slot.
9  ;       '((allocates-new-storage ans); might invoke gbc  ;;       '((allocates-new-storage ans)          ;; might invoke gbc
10  ;        (side-effect-p set)        ; no effect on arguments  ;;       (side-effect-p set)                    ;; no effect on arguments
11  ;        (constantp)                ; always returns same result,  ;;       (constantp)                            ;; always returns same result,
12  ;                                   ;double eval ok.  ;;                                              ;; double eval ok.
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    ;;       (result-type-from-bounded-args rfba))) ;; result bounds inferred from arg bounds
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 252  Line 253 
253  (push '((fixnum fixnum) fixnum #.(flags)"(#0)*(#1)")  (push '((fixnum fixnum) fixnum #.(flags)"(#0)*(#1)")
254     (get '* 'inline-always))     (get '* 'inline-always))
255    
256    (push '((fixnum fixnum) fixnum #.(flags rfba)"(#0)*(#1)")
257       (get '* 'inline-always))
258    
259  ;;+  ;;+
260  (push '((t t) t #.(flags ans)"number_plus(#0,#1)")  (push '((t t) t #.(flags ans)"number_plus(#0,#1)")
# Line 265  Line 268 
268  (push '((short-float short-float) short-float #.(flags rfa)"(#0)+(#1)")  (push '((short-float short-float) short-float #.(flags rfa)"(#0)+(#1)")
269     (get '+ 'inline-always))     (get '+ 'inline-always))
270    
   
271  (push '((fixnum fixnum) fixnum #.(flags)"(#0)+(#1)")  (push '((fixnum fixnum) fixnum #.(flags)"(#0)+(#1)")
272     (get '+ 'inline-always))     (get '+ 'inline-always))
273    
274    (push '((fixnum fixnum) fixnum #.(flags rfba)"(#0)+(#1)")
275       (get '+ 'inline-always))
276    
277  ;;-  ;;-
278   (push '((t) t #.(flags ans)"number_negate(#0)")   (push '((t) t #.(flags ans)"number_negate(#0)")
# Line 294  Line 298 
298  (push '((fixnum) fixnum #.(flags)"-(#0)")  (push '((fixnum) fixnum #.(flags)"-(#0)")
299     (get '- 'inline-always))     (get '- 'inline-always))
300    
301    (push '((fixnum fixnum) fixnum #.(flags rfba)"(#0)-(#1)")
302       (get '- 'inline-always))
303    
304    
305  ;;/  ;;/
306  (push '((fixnum fixnum) fixnum #.(flags)"(#0)/(#1)")  (push '((fixnum fixnum) fixnum #.(flags)"(#0)/(#1)")

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

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