mirror of
https://github.com/PDP-10/its.git
synced 2026-01-19 01:27:05 +00:00
55 lines
2.2 KiB
Common Lisp
Executable File
55 lines
2.2 KiB
Common Lisp
Executable File
;;; -*-LISP-*-
|
|
|
|
;;; Standard way to create a private obarray, starting with a copy
|
|
;;; of the current (standard) obarray, and adding some new symbols
|
|
;;; to be shared between the standard and the new one, and getting
|
|
;;; private copies of some (possibly already existing) symbols for
|
|
;;; the private obarray. Normally, the standard obarray would be
|
|
;;; current when this file is executed, so that LOCALS, GLOBALS
|
|
;;; STANDARD-OBARRAY, and PRIVATE-OBARRAY would appear as global
|
|
;;; symbols (i.e., on both obarrays).
|
|
;;; The lines of comment having "*****" in them, just below, show how
|
|
;;; this file could be modified for incorporation as a leading part
|
|
;;; of some other file. One could then replace the names used for
|
|
;;; GLOBALS, LOCALS, STANDARD-OBARRAY, and PRIVATE-OBARRAY.
|
|
|
|
|
|
;These lines must be done first, before any other actions, so that the
|
|
; initial creation of PRIVATE-OBARRAY will have on it only the symbols
|
|
; found on the standard obarray.
|
|
(PROGN (SETQ STANDARD-OBARRAY OBARRAY
|
|
PRIVATE-OBARRAY (COND ((BOUNDP 'PRIVATE-OBARRAY) PRIVATE-OBARRAY)
|
|
((*ARRAY () 'OBARRAY))))
|
|
(AND (OR (NOT (BOUNDP 'GLOBALS)) (ATOM GLOBALS)) (SETQ GLOBALS () ))
|
|
(AND (OR (NOT (BOUNDP 'LOCALS)) (ATOM LOCALS)) (SETQ LOCALS () )))
|
|
|
|
|
|
;;; ***** (SETQ GLOBALS '(globalsym1 globalsym2 | . . . | globalsymn))
|
|
;;; ***** (SETQ LOCALS '(privatesym1 privatesym2 | . . . | privatesymn))
|
|
|
|
|
|
|
|
; Check for conflicting requests.
|
|
(AND (MAPCAN '(LAMBDA (GLOBALS)
|
|
(MAPCAN '(LAMBDA (LOCALS)
|
|
(AND (SAMEPNAMEP GLOBALS LOCALS) (LIST GLOBALS)))
|
|
LOCALS))
|
|
GLOBALS)
|
|
(ERROR '|GLOBALS request conflict with LOCALS for private obarray|))
|
|
|
|
|
|
;So here we try to fix up the two obarrays, as per request
|
|
; Get private copies of the "local" symbol requests, just to factor
|
|
; out the obarray under which these requests were read in.
|
|
; Get the copies of the "global" requests from off the standard obarray,
|
|
; and remove any locals from off the standard obarray
|
|
(SETQ LOCALS (LET ((OBARRAY PRIVATE-OBARRAY))
|
|
(MAPCAR '(LAMBDA (X)
|
|
(REMOB X)
|
|
(INTERN (COPYSYMBOL X () )))
|
|
LOCALS)))
|
|
(SETQ GLOBALS (LET ((OBARRAY STANDARD-OBARRAY))
|
|
(MAPCAR 'INTERN GLOBALS)))
|
|
|
|
|