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

Diff of /gcl/cmpnew/gcl_cmpinline.lsp

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

revision 1.12 by camm, Mon Dec 27 22:09:12 2004 UTC revision 1.13 by camm, Tue Dec 28 22:24:18 2004 UTC
# Line 703  Line 703 
703    
704  ;;; Borrowed from CMPOPT.LSP  ;;; Borrowed from CMPOPT.LSP
705    
706    (defmacro can-allocate-on-stack ()
707      `(and (consp *value-to-go*)
708            (eq (car *value-to-go*) 'var)
709            (/= (var-dynamic (second *value-to-go*)) 0)))
710    
711  (defun list-inline (&rest x &aux tem (n (length x)))  (defun list-inline (&rest x &aux tem (n (length x)))
712     (cond ((setq tem    (let ((tem (can-allocate-on-stack)))
713                  (and (consp *value-to-go*)      (if tem
714                       (eq (car *value-to-go*) 'var)          (wt "(ALLOCA_CONS(" n "),ON_STACK_LIST(" n)
715                       (eq (var-type (second *value-to-go*)) :dynamic-extent)))        (wt "list(" (length x)))
716            (wt "(ALLOCA_CONS(" n "),ON_STACK_LIST(" n))      (dolist (loc x) (wt #\, loc))
717           (t (wt "list(" (length x))))      (wt #\))
718     (dolist (loc x) (wt #\, loc))      (if tem (wt #\)))))
719     (wt #\))  
720     (if tem (wt #\)))  (defun make-list-inline (n)
721  )    (let ((tem (can-allocate-on-stack)))
722        (if tem
723            (wt "({fixnum _t=" n ";(ALLOCA_CONS(_t),ON_STACK_LIST(_t));})")
724          (wt "make_list(" n ")"))))
725    
726    
727    (defun cons-inline (x y)
728      (let ((tem (can-allocate-on-stack)))
729        (if tem
730            (wt "ON_STACK_CONS(" x "," y ")")
731          (wt "make_cons(" x "," y ")"))))
732    
733    
734  (defun list*-inline (&rest x)  (defun list*-inline (&rest x)

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

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