(DEFINE-FILE-INFO PACKAGE "XCL" READTABLE "XCL")
(il:filecreated "28-Aug-87 18:42:36" il:{phylum}<pcl>pcl-env-internal.\;1 8356   

      il:|changes| il:|to:|  (il:vars il:pcl-env-internalcoms)
                             (il:props (il:pcl-env-internal il:makefile-environment))
                             (il:functions stack-eql stack-pointer-frame stack-frame-valid-p 
                                    stack-frame-fn-header stack-frame-pc fnheader-debugging-info 
                                    stack-frame-name compiled-closure-fnheader compiled-closure-env)
)


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

(il:prettycomprint il:pcl-env-internalcoms)

(il:rpaqq il:pcl-env-internalcoms (

(il:* il:|;;;| "***************************************")

                                   

(il:* il:|;;;| " Copyright (c) 1987 Xerox Corporation.  All rights reserved.")

                                   

(il:* il:|;;;| "")

                                   

(il:* il:|;;;| "Use and copying of this software and preparation of derivative works based upon this software are permitted.  Any distribution of this software or derivative works must comply with all applicable United States export control laws.")

                                   

(il:* il:|;;;| " ")

                                   

(il:* il:|;;;| "This software is made available AS IS, and Xerox Corporation makes no  warranty about the software, its performance or its conformity to any  specification.")

                                   

(il:* il:|;;;| " ")

                                   

(il:* il:|;;;| "Any person obtaining a copy of this software is requested to send their name and post office or electronic mail address to:")

                                   

(il:* il:|;;;| "   CommonLoops Coordinator")

                                   

(il:* il:|;;;| "   Xerox Artifical Intelligence Systems")

                                   

(il:* il:|;;;| "   2400 Hanover St.")

                                   

(il:* il:|;;;| "   Palo Alto, CA 94303")

                                   

(il:* il:|;;;| "(or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)")

                                   

(il:* il:|;;;| "")

                                   

(il:* il:|;;;| " Suggestions, comments and requests for improvements are also welcome.")

                                   

(il:* il:|;;;| " *************************************************************************")

                                   

(il:* il:|;;;| "")

                                   (il:declare\: il:dontcopy (il:prop il:makefile-environment 
                                                                    il:pcl-env-internal))
                                                             (il:* il:\; 
                                                             "We're off to hack the system...")

                                   (il:declare\: il:eval@compile il:dontcopy (il:files pcl::abc)
                                          
          
          (il:* il:|;;| "The Deltas and The East and The Freeze")
)
                                   (il:functions stack-eql stack-pointer-frame stack-frame-valid-p 
                                          stack-frame-fn-header stack-frame-pc 
                                          fnheader-debugging-info stack-frame-name 
                                          compiled-closure-fnheader compiled-closure-env)))



(il:* il:|;;;| "***************************************")




(il:* il:|;;;| " Copyright (c) 1987 Xerox Corporation.  All rights reserved.")




(il:* il:|;;;| "")




(il:* il:|;;;| 
"Use and copying of this software and preparation of derivative works based upon this software are permitted.  Any distribution of this software or derivative works must comply with all applicable United States export control laws."
)




(il:* il:|;;;| " ")




(il:* il:|;;;| 
"This software is made available AS IS, and Xerox Corporation makes no  warranty about the software, its performance or its conformity to any  specification."
)




(il:* il:|;;;| " ")




(il:* il:|;;;| 
"Any person obtaining a copy of this software is requested to send their name and post office or electronic mail address to:"
)




(il:* il:|;;;| "   CommonLoops Coordinator")




(il:* il:|;;;| "   Xerox Artifical Intelligence Systems")




(il:* il:|;;;| "   2400 Hanover St.")




(il:* il:|;;;| "   Palo Alto, CA 94303")




(il:* il:|;;;| "(or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)")




(il:* il:|;;;| "")




(il:* il:|;;;| " Suggestions, comments and requests for improvements are also welcome.")




(il:* il:|;;;| " *************************************************************************")




(il:* il:|;;;| "")

(il:declare\: il:dontcopy 

(il:putprops il:pcl-env-internal il:makefile-environment (:package "XCL" :readtable "XCL"))
)



(il:* il:\; "We're off to hack the system...")

(il:declare\: il:eval@compile il:dontcopy 
(il:filesload pcl::abc)
)

(defun stack-eql (x y) "Test two stack pointers for equality" (and (il:stackp x)
                                                                   (il:stackp y)
                                                                   (eql (il:fetch (il:stackp il:edfxp
                                                                                         )
                                                                           il:of x)
                                                                        (il:fetch (il:stackp il:edfxp
                                                                                         )
                                                                           il:of y))))


(defun stack-pointer-frame (stack-pointer) (il:|fetch| (il:stackp il:edfxp) il:|of| stack-pointer))


(defun stack-frame-valid-p (frame) (not (il:|fetch| (il:fx il:invalidp) il:|of| frame)))


(defun stack-frame-fn-header (frame) (il:|fetch| (il:fx il:fnheader) il:|of| frame))


(defun stack-frame-pc (frame) (il:|fetch| (il:fx il:pc) il:|of| frame))


(defun fnheader-debugging-info (fnheader) (let* ((start-pc (il:fetch (il:fnheader il:startpc)
                                                              il:of fnheader))
                                                 (name-table-words
                                                  (let ((size (il:fetch (il:fnheader il:ntsize)
                                                                 il:of fnheader)))
                                                       (if (zerop size)
                                                           il:wordsperquad
                                                           (* size 2))))
                                                 (past-name-table-in-words (+ (il:fetch (il:fnheader
                                                                                         
                                                                                     il:overheadwords
                                                                                         )
                                                                                 il:of fnheader)
                                                                              name-table-words)))
                                                (and (= (- start-pc (* il:bytesperword 
                                                                       past-name-table-in-words))
                                                        il:bytespercell)
          
          (il:* il:|;;| "It's got a debugging-info list.")

                                                     (il:\\getbaseptr fnheader 
                                                            past-name-table-in-words))))


(defun stack-frame-name (frame) (il:|fetch| (il:fx il:framename) il:|of| frame))


(defun compiled-closure-fnheader (closure) (il:|fetch| (il:compiled-closure il:fnheader) il:|of|
                                                                                         closure))


(defun compiled-closure-env (closure) (il:fetch (il:compiled-closure il:environment) il:of closure))

(il:putprops il:pcl-env-internal il:copyright ("Xerox Corporation" 1987))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop