-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathCMLENVIRONMENT
178 lines (141 loc) · 7.34 KB
/
CMLENVIRONMENT
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
(IL:FILECREATED "12-Aug-2022 12:31:32" IL:|{DSK}<home>larry>medley>sources>CMLENVIRONMENT.;2| 6958
:CHANGES-TO (IL:FUNCTIONS ROOM)
:PREVIOUS-DATE " 3-Sep-93 09:49:06" IL:|{DSK}<home>larry>medley>sources>CMLENVIRONMENT.;1|)
; Copyright (c) 1986-1988, 1990, 1993 by Venue & Xerox Corporation.
(IL:PRETTYCOMPRINT IL:CMLENVIRONMENTCOMS)
(IL:RPAQQ IL:CMLENVIRONMENTCOMS
(
(IL:* IL:|;;| "Misc environmental functions:")
(IL:FUNCTIONS LISP-IMPLEMENTATION-TYPE LISP-IMPLEMENTATION-VERSION MACHINE-INSTANCE
MACHINE-VERSION SOFTWARE-TYPE SOFTWARE-VERSION MACHINE-TYPE)
(IL:VARIABLES XCL:*SHORT-SITE-NAME* XCL:*LONG-SITE-NAME*)
(IL:FUNCTIONS SHORT-SITE-NAME LONG-SITE-NAME)
(IL:FUNCTIONS ROOM)
(IL:COMS
(IL:* IL:|;;| "Functions for printing the system information for Customer Support:")
(IL:FNS IL:PRINT-LISP-INFORMATION IL:PRINT-LOADED-FILE-INFORMATION))
(IL:VARIABLES *FEATURES*)
(IL:PROP (IL:MAKEFILE-ENVIRONMENT IL:FILETYPE)
IL:CMLENVIRONMENT)))
(IL:* IL:|;;| "Misc environmental functions:")
(DEFUN LISP-IMPLEMENTATION-TYPE ()
"Venue Medley")
(DEFUN LISP-IMPLEMENTATION-VERSION ()
(CONCATENATE 'STRING (STRING-CAPITALIZE IL:MAKESYSNAME)
" "
(IL:MKSTRING IL:LISP-RELEASE-VERSION)
" sysout of " IL:MAKESYSDATE))
(DEFUN MACHINE-INSTANCE ()
(IL:SELECTC IL:\\MACHINETYPE
(IL:\\MAIKO (FORMAT NIL "~A ~A" (OR (IL:UNIX-GETPARM "HOSTID")
(IL:UNIX-GETENV "HOSTID"))
(OR (IL:UNIX-GETPARM "HOSTNAME")
(IL:UNIX-GETENV "HOSTNAME"))))
(LET ((HOST IL:\\MY.NSHOSTNUMBER))
(FORMAT NIL "~@[~A = ~]~O#" (AND IL:\\PUP.READY (IL:ETHERHOSTNAME))
(+ (ASH (SECOND HOST)
32)
(ASH (THIRD HOST)
16)
(FOURTH HOST))))))
(DEFUN MACHINE-VERSION ()
(IL:SELECTQ (IL:MACHINETYPE)
(IL:MAIKO (IL:* IL:\;
"For emulators, convert the emulator creation date from microcodeversion.")
(FORMAT NIL "Emulator created: ~A, memory size: ~D"
(IL:SUBSTRING (IL:GDATE (+ (IL:IDATE "14-OCT-87 12:00:00")
(* 86400 (IL:MICROCODEVERSION))))
1 9)
(IL:REALMEMORYSIZE)))
(FORMAT NIL "Microcode version: ~D, memory size: ~D" (IL:MICROCODEVERSION)
(IL:REALMEMORYSIZE))))
(DEFUN SOFTWARE-TYPE ()
"Envos Medley")
(DEFUN SOFTWARE-VERSION ()
(CONCATENATE 'STRING (LISP-IMPLEMENTATION-VERSION)
", Make-init dates: "
(CAR IL:MAKEINITDATES)
", "
(CADR IL:MAKEINITDATES)))
(DEFUN MACHINE-TYPE ()
(IL:SELECTC IL:\\MACHINETYPE
(IL:\\DANDELION "Xerox 1108")
(IL:\\DORADO "Xerox 1132")
(IL:\\DAYBREAK "Xerox 1186")
(IL:\\MAIKO (OR (IL:UNIX-GETPARM "MACH")
(IL:UNIX-GETENV "MACH")))
(IL:MKSTRING (IL:MACHINETYPE))))
(DEFVAR XCL:*SHORT-SITE-NAME* NIL)
(DEFVAR XCL:*LONG-SITE-NAME* NIL)
(DEFUN SHORT-SITE-NAME ()
(OR XCL:*SHORT-SITE-NAME* "Unknown"))
(DEFUN LONG-SITE-NAME ()
(OR XCL:*LONG-SITE-NAME* XCL:*SHORT-SITE-NAME* "Unknown"))
(DEFUN ROOM (&OPTIONAL (TYPES NIL SP)
(PAGE-LIMIT (IF SP
NIL
20))
(IN-USE-LIMIT NIL)) (IL:* IL:\; "Edited 12-Aug-2022 12:25 by lmm")
(IL:* IL:|;;| "The three args are identical to those of IL:STORAGE, except that TYPES = NIL, T or omitted is handled per silver book (small, maximal, medium, respectively).")
(LET* ((STORAGE-LEFT (IL:STORAGE.LEFT))
(DATA-REMAINING (ROUND (* 100 (SECOND STORAGE-LEFT))))
(ONE-PERCENT-VMEM (ROUND (+ IL:\\LASTVMEMFILEPAGE 50)
100))
(VMEM-PERCENT (- 100 (ROUND (+ (IL:VMEMSIZE)
(ASH ONE-PERCENT-VMEM -1))
ONE-PERCENT-VMEM))))
(FORMAT T "Data area remaining:~25t~a%~%" DATA-REMAINING)
(FORMAT T "Vmem remaining:~25t~a%~%" VMEM-PERCENT)
(WHEN (OR TYPES PAGE-LIMIT IN-USE-LIMIT)
(TERPRI T)
(WHEN (OR PAGE-LIMIT IN-USE-LIMIT)
(FORMAT T "Datatypes with at least")
(WHEN PAGE-LIMIT (FORMAT T " ~D pages allocated" PAGE-LIMIT IN-USE-LIMIT))
(WHEN IN-USE-LIMIT (FORMAT T "~:[~; and at least~] ~D instances in use" PAGE-LIMIT
IN-USE-LIMIT))
(FORMAT T ":~%~%"))
(IL:STORAGE (AND TYPES (NOT (EQ TYPES T))
TYPES)
PAGE-LIMIT IN-USE-LIMIT))))
(IL:* IL:|;;| "Functions for printing the system information for Customer Support:")
(IL:DEFINEQ
(il:print-lisp-information
(il:lambda (il:file string) (il:* il:\; "Edited 7-Mar-88 15:24 by jds")
(il:printout (or il:file t)
(lisp-implementation-type)
" version "
(lisp-implementation-version)
" on "
(machine-type)
", "
(machine-version)
", " "machine " (machine-instance)
" based on "
(software-type)
" version "
(software-version)
t "Patch files: " il:\# (il:print-loaded-file-information il:file (or string "PATCH"))
)))
(il:print-loaded-file-information
(il:lambda (il:file string) (il:* il:|raf| " 2-Jan-86 17:37")
(il:|for| il:x il:|in| il:loadedfilelst il:|when| (il:strpos (or string "PATCH")
il:x)
il:|do| (il:printout il:file (il:namefield il:x)
" dated "
(caar (il:getprop (il:namefield il:x)
'il:filedates))
t))))
)
(DEFPARAMETER *FEATURES* '(:INTERLISP :XEROX :COMMON :IEEE-FLOATING-POINT :MEDLEY))
(IL:PUTPROPS IL:CMLENVIRONMENT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP"))
(IL:PUTPROPS IL:CMLENVIRONMENT IL:FILETYPE :COMPILE-FILE)
(IL:PUTPROPS IL:CMLENVIRONMENT IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1993))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (1272 1329 (LISP-IMPLEMENTATION-TYPE 1272 . 1329)) (1331 1534 (
LISP-IMPLEMENTATION-VERSION 1331 . 1534)) (1536 2186 (MACHINE-INSTANCE 1536 . 2186)) (2188 2886 (
MACHINE-VERSION 2188 . 2886)) (2888 2934 (SOFTWARE-TYPE 2888 . 2934)) (2936 3140 (SOFTWARE-VERSION
2936 . 3140)) (3142 3456 (MACHINE-TYPE 3142 . 3456)) (3537 3607 (SHORT-SITE-NAME 3537 . 3607)) (3609
3699 (LONG-SITE-NAME 3609 . 3699)) (3701 5278 (ROOM 3701 . 5278)) (5372 6573 (IL:PRINT-LISP-INFORMATION
5385 . 6010) (IL:PRINT-LOADED-FILE-INFORMATION 6012 . 6571)))))
IL:STOP