(FILECREATED " 5-Jul-86 22:43:29" {ERIS}<LISPCORE>LIBRARY>CMLPROGV.;3
 4863   

      changes to:  (MACROS PROGV)
                   (SPECIAL-FORMS PROGV)
                   (VARS CMLPROGVCOMS)
                   (PROPS (CMLPROGV FILETYPE))
                   (FNS \DO.PROGV \DO.PROGV.SETUP.FRAME.AND.EXECUTE)

      previous date: " 5-Jul-86 22:32:02" {ERIS}<LISPCORE>LIBRARY>CMLPROGV.;2)


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

(PRETTYCOMPRINT CMLPROGVCOMS)

(RPAQQ CMLPROGVCOMS
 ((FNS \DO.PROGV \DO.PROGV.SETUP.FRAME.AND.EXECUTE)
                     (SPECIAL-FORMS PROGV)
                     (PROP DMACRO PROGV)
                     (PROP FILETYPE CMLPROGV)))
(DEFINEQ

(\DO.PROGV

  [LAMBDA (VARS VALUES FNTOCALL)
                             (* lmm " 5-Jul-86 22:22")

                                                             (* call FNTOCALL after binding VARS to 

                                                             VALUES)

    (PROG ((NVARS 0)
           NTSIZE NNILS TMP)
          (for
 VAR in
 VARS do
                                (* Count number of vars to bind, check 

                                                             validity)

                              (CL:ASSERT (NOT (CONSTANTP VAR)))
                              (add
 NVARS 1))
          (RETURN (.CALLAFTERPUSHINGNILS. (SETQ NNILS (IPLUS NVARS (SETQ NTSIZE (CEIL (ADD1 NVARS)
                                                                                      WORDSPERQUAD))
                                                             (FOLDHI (fetch
 (FNHEADER OVERHEADWORDS)
                                                                        of
 T)
                                                                    WORDSPERCELL)
                                                             (SUB1 CELLSPERQUAD)))
                         (\DO.PROGV.SETUP.FRAME.AND.EXECUTE
 NNILS NVARS NTSIZE FNTOCALL VARS VALUES])

(\DO.PROGV.SETUP.FRAME.AND.EXECUTE

  [LAMBDA (NNILS NVARS NTSIZE FNTOCALL VARS VALUES)
          (* lmm " 5-Jul-86 22:22")

    (PROG ((CALLER (\MYALINK))
           NILSTART NT HEADER)
          
          (* * Create a nametable inside CALLER where \DO.PROGV pushed all those nils)


          (SETQ HEADER (fetch
 (FX FNHEADER) of
 CALLER))      (* The function header of code for 

                                                             \DO.PROGV)

          (SETQ NT (ADDSTACKBASE (CEIL (IPLUS (SETQ NILSTART (IDIFFERENCE (fetch
 (FX NEXTBLOCK)
                                                                             of
 CALLER)
                                                                    (UNFOLD NNILS WORDSPERCELL)))
                                              (UNFOLD NVARS WORDSPERCELL))
                                       WORDSPERQUAD)))       (* Address of our synthesized 

                                                             nametable: beginning of NIL's, not 

                                                             counting additional PVARs we are about 

                                                             to bind, rounded up to quadword)

          (for
 VAR in
 VARS as
 VAR# from
 (FOLDLO (IDIFFERENCE NILSTART (fetch
 (FX FIRSTPVAR)
                                                                         of
 CALLER))
                                               WORDSPERCELL) as
 NT1 from
 (fetch
 (FNHEADER 
                                                                                       OVERHEADWORDS)
                                                                            of
 T) as
 NT2
             from
 (IPLUS (fetch
 (FNHEADER OVERHEADWORDS) of
 T)
                         NTSIZE) as
 VALUEOFF from
 NILSTART by
 WORDSPERCELL
             do
 (PUTBASEPTR \STACKSPACE VALUEOFF (pop
 VALUES))
                (PUTBASE NT NT1 (\ATOMVALINDEX VAR))
                (PUTBASE NT NT2 (IPLUS PVARCODE VAR#)))
          
          (* * now fix up header of NT)


          (replace
 (FNHEADER NTSIZE) of
 NT with
 NTSIZE)
          (replace
 (FX NAMETABLE) of
 CALLER with
 NT)
          (RETURN (FUNCALL FNTOCALL])
)
(DEFINE-SPECIAL-FORM PROGV
 (VARIABLES VALUES &REST $PROGV-FORMS &ENVIRONMENT $PROGV-ENVIRONMENT)
   (\DO.PROGV (CL:EVAL VARIABLES ENV)
          (CL:EVAL VALUES ENV)
          (CL:FUNCTION (CL:LAMBDA NIL (EVAL-PROGN $PROGV-FORMS $PROGV-ENVIRONMENT)))))


(PUTPROPS PROGV DMACRO
 [(VARIABLES VALUES . FORMS)
                        (\DO.PROGV VARIABLES VALUES (CL:FUNCTION (LAMBDA NIL . FORMS])

(PUTPROPS CMLPROGV FILETYPE
 COMPILE-FILE)
(PUTPROPS CMLPROGV COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (702 4336 (\DO.PROGV 712 . 2012) (\DO.PROGV.SETUP.FRAME.AND.EXECUTE 2014 . 4334)))))
STOP