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

Diff of /gcl/cmpnew/gcl_cmplam.lsp

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

revision 1.12 by camm, Sat Jul 23 08:48:11 2005 UTC revision 1.13 by camm, Mon Aug 8 23:00:19 2005 UTC
# Line 467  Line 467 
467    ;;; check arguments    ;;; check arguments
468    (when (or *safe-compile* *compiler-check-args*)    (when (or *safe-compile* *compiler-check-args*)
469      (cond ((or rest optionals)      (cond ((or rest optionals)
470             (when requireds             (when requireds
471               (wt-nl "if(vs_top-vs_base<" (length requireds)               (wt-nl "if(vs_top-vs_base<" (length requireds)
472                      ") too_few_arguments();"))                      ") too_few_arguments();"))
473             (unless rest             (unless rest
474               (wt-nl "if(vs_top-vs_base>"               (wt-nl "if(vs_top-vs_base>"
475                      (+ (length requireds) (length optionals))                      (+ (length requireds) (length optionals))
476                      ") too_many_arguments();")))                      ") too_many_arguments();")))
477            (t (wt-nl "check_arg(" (length requireds) ");"))))            (t (wt-nl "check_arg(" (length requireds) ");"))))
478      
479    ;;; Allocate the parameters.    ;;; Allocate the parameters.
480    (dolist** (var requireds) (setf (var-ref var) (vs-push)))    (dolist** (var requireds) (setf (var-ref var) (vs-push)))
481    (dolist** (opt optionals) (setf (var-ref (car opt)) (vs-push)))    (dolist** (opt optionals) (setf (var-ref (car opt)) (vs-push)))
# Line 589  Line 589 
589          )          )
590    ;;; Check arguments.    ;;; Check arguments.
591    (when (and (or *safe-compile* *compiler-check-args*) requireds)    (when (and (or *safe-compile* *compiler-check-args*) requireds)
592          (when requireds      (when requireds
593                (wt-nl "if(vs_top-vs_base<" (length requireds)        (wt-nl "if(vs_top-vs_base<" (length requireds)
594                       ") too_few_arguments();")))               ") too_few_arguments();")))
595    
596    ;;; Allocate the parameters.    ;;; Allocate the parameters.
597    (dolist** (var requireds) (setf (var-ref var) (vs-push)))    (dolist** (var requireds) (setf (var-ref var) (vs-push)))
# Line 881  Line 881 
881    
882  (defun c2dm (whole env vl body  (defun c2dm (whole env vl body
883                     &aux (cvar (cs-push t t)))                     &aux (cvar (cs-push t t)))
884  ; FIXME Compile macros as sfn instead of cf -- need this to guarantee safe calls    (when (or *safe-compile* *compiler-check-args*)
885  ; CM 20040129      (wt-nl "check_arg(2);"))
 ;  (when (or *safe-compile* *compiler-check-args*)  
   (wt-nl "check_arg(2);")  
 ;    )  
886    (cond (whole (setf (var-ref whole) (vs-push)))    (cond (whole (setf (var-ref whole) (vs-push)))
887          (t (vs-push)))          (t (vs-push)))
888    (cond (env (setf (var-ref env) (vs-push)))    (cond (env (setf (var-ref env) (vs-push)))

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