32 |
(in-package 'system) |
(in-package 'system) |
33 |
|
|
34 |
|
|
35 |
(proclaim '(optimize (safety 2) (space 3))) |
;(proclaim '(optimize (safety 2) (space 3))) |
36 |
|
|
37 |
|
|
38 |
(defmacro time (form) |
(defmacro time (form) |
39 |
|
(declare (optimize (safety 1))) |
40 |
(let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym)) |
(let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym)) |
41 |
(gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym)) |
(gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym)) |
42 |
(child-run-start (gensym)) (child-run-end (gensym))) |
(child-run-start (gensym)) (child-run-end (gensym))) |
76 |
-460))) |
-460))) |
77 |
|
|
78 |
(defun decode-universal-time (ut &optional (tz *default-time-zone*)) |
(defun decode-universal-time (ut &optional (tz *default-time-zone*)) |
79 |
|
(declare (optimize (safety 1))) |
80 |
(let (sec min h d m y dow) |
(let (sec min h d m y dow) |
81 |
(decf ut (* tz 3600)) |
(decf ut (* tz 3600)) |
82 |
(multiple-value-setq (d ut) (floor ut seconds-per-day)) |
(multiple-value-setq (d ut) (floor ut seconds-per-day)) |
101 |
|
|
102 |
(defun encode-universal-time (sec min h d m y |
(defun encode-universal-time (sec min h d m y |
103 |
&optional (tz *default-time-zone*)) |
&optional (tz *default-time-zone*)) |
104 |
|
(declare (optimize (safety 1))) |
105 |
(incf h tz) |
(incf h tz) |
106 |
(when (<= 0 y 99) |
(when (<= 0 y 99) |
107 |
(multiple-value-bind (sec min h d m y1 dow dstp tz) |
(multiple-value-bind (sec min h d m y1 dow dstp tz) |
118 |
|
|
119 |
; Courtesy Paul Dietz |
; Courtesy Paul Dietz |
120 |
(defmacro nth-value (n expr) |
(defmacro nth-value (n expr) |
121 |
|
(declare (optimize (safety 1))) |
122 |
`(nth ,n (multiple-value-list ,expr))) |
`(nth ,n (multiple-value-list ,expr))) |
123 |
(defun compile-file-pathname (pathname) |
(defun compile-file-pathname (pathname) |
124 |
(make-pathname :defaults pathname :type "o")) |
(declare (optimize (safety 1))) |
125 |
|
(make-pathname :defaults pathname :type "o")) |
126 |
(defun constantly (x) |
(defun constantly (x) |
127 |
#'(lambda (&rest args) |
(declare (optimize (safety 1))) |
128 |
(declare (ignore args) (dynamic-extent args)) |
(lambda (&rest args) |
129 |
x)) |
(declare (ignore args) (dynamic-extent args)) |
130 |
|
x)) |
131 |
(defun complement (fn) |
(defun complement (fn) |
132 |
#'(lambda (&rest args) (not (apply fn args)))) |
(declare (optimize (safety 1))) |
133 |
|
(lambda (&rest args) (not (apply fn args)))) |
134 |
|
|
135 |
(defun default-system-banner () |
(defun default-system-banner () |
136 |
(let (gpled-modules) |
(let (gpled-modules) |
151 |
"Use (help) to get some basic information on how to use GCL."))) |
"Use (help) to get some basic information on how to use GCL."))) |
152 |
|
|
153 |
(defun lisp-implementation-version nil |
(defun lisp-implementation-version nil |
154 |
|
(declare (optimize (safety 1))) |
155 |
(format nil "GCL ~a.~a.~a" |
(format nil "GCL ~a.~a.~a" |
156 |
si::*gcl-major-version* |
si::*gcl-major-version* |
157 |
si::*gcl-minor-version* |
si::*gcl-minor-version* |