Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED " 2-NOV-81 22:33:07" <LISPUSERS>GLOBALRESOURCE.;4 4763
changes to: GLOBALRESOURCECOMS RELEASERESOURCE
previous date: " 1-NOV-81 23:17:51" <LISPUSERS>GLOBALRESOURCE.;2)
(PRETTYCOMPRINT GLOBALRESOURCECOMS)
(RPAQQ GLOBALRESOURCECOMS ((* Global resource mangement; exported so GATHEREXPORTS will grab
everything.)
(EXPORT (MACROS FREERESOURCE GETRESOURCE GLOBALRESOURCE RELEASERESOURCE RESOURCECONTEXT)
(ADDVARS (GLOBAL.RESOURCES))
(FILEPKGCOMS GLOBALRESOURCES)
[P (MAPC (QUOTE (GLOBALRESOURCE RESOURCECONTEXT
))
(FUNCTION (LAMBDA (A)
(APPLY* (QUOTE ADDTOVAR)
(QUOTE PRETTYPRINTMACROS)
(CONS A
(QUOTE (LAMBDA
(FORM)
(PROG [(POS (IPLUS 4 (POSITION]
(PRIN1 "(")
(PRIN2 (CAR FORM))
(SPACES 1)
(PRINTDEF (CADR FORM)
(POSITION))
(OR [EQ COMMENTFLG
(CAAR (SETQ
FORM
(CDDR FORM]
(TAB POS 0))
(PRINTDEF FORM POS T T FNSLST)
(PRIN1 ")"]
(TEMPLATES GLOBALRESOURCE RELEASERESOURCE RESOURCECONTEXT))))
(* Global resource mangement; exported so GATHEREXPORTS will grab everything.)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS FREERESOURCE MACRO (ARGS (HELP "FREERESOURCE not in RESOURCECONTEXT"
(CONS (QUOTE FREERESOURCE)
ARGS))))
(PUTPROPS GETRESOURCE MACRO (ARGS (HELP "GETRESOURCE not in RESOURCECONTEXT"
(CONS (QUOTE GETRESOURCE)
ARGS))))
(PUTPROPS GLOBALRESOURCE MACRO [X (PROG ((NAMES (MKLIST (CAR X)))
(FORMS (CDR X)))
(RETURN (LIST (QUOTE RESOURCECONTEXT)
NAMES
[MKPROGN (MAPCAR NAMES
(FUNCTION (LAMBDA (N)
(LIST (QUOTE GETRESOURCE)
N]
(LIST (QUOTE PROG1)
(MKPROGN FORMS)
(MKPROGN (MAPCAR NAMES
(FUNCTION (LAMBDA (N)
(LIST (QUOTE
FREERESOURCE)
N])
(PUTPROPS RELEASERESOURCE MACRO [ARGS (PROG ((RNAME (CAR ARGS)))
(AND (EQ (NTHCHAR RNAME -5)
(QUOTE A))
(FIXP (SUBATOM RNAME -4 -1))
(SETQ RNAME (SUBATOM RNAME 1 -6)))
(RETURN (SUBPAIR
(QUOTE (ALLOC RNAME RVALVAR . FORMS))
(CONS (OR (CADR (ASSOC RNAME GLOBAL.RESOURCES))
(HELP "undefined resource" RNAME))
(CONS RNAME (CDR ARGS)))
(QUOTE (PROGN (SETQ RNAME RVALVAR)
(PROG1 (PROGN . FORMS)
(SETQ RVALVAR
(PROG1 (OR RNAME ALLOC)
(SETQ RNAME NIL])
(PUTPROPS RESOURCECONTEXT MACRO [X
(PROG [LVS (NAMES (MKLIST (CAR X)))
(FORMS (COPY (CDR X]
[SETQ LVS (MAPCAR NAMES (FUNCTION (LAMBDA (N)
(PACK* N (GENSYM]
(APPLY (QUOTE GLOBALVARS)
NAMES)
[MAP2C NAMES LVS
(FUNCTION (LAMBDA (N L)
(DSUBST L N FORMS)
(DSUBST (LIST (QUOTE SETQ)
N L)
(LIST (QUOTE FREERESOURCE)
L)
FORMS)
(DSUBST (LIST (QUOTE SETQ)
L
(LIST (QUOTE PROG1)
(LIST (QUOTE OR)
N
(OR (CADR (ASSOC N GLOBAL.RESOURCES))
(HELP "undefined resource" N)))
(LIST (QUOTE SETQ)
N)))
(LIST (QUOTE GETRESOURCE)
L)
FORMS]
(RETURN (LIST (CONS (QUOTE LAMBDA)
(CONS LVS (CONS (LIST (QUOTE DECLARE)
(CONS (QUOTE LOCALVARS)
LVS))
FORMS])
)
(ADDTOVAR GLOBAL.RESOURCES )
[FILEPKGCOM (QUOTE GLOBALRESOURCES)
(QUOTE MACRO)
(QUOTE (X [VARS * (MAPCAR (QUOTE X)
(FUNCTION (LAMBDA (Y)
(CONS (CAR Y]
(DECLARE: DOEVAL@COMPILE DONTCOPY (P (ADDTOVAR GLOBAL.RESOURCES . X]
[MAPC (QUOTE (GLOBALRESOURCE RESOURCECONTEXT
))
(FUNCTION (LAMBDA (A)
(APPLY* (QUOTE ADDTOVAR)
(QUOTE PRETTYPRINTMACROS)
(CONS A (QUOTE (LAMBDA (FORM)
(PROG [(POS (IPLUS 4 (POSITION]
(PRIN1 "(")
(PRIN2 (CAR FORM))
(SPACES 1)
(PRINTDEF (CADR FORM)
(POSITION))
(OR [EQ COMMENTFLG (CAAR (SETQ
FORM
(CDDR FORM]
(TAB POS 0))
(PRINTDEF FORM POS T T FNSLST)
(PRIN1 ")"]
(SETTEMPLATE (QUOTE GLOBALRESOURCE)
(QUOTE MACRO))
(SETTEMPLATE (QUOTE RELEASERESOURCE)
(QUOTE MACRO))
(SETTEMPLATE (QUOTE RESOURCECONTEXT)
(QUOTE MACRO))
(* END EXPORTED DEFINITIONS)
(DECLARE: DONTCOPY
(FILEMAP (NIL)))
STOP