(DEFINE-FILE-INFO PACKAGE "D-ASSEM" READTABLE "XCL" BASE 10)
(il:filecreated "13-Jan-88 17:28:01" il:|{EG:PARC:XEROX}<LANNING>LISP>USERS>D-ASSEM-GVAR-PATCH.;1| 4089   

      il:|changes| il:|to:|  (il:vars il:d-assem-gvar-patchcoms)
                             (il:props (il:d-assem-gvar-patch il:makefile-environment)))


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:d-assem-gvar-patchcoms)

(il:rpaqq il:d-assem-gvar-patchcoms ((il:functions store-var)
                                     (il:declare\: il:donteval@load il:dontcopy il:eval@compile
                                            (il:files (il:loadcomp)
                                                   "D-ASSEM"))
                                     (il:declare\: il:dontcopy (il:props (il:d-assem-gvar-patch
                                                                          il:makefile-environment)
                                                                      (il:d-assem-gvar-patch 
                                                                             il:filetype)))))

(defun store-var (var-or-slot pop-p) 
(il:* il:|;;;| "Return a list of instructions to store the value on the top of stack into the given variable.  If a slot number is given instead, it is assumed to refer to a PVAR.  If POP-P is non-NIL, don't leave the value on the stack.")
 (let (kind slot)
      (etypecase var-or-slot (fixnum (setq slot var-or-slot)
                                    (setq kind :local))
             (cons (unless (eq (first var-or-slot)
                               ':g)
                          (error "BUG: This variable is neither a global nor a DVAR: ~S" var-or-slot)
                          )
                   (setq kind :global)
                   (setq slot (second var-or-slot)))
             (dvar (setq slot (dvar-slot var-or-slot))
                   (setq kind (dvar-kind var-or-slot))))
      (ecase kind ((:local)
                   (if pop-p (if (<= slot (max-arg 'il:pvar←↑))
                                 `((il:pvar←↑
                                    ,slot))
                                 `(,@(choose-op '(il:pvar← . il:pvarx←) slot) il:pop))
                       (choose-op '(il:pvar← . il:pvarx←) slot)))
             ((:argument)
              `(il:ivarx← ,(il:llsh slot 1) ,@(and pop-p '(il:pop))))
             ((:free)
              (if (eql slot +slow-fvar-slot+)
                  (il:* il:|;;| 
 "This one is icky.  It couldn't fit in the frame, so we use a call to SET to store the value.  Ugh.")

                  `(il:aconst (:sym ,(dvar-name var-or-slot))
                          il:swap il:fn2 (:fn set)
                          ,@(and pop-p '(il:pop)))
                  `(il:fvarx← ,(il:llsh slot 1) ,@(and pop-p '(il:pop)))))
             ((:closed)
              (let* ((level (dvar-level var-or-slot))
                     (map-entry (il:find entry il:in (reverse *hunk-map*)
                                   il:suchthat (<= level (car entry))))
                     (hunk-level (car map-entry))
                     (hunk-slot (cdr map-entry)))
                    `(,@(and (not pop-p)
                             '(il:copy)) ,@(choose-op '(il:pvar . il:pvarx) hunk-slot)
                            ,@(il:for i il:from 1 il:to (- hunk-level level)
                                 il:join (list 'il:getbaseptr.n 0)) il:swap il:rplptr.n
                            ,(il:llsh slot 1) il:pop)))
             ((:global)
              `(il:gvar← (:sym ,slot)
                      ,@(and pop-p '(il:pop)))))))

(il:declare\: il:donteval@load il:dontcopy il:eval@compile 
(il:filesload (il:loadcomp)
       "D-ASSEM")
)
(il:declare\: il:dontcopy 

(il:putprops il:d-assem-gvar-patch il:makefile-environment (:package "D-ASSEM" :readtable "XCL" :base 
                                                                  10))

(il:putprops il:d-assem-gvar-patch il:filetype :compile-file)
)
(il:putprops il:d-assem-gvar-patch il:copyright ("Xerox Corporation" 1988))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop