(FILECREATED "13-May-86 13:10:58" {ERIS}<LISPCORE>LIBRARY>CMLMVS.;21 8633
changes to: (VARS CMLMVSCOMS)
(MACROS \VALUES)
(FUNCTIONS MULTIPLE-VALUE-LIST MULTIPLE-VALUE-PROG1 MULTIPLE-VALUE-SETQ)
(PROPS (CMLMVS FILETYPE))
previous date: " 7-May-86 20:47:53" {ERIS}<LISPCORE>LIBRARY>CMLMVS.;20)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLMVSCOMS)
(RPAQQ CMLMVSCOMS [(FNS MULTIPLE-VALUE-CALL)
(PROP DMACRO MULTIPLE-VALUE-CALL)
(FUNCTIONS MULTIPLE-VALUE-BIND MULTIPLE-VALUE-LIST MULTIPLE-VALUE-PROG1
MULTIPLE-VALUE-SETQ)
(DECLARE: DONTCOPY (MACROS \VALUES))
(VARS MULTIPLE-VALUES-LIMIT)
(FNS VALUES VALUES-LIST \MVLIST)
[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 VALUES])
(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])
)
(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) (BQUOTE (DESTRUCTURING-SETQ (\, VARIABLES)
(MULTIPLE-VALUE-LIST (\, FORM)))))
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS \VALUES MACRO
((MANY ONE)
(PROG ((CALLER (\MYALINK)))
NEWFRAME
(RETURN (PROG ((PC (fetch (FX PC)
of CALLER))
(CODE (fetch (FX FNHEADER)
of CALLER))
BYTE)
NEWPC
[SELECTC (SETQ BYTE (\GETBASEBYTE CODE PC))
((OP# RETURN)
(SETQ CALLER (fetch (FX CLINK)
of CALLER))
(GO NEWFRAME))
((OP# FN1)
(SELECTQ [\INDEXATOMDEF (create WORD HIBYTE ← (\GETBASEBYTE
CODE
(ADD1 PC))
LOBYTE ← (\GETBASEBYTE
CODE
(+ PC 2]
(\MVLIST (replace (FX PC)
of CALLER with (PLUS 3 PC))
(RETURN MANY))
NIL))
((OP# JUMPX)
(add PC (if (>= (SETQ BYTE (\GETBASEBYTE CODE (1+ PC)))
128)
then
(- BYTE 256)
else BYTE))
(GO NEWPC))
((OP# JUMPXX)
[add PC (+ (LSH (SETQ BYTE (\GETBASEBYTE CODE (1+ PC)))
8)
(\GETBASEBYTE CODE (+ PC 2))
(COND ((IGREATERP BYTE 127)
-65536)
(T 0]
(GO NEWPC))
(LET [(JUMPS (CONSTANT (CAR (\FINDOP (QUOTE JUMP]
(if (<= (CAR JUMPS)
BYTE
(CADR JUMPS))
then
(add PC (+ (- BYTE (CAR JUMPS))
2))
(GO NEWPC]
(RETURN ONE]
)
)
(RPAQQ MULTIPLE-VALUES-LIMIT 512)
(DEFINEQ
(VALUES
[LAMBDA ARGS (* lmm " 1-May-86 23:51")
(\VALUES (for I from 1 to ARGS collect (ARG ARGS I))
(AND (IGEQ ARGS 1)
(ARG ARGS 1])
(VALUES-LIST
[LAMBDA (VALUES) (* lmm
" 7-Feb-86 14:36")
(\VALUES VALUES (CAR VALUES])
(\MVLIST
[LAMBDA (X)
(LIST X])
)
(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 VALUES)
)
(PUTPROPS CMLMVS COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2157 2708 (MULTIPLE-VALUE-CALL 2167 . 2706)) (7520 8046 (VALUES 7530 . 7769) (
VALUES-LIST 7771 . 8002) (\MVLIST 8004 . 8044)))))
STOP