LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032827. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "EXCL-LOW" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "PCL") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2756388105. :AUTHOR "REL3" :LENGTH-IN-BYTES 3389. :LENGTH-IN-BLOCKS 4. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ;;; -*- Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-;;;;;; *************************************************************************;;; Copyright (c) 1985, 1986, 1987 Xerox Corporation.  All rights reserved.;;;;;; 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.;;; ;;; This software is made available AS IS, and Xerox Corporation makes no;;; warranty about the software, its performance or its conformity to any;;; specification.;;; ;;; Any person obtaining a copy of this software is requested to send their;;; name and post office or electronic mail address to:;;;   CommonLoops Coordinator;;;   Xerox Artifical Intelligence Systems;;;   2400 Hanover St.;;;   Palo Alto, CA 94303;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa);;;;;; Suggestions, comments and requests for improvements are also welcome.;;; *************************************************************************;;; ;;; This is the EXCL (Franz) lisp version of the file portable-low.;;; ;;; This is for version 1.1.2.  Many of the special symbols now in the lisp;;; package (e.g. lisp::pointer-to-fixnum) will be in some other package in;;; a later release so this will need to be changed.;;; (in-package 'pcl)(defmacro load-time-eval (form)  (cond ((and sys:*macroexpand-for-compiler* sys:*compile-to-core*) `',(eval form))((and sys:*macroexpand-for-compiler* sys:*compile-to-file*);(cerror "go ahead" "called load-time-eval in compile-to-file") `'(,compiler::*eval-when-load-marker* . ,form))(t `(progn ,form))))(eval-when (compile load eval)  (unless (fboundp 'excl::sy_hash)    (setf (symbol-function 'excl::sy_hash)  (symbol-function 'excl::_sy_hash-value))))(defmacro symbol-cache-no (symbol mask)  (if (and (constantp symbol)   (constantp mask))      `(load-time-eval (logand (ash (excl::sy_hash ',symbol) -1) ,mask))      `(logand (ash (the fixnum (excl::pointer-to-fixnum ,symbol)) -1)       (the fixnum ,mask))))(defmacro object-cache-no (object mask)  `(logand (the fixnum (excl::pointer-to-fixnum ,object))   (the fixnum ,mask)))(defun printing-random-thing-internal (thing stream)  (format stream "~O" (excl::pointer-to-fixnum thing)))(defun set-function-name (fn new-name)  (unless (symbolp new-name)    (setq new-name (intern (format nil "~S" new-name))))  (cond ((excl::function-object-p fn) (setf (excl::fn_symdef fn) new-name))(t nil)))(defun function-arglist (f)  (excl::arglist f))(defun symbol-append (sym1 sym2 &optional (package *package*))   ;; This is a version of symbol-append from macros.cl   ;; It insures that all created symbols are of one case and that   ;; case is the current prefered case.   ;; This special version of symbol-append is not necessary if all you   ;; want to do is compile and run pcl in a case-insensitive-upper    ;; version of cl.     ;;   (let ((string (string-append sym1 sym2)))      (case excl::*current-case-mode* ((:case-insensitive-lower :case-sensitive-lower)  (setq string (string-downcase string))) ((:case-insensitive-upper :case-sensitive-upper)  (setq string (string-upcase string))))      (intern string package)))***    1. speed, if we don't need the class, why bother to   ;; ***       compute it.   ;; ***    2. Bootstrapping reasons.  During Booting, there are   ;; ***       times when we can't compute the class of something,   ;; ***       but it is a T specialized argument (the new value   ;; ***       argument to a setf of an accessor.   (iterate ((i from 0 to (apply #'max specialized-positions)))          (collect       (list (make-symbol (format nil "Class of ARG ~D" i))     (if (member i specialized-positions) (funcall *make-class-of-form-fn* (nth i args)) nil)))))         (classes (remove nil (mapcar #'car class-bindings)))         (method-function-var (make-symbol "Met