(FILECREATED "10-Sep-86 21:10:22" {ERIS}<LISPCORE>LIBRARY>CMLMVS.;24
 5917   

      changes to:  (FUNCTIONS MULTIPLE-VALUE-SETQ)

      previous date: " 5-Jun-86 00:10:36" {ERIS}<LISPCORE>LIBRARY>CMLMVS.;23)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLMVSCOMS)

(RPAQQ CMLMVSCOMS
 ((* 
               "Interpreter and compiler support for multiple values.  See LLMVS for runtime support"
                      )
                   (FNS MULTIPLE-VALUE-CALL RETVALUES)
                   (PROP DMACRO MULTIPLE-VALUE-CALL)
                   (FUNCTIONS MULTIPLE-VALUE-BIND MULTIPLE-VALUE-LIST MULTIPLE-VALUE-PROG1 
                          MULTIPLE-VALUE-SETQ)
                   (VARS (NEW-ADVISETEMPLATE (QUOTE (ADV-PROG (!VALUE !OTHER-VALUES)
                                                           (MULTIPLE-VALUE-SETQ (!VALUE . !OTHER-VALUES
                                                                                 )
                                                                  (ADV-PROG NIL (ADV-RETURN DEF)))
                                                           (ADV-RETURN (VALUES-LIST (CONS !VALUE 
                                                                                        !OTHER-VALUES
                                                                                          )))))))
                   (PROP FILETYPE CMLMVS)
                   (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA
                                                                                          
                                                                                  MULTIPLE-VALUE-CALL
                                                                                          )
                                                                                       (NLAML)
                                                                                       (LAMA)))))



(* "Interpreter and compiler support for multiple values.  See LLMVS for runtime support")


(DEFINEQ

(MULTIPLE-VALUE-CALL

  [NLAMBDA FORMS
    (DECLARE
 (LOCALVARS FORM))
                               (* lmm "22-Apr-86 14:00")

                                                             (* for interpreted calls only.

                                                             The macro inserts a \MVLIST call after 

                                                             the computation of FORM)

    (CL:APPLY (\EVAL (CAR FORMS))
           (for
 X in
 (CDR FORMS) join
 (\MVLIST (\EVAL X])

(RETVALUES

  [LAMBDA (POS VALUES FLG)
                                   (* lmm "30-May-86 00:03")

    (PROG ((P (\STACKARGPTR POS)))
          (COND
             ((fetch
 (FX INVALIDP) of
 (SETQ P (fetch
 (FX CLINK) of
 P)))
              (LISPERROR "ILLEGAL RETURN" VALUES)))
          (\SMASHLINK NIL P P)
          (AND FLG (RELSTK POS))
          (RETURN (VALUES-LIST VALUES])
)

(PUTPROPS MULTIPLE-VALUE-CALL DMACRO
 
          (DEFMACRO (FN
 &BODY BODY) (* "optmizer" for special form MULTIPLE-VALUE-CALL - handle 
                                       special case of "list" and let the rest turn into an APPLY)
             (COND
                ((AND (EQUAL FN (QUOTE (FUNCTION LIST)))
                      (NULL (CDR BODY)))
                 (CONS (QUOTE \MVLIST)
                       BODY))
                (T (BQUOTE (CL:APPLY (\, FN)
                                  (NCONC (\,@ (for
 F in
 BODY collect
 (BQUOTE (MULTIPLE-VALUE-LIST
                                                                              (\, F)))))))))))
)
(DEFMACRO MULTIPLE-VALUE-BIND
 (VARS VALUES-FORM &REST FORMS) (BQUOTE (DESTRUCTURING-BIND
                                                                      (\, VARS)
                                                                      (MULTIPLE-VALUE-LIST
                                                                       (\, VALUES-FORM))
                                                                      (\,@ FORMS))))

(DEFMACRO MULTIPLE-VALUE-LIST
 (FORM) (BQUOTE (MULTIPLE-VALUE-CALL (FUNCTION LIST)
                                                    (\, FORM))))

(DEFMACRO MULTIPLE-VALUE-PROG1
 (FORM . OTHER-FORMS) (BQUOTE (VALUES-LIST (PROG1 (MULTIPLE-VALUE-LIST
                                                                                 (\, FORM))
                                                                                (\,@ OTHER-FORMS)))))

(DEFMACRO MULTIPLE-VALUE-SETQ
 (VARIABLES FORM) (LET ((LIST (GENSYM)))
                                                    (BQUOTE (LET (((\, LIST)
                                                                   (MULTIPLE-VALUE-LIST (\, FORM))))
                                                                 (PROG1 (CAR (\, LIST))
                                                                        (DESTRUCTURING-SETQ
                                                                         (\, VARIABLES)
                                                                         (MULTIPLE-VALUE-LIST
                                                                          (\, FORM))))))))


(RPAQQ NEW-ADVISETEMPLATE
 (ADV-PROG (!VALUE !OTHER-VALUES)
                                 (MULTIPLE-VALUE-SETQ (!VALUE . !OTHER-VALUES)
                                        (ADV-PROG NIL (ADV-RETURN DEF)))
                                 (ADV-RETURN (VALUES-LIST (CONS !VALUE !OTHER-VALUES)))))

(PUTPROPS CMLMVS FILETYPE
 COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 MULTIPLE-VALUE-CALL)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS CMLMVS COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2102 3055 (MULTIPLE-VALUE-CALL 2112 . 2647) (RETVALUES 2649 . 3053)))))
STOP