/[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.2 by camm, Sun Sep 14 02:43:01 2003 UTC revision 1.3 by camm, Tue Sep 23 21:48:27 2003 UTC
# Line 843  Line 843 
843  (defun c1dm-bad-key (key)  (defun c1dm-bad-key (key)
844         (cmperr "Defmacro-lambda-list contains illegal use of ~s." key))         (cmperr "Defmacro-lambda-list contains illegal use of ~s." key))
845    
846    (defmacro maybe-wt-c2dm-bind-vl (vl cvar form end-form)
847      `(let ((ipos (file-position *compiler-output1*)))
848        ,form
849        (let ((npos (file-position *compiler-output1*)))
850         (c2dm-bind-vl ,vl ,cvar)
851         (if (eql npos (file-position *compiler-output1*))
852             (file-position *compiler-output1* ipos)
853          ,end-form))))
854    
855  (defun c2dm (whole env vl body  (defun c2dm (whole env vl body
856                     &aux (cvar (next-cvar)))                     &aux (cvar (next-cvar)))
857    (when (or *safe-compile* *compiler-check-args*)    (when (or *safe-compile* *compiler-check-args*)
# Line 855  Line 864 
864    (wt-nl "vs_top=sup;")    (wt-nl "vs_top=sup;")
865    (when whole (c2bind whole))    (when whole (c2bind whole))
866    (when env (c2bind env))    (when env (c2bind env))
867    (wt-nl "{object V" cvar "=base[0]->c.c_cdr;")    (maybe-wt-c2dm-bind-vl vl cvar (wt-nl "{object V" cvar "=base[0]->c.c_cdr;") (wt "}"))
   (c2dm-bind-vl vl cvar)  
   (wt "}")  
868    (c2expr body)    (c2expr body)
869    )    )
870    
# Line 879  Line 886 
886        (c2dm-reserve-vl v)        (c2dm-reserve-vl v)
887        (setf (var-ref v) (vs-push))))        (setf (var-ref v) (vs-push))))
888    
889  (defun c2dm-bind-vl (vl cvar  (defun c2dm-bind-vl (vl cvar
890                          &aux                          &aux
891                          (requireds (car vl)) (optionals (cadr vl))                          (requireds (car vl)) (optionals (cadr vl))
892                          (rest (caddr vl)) (key-flag (cadddr vl))                          (rest (caddr vl)) (key-flag (cadddr vl))
# Line 929  Line 936 
936                 (*ccb-vs* *ccb-vs*))                 (*ccb-vs* *ccb-vs*))
937                (c2dm-bind-init (cadr kwd) (caddr kwd))                (c2dm-bind-init (cadr kwd) (caddr kwd))
938                (when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) nil))                (when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) nil))
939                (wt-nl "} else {"))                (wt "} else {"))
940           (c2dm-bind-loc (cadr kwd) `(cvar ,cvar1))           (c2dm-bind-loc (cadr kwd) `(cvar ,cvar1))
941           (when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) t))           (when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) t))
942           (wt "}}")))           (wt-nl "}}")))
943    (when (and (or *safe-compile* *compiler-check-args*)    (when (and (or *safe-compile* *compiler-check-args*)
944               (null rest)               (null rest)
945               (null key-flag))               (null key-flag))
# Line 951  Line 958 
958  (defun c2dm-bind-loc (v loc)  (defun c2dm-bind-loc (v loc)
959    (if (consp v)    (if (consp v)
960        (let ((cvar (next-cvar)))        (let ((cvar (next-cvar)))
961             (wt-nl "{object V" cvar "= " loc ";")             (maybe-wt-c2dm-bind-vl v cvar (wt-nl "{object V" cvar "= " loc ";") (wt "}")))
            (c2dm-bind-vl v cvar)  
            (wt "}"))  
962        (c2bind-loc v loc)))        (c2bind-loc v loc)))
963    
964  (defun c2dm-bind-init (v init)  (defun c2dm-bind-init (v init)
# Line 961  Line 966 
966        (let* ((*vs* *vs*) (*inline-blocks* 0)        (let* ((*vs* *vs*) (*inline-blocks* 0)
967               (cvar (next-cvar))               (cvar (next-cvar))
968               (loc (car (inline-args (list init) '(t)))))               (loc (car (inline-args (list init) '(t)))))
969              (wt-nl "{object V" cvar "= " loc ";")         (maybe-wt-c2dm-bind-vl v cvar (wt-nl "{object V" cvar "= " loc ";") (wt "}"))
970              (c2dm-bind-vl v cvar)         (close-inline-blocks))
             (wt "}")  
             (close-inline-blocks))  
971        (c2bind-init v init)))        (c2bind-init v init)))
972    
973    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

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