github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-04 15:16:50 +00:00
Code Issues Projects Releases Wiki Activity

initial checkin for sources

Browse Source
This commit is contained in:
Larry Masinter
2020-08-29 18:36:46 -07:00
parent cb46b0b62b
commit 851925875d
314 changed files with 37442 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

177
sources/CMLENVIRONMENT Normal file
View File

@@ -0,0 +1,177 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
(IL:FILECREATED " 3-Sep-93 09:49:06" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>CMLENVIRONMENT.;4| 7109
IL:|changes| IL:|to:| (IL:VARIABLES *FEATURES*)
IL:|previous| IL:|date:| " 8-Nov-90 17:26:56"
IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>CMLENVIRONMENT.;3|)
; Copyright (c) 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
(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:|;;| "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))))
(SYMBOLS-REMAINING (ROUND (* 100 (FIFTH 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 "Symbol area remaining:~25t~a%~%" SYMBOLS-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 (5523 6724 (IL:PRINT-LISP-INFORMATION 5536 . 6161) (IL:PRINT-LOADED-FILE-INFORMATION
6163 . 6722)))))
IL:STOP