/usr/share/common-lisp/source/metatilities-base/dev/generic-lisp.lisp is in cl-metatilities-base 20170403-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | (in-package #:metatilities)
;;; Interface determination
(defvar *default-interface* nil)
(defun default-interface ()
"Return the current default interface (this is setfable)."
*default-interface*)
(defun (setf default-interface) (value)
(setf *default-interface* value))
(defgeneric is-interface-available-p (interface-name)
(:documentation "Returns true is interface-name is available."))
(defmethod is-interface-available-p ((interface (eql nil)))
(values nil))
(defun is-default-interface-available-p ()
(is-interface-available-p *default-interface*))
;;; quitting
(defgeneric quit-lisp* (interface)
(:documentation "Quits Lisp"))
(defmethod quit-lisp* (interface)
(declare (ignore interface))
(print "I would love to quit for you, but I'm not sure how?"))
(defun quit-lisp ()
(quit-lisp* *default-interface*))
;;; memory management stuff
(defgeneric total-bytes-allocated* (interface)
(:documentation "")
(:method (interface)
(declare (ignore interface))
(values nil)))
(defun total-bytes-allocated ()
"Returns the total number of bytes that this Lisp session has allocated."
(total-bytes-allocated* *default-interface*))
(defgeneric gc-time* (interface)
(:documentation "")
(:method (interface)
(declare (ignore interface))
(values nil)))
(defun gc-time ()
"Returns the total amount of time that this Lisp session has spent in garbage collection."
(gc-time* *default-interface*))
(defgeneric collect-garbage* (interface)
(:documentation ""))
(defun collect-garbage ()
"Tell lisp that now is a good time to collect any accumulated garbage."
(collect-garbage* *default-interface*))
;;; other
(defmacro make-load-form* (class-name)
#+(or openmcl (not mcl) ansi-make-load-form)
`(defmethod make-load-form ((self ,class-name) &optional environment)
(declare (ignore environment))
(make-load-form-saving-slots self))
#+(and digitool (not ansi-make-load-form))
`(defmethod make-load-form ((self ,class-name))
(make-load-form-saving-slots self)))
|