diff --git a/code/cmu-site.lisp b/code/cmu-site.lisp new file mode 100644 index 0000000000000000000000000000000000000000..495fa84f906241e8798b4770fb47ce3deb2b4fec --- /dev/null +++ b/code/cmu-site.lisp @@ -0,0 +1,20 @@ +;;; -*- Mode: Lisp; Package: System -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of CMU Common Lisp, please contact +;;; Scott Fahlman or slisp-group@cs.cmu.edu. +;;; +(ext:file-comment + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/cmu-site.lisp,v 1.1 1991/08/30 17:43:33 ram Exp $") +;;; +;;; ********************************************************************** +;;; +;;; Site specific initialization for CMU. This can be used as a template for +;;; non-cmu "library:site-init" files. +;;; +(in-package "SYSTEM") + +(setq *short-site-name* "CMU-SCS") +(setq *long-site-name* "Carnegie-Mellon University School of Computer Science") diff --git a/code/mach-os.lisp b/code/mach-os.lisp new file mode 100644 index 0000000000000000000000000000000000000000..f877da064f23bc58a91dfc4a5a1e4c072e4794ea --- /dev/null +++ b/code/mach-os.lisp @@ -0,0 +1,64 @@ +;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of CMU Common Lisp, please contact +;;; Scott Fahlman or slisp-group@cs.cmu.edu. +;;; +(ext:file-comment + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/mach-os.lisp,v 1.1 1991/08/30 17:39:40 ram Exp $") +;;; +;;; ********************************************************************** +;;; +;;; OS interface functions for CMU CL under Mach. +;;; +;;; Written and maintained mostly by Skef Wholey and Rob MacLachlan. +;;; Scott Fahlman, Dan Aronson, and Steve Handerson did stuff here, too. +;;; +(in-package "SYSTEM") +(export '(get-system-info get-page-size)) + +(pushnew :mach *features*) +(setq *software-type* "MACH/4.3BSD") + +(defconstant foreign-segment-start #x00C00000) +(defconstant foreign-segment-size #x00400000) + +(defun software-version () + "Returns a string describing version of the supporting software." + (string-trim '(#\newline) + (with-output-to-string (stream) + (run-program "/usr/cs/etc/version" ; Site dependent??? + nil :output stream)))) + +;;; GET-SYSTEM-INFO -- Interface +;;; +;;; Return system time, user time and number of page faults. For +;;; page-faults, we add pagein and pageout, since that is a somewhat more +;;; interesting number than the total faults. +;;; +(defun get-system-info () + (let (run-utime run-stime page-faults) + (multiple-value-bind (err? utime stime maxrss ixrss idrss + isrss minflt majflt) + (mach:unix-getrusage mach:rusage_self) + (declare (ignore maxrss ixrss idrss isrss minflt)) + (unless err? + (error "Unix system call getrusage failed: ~A." + (mach:get-unix-error-msg utime))) + + (multiple-value-bind (gr ps fc ac ic wc zf ra in ot) + (mach:vm_statistics *task-self*) + (declare (ignore ps fc ac ic wc zf ra)) + (gr-error 'mach:vm_statistics gr) + + (values utime stime (+ in ot)))))) + + +;;; GET-PAGE-SIZE -- Interface +;;; +;;; Return the system page size. +;;; +(defun get-page-size () + (gr-call* mach:vm_statistics *task-self*)) diff --git a/code/sunos-os.lisp b/code/sunos-os.lisp new file mode 100644 index 0000000000000000000000000000000000000000..d9bf1c2164de93246953bceda90727c3ac9fb2e5 --- /dev/null +++ b/code/sunos-os.lisp @@ -0,0 +1,79 @@ +;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of CMU Common Lisp, please contact +;;; Scott Fahlman or slisp-group@cs.cmu.edu. +;;; +(ext:file-comment + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sunos-os.lisp,v 1.1 1991/08/30 17:38:54 ram Exp $") +;;; +;;; ********************************************************************** +;;; +;;; OS interface functions for CMU CL under Mach. From Miles Bader and David +;;; Axmark. +;;; +(in-package "SYSTEM") +(export '(get-system-info get-page-size)) + +(pushnew :sunos *features*) +(setq *software-type* "SunOS") + +(defconstant foreign-segment-start #x00C00000) ; ### Not right??? +(defconstant foreign-segment-size #x00400000) + +(defvar *software-version* nil "Version string for supporting software") +(defun software-version () + "Returns a string describing version of the supporting software." + (unless *software-version* + (setf *software-version* + (let ((version-line + (with-output-to-string (stream) + (run-program + "/bin/sh" + '("-c" "strings /vmunix|grep -i 'sunos release'") + :output stream + :pty nil + :error nil)))) + (let* ((first-space (position #\Space version-line)) + (second-space (position #\Space version-line + :start (1+ first-space))) + (third-space (position #\Space version-line + :start (1+ second-space)))) + (subseq version-line (1+ second-space) third-space))))) + *software-version*) + +;;; Decache version on save, because it might not be the same when we restart. +;;; +(pushnew #'(lambda () + (setq *sofware-version* nil)) + ext:*before-save-initializations*) + + +;;; GET-SYSTEM-INFO -- Interface +;;; +;;; Return system time, user time and number of page faults. +;;; +(defun get-system-info () + (let (run-utime run-stime page-faults) + (multiple-value-bind (err? utime stime maxrss ixrss idrss + isrss minflt majflt) + (mach:unix-getrusage mach:rusage_self) + (declare (ignore maxrss ixrss idrss isrss minflt)) + (cond ((null err?) + (error "Unix system call getrusage failed: ~A." + (mach:get-unix-error-msg utime))) + (T (values utime stime majflt)))))) + + +;;; GET-PAGE-SIZE -- Interface +;;; +;;; Return the system page size. +;;; +(defun get-page-size () + (multiple-value-bind (val err) + (mach:unix-getpagesize) + (unless val + (error "Getpagesize failed: ~A" (mach:get-unix-error-msg err))) + val))