(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "18-Oct-93 10:51:39" "{Pele:mv:envos}Sources>CLTL2>CMLEVAL.;2" 113967 |previous| |date:| "30-Mar-92 14:31:25" "{Pele:mv:envos}Sources>CLTL2>CMLEVAL.;1") ; Copyright (c) 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT CMLEVALCOMS) (RPAQQ CMLEVALCOMS ( (* |;;;| "Common Lisp interpreter") (COMS (* |;;| "These really don't belong here") (FUNCTIONS LISP:EQUAL LISP:EQUALP) (* |;;|  "For the byte compiler: Optimize by constant fold and coerce to EQ where possible") (PROP BYTEMACRO LISP:EQUAL LISP:EQUALP) (PROP DOPVAL LISP:EQUAL)) (COMS (FUNCTIONS \\REMOVE-DECLS) (FUNCTIONS LISP:SPECIAL-FORM-P)) (COMS (SPECIAL-FORMS INTERLISP) (PROP DMACRO INTERLISP COMMON-LISP) (FNS COMMON-LISP)) (COMS (ADDVARS (LAMBDASPLST LISP:LAMBDA)) (FNS \\TRANSLATE-CL\:LAMBDA) (VARIABLES *CHECK-ARGUMENT-COUNTS* *SPECIAL-BINDING-MARK*)) (VARIABLES LISP:LAMBDA-LIST-KEYWORDS LISP:CALL-ARGUMENTS-LIMIT LISP:LAMBDA-PARAMETERS-LIMIT) (STRUCTURES CLOSURE ENVIRONMENT) (FUNCTIONS \\MAKE-CHILD-ENVIRONMENT) (COMS (FNS LISP:EVAL \\EVAL-INVOKE-LAMBDA \\INTERPRET-ARGUMENTS \\INTERPRETER-LAMBDA CHECK-BINDABLE CHECK-KEYWORDS) (FUNCTIONS ARG-REF) (PROP DMACRO .COMPILER-SPREAD-ARGUMENTS.)) (FNS DECLARED-SPECIAL) (COMS (* \;  "FUNCALL and APPLY, not quite same as Interlisp") (FNS LISP:FUNCALL LISP:APPLY) (PROP DMACRO LISP:APPLY LISP:FUNCALL)) (COMS (* \;  "COMPILER-LET needs to work differently compiled and interpreted") (FNS LISP:COMPILER-LET COMP.COMPILER-LET) (PROP DMACRO LISP:COMPILER-LET) (SPECIAL-FORMS LISP:COMPILER-LET)) (COMS (* \;  "Lexical function- and macro-binding forms: FLET, LABELS, and MACROLET.") (SPECIAL-FORMS LISP:MACROLET LISP:FLET LISP:LABELS)) (SPECIAL-FORMS QUOTE) (COMS (SPECIAL-FORMS THE) (PROP DMACRO THE)) (COMS (PROP DMACRO LISP:EVAL-WHEN) (FNS LISP:EVAL-WHEN) (SPECIAL-FORMS LISP:EVAL-WHEN)) (COMS (SPECIAL-FORMS DECLARE) (FUNCTIONS LISP:LOCALLY LISP:LOCALLY)) (COMS (* \; "Interlisp version on LLINTERP") (SPECIAL-FORMS PROGN) (FNS \\EVAL-PROGN)) (COMS (* \;  "Confused because currently Interlisp special form, fixing MACRO-FUNCTION is complex") (* \;  "The Interlisp function is on LLINTERP") (SPECIAL-FORMS PROG1) (FUNCTIONS PROG1)) (COMS (SPECIAL-FORMS LET* LET) (PROP MACRO LET LET*) (FNS \\LET*-RECURSION |\\LETtran|)) (COMS (SPECIAL-FORMS COND) (FUNCTIONS COND)) (COMS (FNS LISP:IF) (SPECIAL-FORMS LISP:IF) (PROP DMACRO LISP:IF)) (COMS (* \;  "Interlisp NLAMBDA definitions on LLINTERP") (* \; "both special form and macro") (FUNCTIONS AND OR) (SPECIAL-FORMS AND OR)) (COMS (* \; "BLOCK and RETURN go together") (FNS LISP:BLOCK) (PROP DMACRO LISP:BLOCK) (SPECIAL-FORMS LISP:BLOCK) (FUNCTIONS RETURN) (FNS LISP:RETURN-FROM) (SPECIAL-FORMS LISP:RETURN-FROM)) (COMS (* \;  "IL and CL versions of FUNCTION.") (FNS LISP:FUNCTION) (PROP DMACRO LISP:FUNCTION) (SPECIAL-FORMS FUNCTION LISP:FUNCTION) (FUNCTIONS LISP:FUNCTIONP LISP:COMPILED-FUNCTION-P)) (SPECIAL-FORMS LISP:MULTIPLE-VALUE-CALL LISP:MULTIPLE-VALUE-PROG1) (FNS COMP.CL-EVAL) (FUNCTIONS LISP:EVALHOOK LISP:APPLYHOOK) (VARIABLES *EVALHOOK* *APPLYHOOK* LISP::*SKIP-EVALHOOK* LISP::*SKIP-APPLYHOOK*) (COMS (* \; "CONSTANTS mechanism") (FNS LISP:CONSTANTP) (SETFS LISP:CONSTANTP) (FUNCTIONS XCL::SET-CONSTANTP)) (COMS (* \;  "Interlisp SETQ for Common Lisp and vice versa") (SPECIAL-FORMS LISP:SETQ SETQ) (PROP DMACRO LISP:SETQ) (* |;;|  "An nlambda definition for cl:setq so cmldeffer may use cl:setq will run in the init") (FNS LISP:SETQ) (FUNCTIONS SETQ) (FNS SET-SYMBOL) (FUNCTIONS LISP:PSETQ) (FUNCTIONS SETQQ)) (COMS (SPECIAL-FORMS LISP:CATCH LISP:THROW LISP:UNWIND-PROTECT) (FNS LISP:THROW LISP:CATCH LISP:UNWIND-PROTECT)) (COMS (FUNCTIONS PROG PROG*) (SPECIAL-FORMS GO LISP:TAGBODY) (FNS LISP:TAGBODY)) (COMS (* \; "for macro caching") (FNS CACHEMACRO) (VARIABLES *MACROEXPAND-HOOK*) (VARS (*IN-COMPILER-LET* NIL))) (COMS (* |;;| "PROCLAIM and friends.") (* |;;| "Needs to come first because DEFVARs put it out. With package code in the init, also need this here rather than CMLEVAL") (FUNCTIONS LISP:PROCLAIM) (* \; "used by the codewalker, too") (MACROS VARIABLE-GLOBALLY-SPECIAL-P VARIABLE-GLOBAL-P) (FUNCTIONS XCL::DECL-SPECIFIER-P XCL::SET-DECL-SPECIFIER-P) (FUNCTIONS XCL::GLOBALLY-NOTINLINE-P XCL::SET-GLOBALLY-NOTINLINE-P) (SETFS XCL::DECL-SPECIFIER-P XCL::GLOBALLY-NOTINLINE-P) (PROP PROPTYPE GLOBALLY-SPECIAL GLOBALVAR SI::DECLARATION-SPECIFIER SI::GLOBALLY-NOTINLINE SPECIAL-FORM) (FUNCTIONS LISP:DECLAIM) (* |;;|  "This proclamation is here to shut DECLARE up about CLtL2 declarations that we ignore anyway") (* |;;| "We don't need one of these for (OPTIMIZE DEBUG) since we throw all OPTIMIZE declarations away already") (P (LISP:PROCLAIM '(LISP:DECLARATION DYNAMIC-EXTENT)))) (PROP (FILETYPE MAKEFILE-ENVIRONMENT) CMLEVAL) (DECLARE\: EVAL@COMPILE DONTCOPY (OPTIMIZERS CL-EVAL-FN3-CALL)) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T)) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA LISP:TAGBODY LISP:UNWIND-PROTECT LISP:CATCH LISP:SETQ LISP:BLOCK LISP:EVAL-WHEN LISP:COMPILER-LET COMMON-LISP) (NLAML LISP:THROW LISP:FUNCTION LISP:RETURN-FROM LISP:IF) (LAMA LISP:APPLY LISP:FUNCALL))))) (* |;;;| "Common Lisp interpreter") (* |;;| "These really don't belong here") (LISP:DEFUN LISP:EQUAL (LISP::X LISP::Y) (LISP:TYPECASE LISP::X (LISP:SYMBOL (EQ LISP::X LISP::Y)) (LISP:NUMBER (EQL LISP::X LISP::Y)) (CONS (AND (LISP:CONSP LISP::Y) (LISP:EQUAL (CAR LISP::X) (CAR LISP::Y)) (LISP:EQUAL (CDR LISP::X) (CDR LISP::Y)))) (STRING (AND (LISP:STRINGP LISP::Y) (LISP:STRING= LISP::X LISP::Y))) (LISP:BIT-VECTOR (AND (LISP:BIT-VECTOR-P LISP::Y) (LET ((LISP::SX (LISP:LENGTH LISP::X))) (AND (EQL LISP::SX (LISP:LENGTH LISP::Y)) (LISP:DOTIMES (LISP::I LISP::SX T) (LISP:IF (NOT (EQ (BIT LISP::X LISP::I) (BIT LISP::Y LISP::I))) (RETURN NIL))))))) (PATHNAME (AND (LISP:PATHNAMEP LISP::Y) (%PATHNAME-EQUAL LISP::X LISP::Y))) (T (EQ LISP::X LISP::Y)))) (LISP:DEFUN LISP:EQUALP (LISP::X LISP::Y) (* \; "Edited 23-Mar-92 14:07 by jrb:") (OR (EQ LISP::X LISP::Y) (LISP:TYPECASE LISP::X (LISP:SYMBOL NIL) (LISP:NUMBER (AND (LISP:NUMBERP LISP::Y) (= LISP::X LISP::Y))) (CONS (AND (LISP:CONSP LISP::Y) (LISP:EQUALP (CAR LISP::X) (CAR LISP::Y)) (LISP:EQUALP (CDR LISP::X) (CDR LISP::Y)))) (LISP:CHARACTER (AND (LISP:CHARACTERP LISP::Y) (LISP:CHAR-EQUAL LISP::X LISP::Y))) (STRING (AND (LISP:STRINGP LISP::Y) (STRING-EQUAL LISP::X LISP::Y))) (PATHNAME (AND (LISP:PATHNAMEP LISP::Y) (%PATHNAME-EQUAL LISP::X LISP::Y))) (LISP:VECTOR (AND (LISP:VECTORP LISP::Y) (LET ((LISP::SX (LISP:LENGTH LISP::X))) (AND (EQL LISP::SX (LISP:LENGTH LISP::Y)) (LISP:DOTIMES (LISP::I LISP::SX T) (LISP:IF (NOT (LISP:EQUALP (LISP:AREF LISP::X LISP::I ) (LISP:AREF LISP::Y LISP::I ))) (RETURN NIL))))))) (LISP:ARRAY (AND (LISP:ARRAYP LISP::Y) (LISP:EQUAL (LISP:ARRAY-DIMENSIONS LISP::X) (LISP:ARRAY-DIMENSIONS LISP::Y)) (LET ((LISP::FX (%FLATTEN-ARRAY LISP::X)) (LISP::FY (%FLATTEN-ARRAY LISP::Y))) (LISP:DOTIMES (LISP::I (LISP:ARRAY-TOTAL-SIZE LISP::X) T) (LISP:IF (NOT (LISP:EQUALP (LISP:AREF LISP::FX LISP::I) (LISP:AREF LISP::FY LISP::I))) (RETURN NIL)))))) (LISP:HASH-TABLE (AND (LISP:HASH-TABLE-P LISP::Y) (EQ (LISP:HASH-TABLE-TEST LISP::X) (LISP:HASH-TABLE-TEST LISP::Y)) (= (HARRAYPROP LISP::X 'NUMKEYS) (HARRAYPROP LISP::Y 'NUMKEYS)) (LISP:CATCH 'LISP::HASH-TABLE-CHECK (LISP:MAPHASH #'(LISP:LAMBDA (LISP::K LISP::V) (LISP:UNLESS (LISP:EQUALP (LISP:GETHASH LISP::K LISP::Y 'DEFAULT) LISP::V) (LISP:THROW 'LISP::HASH-TABLE-CHECK NIL ))) LISP::X) T))) (T (* |;;| "so that datatypes will be properly compared") (LET ((LISP::TYPENAME (TYPENAME LISP::X))) (AND (EQ LISP::TYPENAME (TYPENAME LISP::Y)) (LET ((LISP::DESCRIPTORS (GETDESCRIPTORS LISP::TYPENAME))) (LISP:IF LISP::DESCRIPTORS (FOR LISP::FIELD IN LISP::DESCRIPTORS ALWAYS (LISP:EQUALP (FETCHFIELD LISP::FIELD LISP::X) (FETCHFIELD LISP::FIELD LISP::Y))))))))))) (* |;;| "For the byte compiler: Optimize by constant fold and coerce to EQ where possible") (PUTPROPS LISP:EQUAL BYTEMACRO COMP.EQ) (PUTPROPS LISP:EQUALP BYTEMACRO COMP.EQ) (PUTPROPS LISP:EQUAL DOPVAL (2 CMLEQUAL)) (LISP:DEFUN \\REMOVE-DECLS (LISP::BODY LISP::ENVIRONMENT) (* |;;;| "This is like parse-body, except that it returns the body and a list of specials declared in this frame. It side-effects the environment to mark the specials.") (PROG ((LISP::SPECIALS NIL) LISP::FORM) LISP::NEXT-FORM (LISP:IF (NULL LISP::BODY) (GO LISP::DONE)) (LISP:SETQ LISP::FORM (CAR LISP::BODY)) LISP::RETRY-FORM (COND ((OR (LISP:ATOM LISP::FORM) (NOT (LISP:SYMBOLP (CAR LISP::FORM)))) (GO LISP::DONE)) ((EQ (CAR LISP::FORM) 'DECLARE) (LISP:MAPC #'(LISP:LAMBDA (LISP:DECLARATION) (LISP:WHEN (LISP:CONSP LISP:DECLARATION) (LISP:WHEN (OR (EQ (CAR LISP:DECLARATION) 'LISP:SPECIAL) (EQ (CAR LISP:DECLARATION) 'SPECVARS)) (LISP:IF (EQ (CDR LISP:DECLARATION) T) (* |;;| "(specvars . t) refers to all variables inside this scope, not just those bound in this frame. So handling (specvars . t) by declaring the variables in this frame special would not be correct. Hence print a warning and continue.") (LISP:WARN "(IL:SPECVARS . T) has no effect in the CL evaluator." ) (LISP:MAPC #'(LISP:LAMBDA (LISP::NAME) (LISP:PUSH LISP::NAME LISP::SPECIALS)) (CDR LISP:DECLARATION)))))) (CDR LISP::FORM)) (LISP:POP LISP::BODY) (GO LISP::NEXT-FORM)) ((LISP:SPECIAL-FORM-P (CAR LISP::FORM)) (GO LISP::DONE)) (T (LET ((LISP::NEW-FORM (LISP:MACROEXPAND-1 LISP::FORM LISP::ENVIRONMENT))) (COND ((AND (NOT (EQ LISP::NEW-FORM LISP::FORM)) (LISP:CONSP LISP::NEW-FORM)) (LISP:SETQ LISP::FORM LISP::NEW-FORM) (GO LISP::RETRY-FORM)) (T (GO LISP::DONE)))))) LISP::DONE (RETURN (LISP:IF LISP::SPECIALS (PROGN (FOR LISP::VAR IN LISP::SPECIALS DO (LISP:SETF (ENVIRONMENT-VARS LISP::ENVIRONMENT) (LIST* LISP::VAR *SPECIAL-BINDING-MARK* (ENVIRONMENT-VARS LISP::ENVIRONMENT)))) (LISP:VALUES LISP::BODY LISP::SPECIALS)) LISP::BODY)))) (LISP:DEFUN LISP:SPECIAL-FORM-P (LISP::X) (GET LISP::X 'SPECIAL-FORM)) (DEFINE-SPECIAL-FORM INTERLISP PROGN) (PUTPROPS INTERLISP DMACRO ((X . Y) (PROGN X . Y))) (PUTPROPS COMMON-LISP DMACRO ((X) X)) (DEFINEQ (COMMON-LISP (NLAMBDA COMMON-LISP-FORMS (* \;  "Edited 12-Feb-87 20:24 by Pavel") (\\EVAL-PROGN COMMON-LISP-FORMS NIL))) ) (ADDTOVAR LAMBDASPLST LISP:LAMBDA) (DEFINEQ (\\TRANSLATE-CL\:LAMBDA (LAMBDA (EXPR) (* \;  "Edited 13-Feb-87 23:20 by Pavel") (LET (VRBLS KEYVARS OPTVARS AUXLIST RESTFORM VARTYP BODY KEYWORDS (CNT 1) (MIN 0) (MAX 0) DECLS (SIMPLEP T)) (|for| BINDING VAR |in| (CAR (CDR EXPR)) |do| (SELECTQ BINDING ((&REST &BODY) (SETQ VARTYP '&REST)) (&OPTIONAL (SETQ VARTYP BINDING)) (&AUX (SETQ VARTYP BINDING)) (&ALLOW-OTHER-KEYS (OR (EQ VARTYP '&KEY) (ERROR "&ALLOW-OTHER-KEYS not in &KEY"))) (&KEY (SETQ VARTYP '&KEY)) (SELECTQ VARTYP (NIL "required" (|push| VRBLS BINDING) (|add| CNT 1) (|add| MIN 1) (|add| MAX 1) (AND *CHECK-ARGUMENT-COUNTS* (SETQ SIMPLEP NIL))) (&REST (SETQ RESTFORM `((,BINDING (|for| I |from| ,CNT |to| |-args-| |collect| (ARG |-args-| I))))) (SETQ MAX NIL) (SETQ SIMPLEP NIL)) (&AUX (|push| AUXLIST BINDING)) (&KEY (LET* (SVAR (INIT (COND ((LISTP BINDING) (PROG1 (CADR BINDING) (SETQ SVAR (CADDR BINDING)) (SETQ BINDING (CAR BINDING)))))) (KEY (COND ((LISTP BINDING) (PROG1 (CAR BINDING) (SETQ BINDING (CADR BINDING)))) (T (MAKE-KEYWORD BINDING))))) (COND (SVAR (|push| KEYVARS (LIST SVAR T)))) (|push| KEYVARS (LIST BINDING `(|for| \\INDEX |from| ,CNT |to| |-args-| |by| 2 |when| (EQ (ARG |-args-| \\INDEX) ,KEY) |do| (RETURN (ARG |-args-| (ADD1 \\INDEX))) |finally| (RETURN ,(COND (SVAR `(PROGN (SETQ ,SVAR NIL) ,INIT)) (T INIT))))))) (SETQ MAX NIL) (SETQ SIMPLEP NIL)) (&OPTIONAL (OR (LISTP BINDING) (SETQ BINDING (LIST BINDING))) (LET ((SVAR (CADDR BINDING))) (LISP:WHEN SVAR (|push| OPTVARS SVAR) (SETQ SIMPLEP NIL)) (LISP:WHEN (CADR BINDING) (SETQ SIMPLEP NIL)) (|push| OPTVARS `(,(CAR BINDING) (COND ((IGREATERP ,CNT |-args-|) ,(CADR BINDING)) (T ,@(COND (SVAR `((SETQ ,SVAR T)))) (ARG |-args-| ,CNT)))))) (AND MAX (|add| MAX 1)) (|add| CNT 1)) (SHOULDNT)))) (LISP:MULTIPLE-VALUE-SETQ (BODY DECLS) (PARSE-BODY (CDR (CDR EXPR)) NIL)) (LISP:IF SIMPLEP `(,'LAMBDA (,@(REVERSE VRBLS) ,@(MAPCAR (REVERSE OPTVARS) (FUNCTION CAR))) (DECLARE (LOCALVARS . T)) ,@DECLS (,'LET* (,@(REVERSE AUXLIST)) ,@DECLS ,@BODY)) `(LAMBDA |-args-| (DECLARE (LOCALVARS . T)) ,@(COND ((AND *CHECK-ARGUMENT-COUNTS* MIN (NEQ MIN 0)) `((COND ((ILESSP ,'|-args-| ,MIN) (ERROR "Too few args" ,'|-args-|)))))) ,@(COND ((AND *CHECK-ARGUMENT-COUNTS* MAX) `((COND ((IGREATERP ,'|-args-| ,MAX) (ERROR "Too many args" ,'|-args-|)))))) (,'LET* (,@(|for| VAR |in| (REVERSE VRBLS) |as| I |from| 1 |collect| (LIST VAR `(ARG |-args-| ,I))) ,@(REVERSE OPTVARS) ,@(REVERSE KEYVARS) ,@RESTFORM ,@(REVERSE AUXLIST)) ,@DECLS ,@BODY)))))) ) (LISP:DEFPARAMETER *CHECK-ARGUMENT-COUNTS* NIL) (DEFGLOBALVAR *SPECIAL-BINDING-MARK* "Variable specially bound. This string should never be visible") (LISP:DEFCONSTANT LISP:LAMBDA-LIST-KEYWORDS '(&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT &CONTEXT)) (LISP:DEFCONSTANT LISP:CALL-ARGUMENTS-LIMIT 512) (LISP:DEFCONSTANT LISP:LAMBDA-PARAMETERS-LIMIT 512) (LISP:DEFSTRUCT (CLOSURE (:PRINT-FUNCTION (LAMBDA (CLOSURE STREAM) (LET ((*PRINT-RADIX* NIL)) (LISP:FORMAT STREAM "#" (\\HILOC CLOSURE) (\\LOLOC CLOSURE)))))) (* |;;;| "An interpreted lexical closure. Contains the function and an environment object.") FUNCTION ENVIRONMENT) (LISP:DEFSTRUCT (ENVIRONMENT (:CONSTRUCTOR \\MAKE-ENVIRONMENT NIL) (:COPIER \\COPY-ENVIRONMENT) (:PRINT-FUNCTION (LAMBDA (ENV STREAM DEPTH) (DECLARE (IGNORE DEPTH)) (LET ((*PRINT-RADIX* NIL)) (LISP:FORMAT STREAM "#" (\\HILOC ENV) (\\LOLOC ENV)))))) (* |;;;| "An environment used by the Common Lisp interpreter. Every environment contains all of the information of its parents. That is, new child environments are made by copying the parent and then pushing new data onto one of the fields. This makes certain tests very fast.") (* |;;| "Lexically-bound or -declared variables. A property list mapping names into either *SPECIAL-BINDING-MARK* or their values.") VARS (* |;;| "Lexical functions and macros. A property list mapping names into either (:function . fn) or (:macro . expansion-fn).") FUNCTIONS (* |;;| "A property list mapping block names into unique blips. RETURN-FROMs can throw to the appropriate blip.") BLOCKS (* |;;| "A property list mapping TAGBODY bodies into unique blips. GOs throw the correct tail of the body to the blip.") TAGBODIES) (DEFMACRO \\MAKE-CHILD-ENVIRONMENT (PARENT &KEY ((:BLOCK (BLOCK-NAME BLOCK-BLIP)) NIL BLOCK-P) ((:TAGBODY (TAGBODY-TAIL TAGBODY-BLIP)) NIL TAGBODY-P)) `(LET* (($$PARENT ,PARENT) ($$NEW-ENV (LISP:IF $$PARENT (\\COPY-ENVIRONMENT $$PARENT) (\\MAKE-ENVIRONMENT)))) ,@(AND BLOCK-P `((LISP:SETF (ENVIRONMENT-BLOCKS $$NEW-ENV) (LIST* ,BLOCK-NAME ,BLOCK-BLIP (ENVIRONMENT-BLOCKS $$NEW-ENV))) )) ,@(AND TAGBODY-P `((LISP:SETF (ENVIRONMENT-TAGBODIES $$NEW-ENV) (LIST* ,TAGBODY-TAIL ,TAGBODY-BLIP (ENVIRONMENT-TAGBODIES $$NEW-ENV))))) $$NEW-ENV)) (DEFINEQ (LISP:EVAL (LAMBDA (LISP::EXPRESSION LISP::ENVIRONMENT) (* \; "Edited 7-Feb-91 20:42 by jds") (* |;;| "This is in Interlisp and not a DEFUN to help avoid bootstrap death, although bootstrap death is quite possible anyway if, for example, any of the macros here are in Common Lisp and the macro definitions are interpreted.") (DECLARE (LOCALVARS . T)) (COND ((AND *EVALHOOK* (NOT (PROG1 LISP::*SKIP-EVALHOOK* (LISP:SETQ LISP::*SKIP-EVALHOOK* NIL) ))) (LET ((LISP::HOOKFN *EVALHOOK*) (*EVALHOOK* NIL)) (LISP:FUNCALL LISP::HOOKFN LISP::EXPRESSION LISP::ENVIRONMENT))) (T (LISP:TYPECASE LISP::EXPRESSION (LISP:SYMBOL (COND ((NULL LISP::EXPRESSION) NIL) ((EQ LISP::EXPRESSION T) T) (T (LET (LISP::LOC LISP::VAL) (LISP:BLOCK LISP::EVAL-VARIABLE (LISP:WHEN LISP::ENVIRONMENT (|for| LISP::TAIL |on| (ENVIRONMENT-VARS LISP::ENVIRONMENT) |by| (CDDR LISP::TAIL) |when| (EQ LISP::EXPRESSION (CAR LISP::TAIL)) |do| (LISP:SETQ LISP::VAL (CADR LISP::TAIL)) (|if| (EQ LISP::VAL *SPECIAL-BINDING-MARK*) |then| (* |;;|  "return from FOR loop, skipping to SPECIALS code below.") (RETURN NIL) |else| (LISP:RETURN-FROM LISP::EVAL-VARIABLE LISP::VAL)))) (* |;;|  "following copied from \\EVALVAR in the Interlisp interpreter") (SETQ LISP::LOC (\\STKSCAN LISP::EXPRESSION)) (COND ((EQ (LISP:SETQ LISP::VAL (\\GETBASEPTR LISP::LOC 0)) 'NOBIND) (* \;  "Value is NOBIND even if it was not found as the top-level value.") (LISP:ERROR 'UNBOUND-VARIABLE :NAME LISP::EXPRESSION)) (T LISP::VAL))))))) (CONS (COND ((LISP:CONSP (CAR LISP::EXPRESSION)) (LET ((LISP::ARGCOUNT 1)) (* |;;| "This is a very very awful hack for getting into internal lambda expressions .COMPILER-SPREAD-ARGUMENTS. is handled specially by the compiler--it iterates over a list pushing things") (* |;;| "secondly, the (OPCODES) directly calls EVAL-INVOKE-LAMBDA with more args than are given, blowing away the following APPLYFN. Larry thought this level of hackery was important for performance.") (.COMPILER-SPREAD-ARGUMENTS. (CDR LISP::EXPRESSION) LISP::ARGCOUNT (CL-EVAL-FN3-CALL (CAR LISP::EXPRESSION) LISP::ENVIRONMENT) ((LISP:EVAL LISP::ENVIRONMENT))))) (T (LET ((LISP::FN-DEFN (AND LISP::ENVIRONMENT (LISP:GETF ( ENVIRONMENT-FUNCTIONS LISP::ENVIRONMENT) (CAR LISP::EXPRESSION)))) ) (COND ((NULL LISP::FN-DEFN) (* \;  "The normal case: the function is not lexically-defined.") (CASE (ARGTYPE (CAR LISP::EXPRESSION)) ((0 2) (* |;;| "has a Interlisp/CommonLisp lambda-spread definition") (LISP:IF (AND *APPLYHOOK* (NOT (PROG1 LISP::*SKIP-APPLYHOOK* (LISP:SETQ LISP::*SKIP-APPLYHOOK* NIL)))) (LET* ((LISP::ARGS (LISP:MAPCAR #'(LISP:LAMBDA (LISP::ARG) (LISP:EVAL LISP::ARG LISP::ENVIRONMENT) ) (CDR LISP::EXPRESSION))) (LISP::HOOKFN *APPLYHOOK*) (*APPLYHOOK* NIL)) (LISP:FUNCALL LISP::HOOKFN (CAR LISP::EXPRESSION) LISP::ARGS LISP::ENVIRONMENT)) (LET ((LISP::ARGCOUNT 0)) (.COMPILER-SPREAD-ARGUMENTS. (CDR LISP::EXPRESSION) LISP::ARGCOUNT (CAR LISP::EXPRESSION) ((LISP:EVAL LISP::ENVIRONMENT)))))) (T (* |;;|  "in Common Lisp, special form overrides nlambda definition") (* |;;| "note that the GET will error if not a symbol. ") (LET ((LISP::TEMP (GET (CAR LISP::EXPRESSION) 'SPECIAL-FORM))) (COND (LISP::TEMP (* \;  "CAR is the name of a special form.") (LISP:FUNCALL LISP::TEMP (CDR LISP::EXPRESSION ) LISP::ENVIRONMENT)) ((LISP:SETQ LISP::TEMP (LISP:MACRO-FUNCTION (CAR LISP::EXPRESSION))) (* \; "CAR is the name of a macro") (LISP:EVAL (LISP:FUNCALL LISP::TEMP LISP::EXPRESSION LISP::ENVIRONMENT) LISP::ENVIRONMENT)) (T (ERROR "Undefined car of form" (CAR LISP::EXPRESSION) ))))))) ((EQ (CAR LISP::FN-DEFN) :MACRO) (* \; "A use of a lexical macro.") (LISP:EVAL (LISP:FUNCALL (CDR LISP::FN-DEFN) LISP::EXPRESSION LISP::ENVIRONMENT) LISP::ENVIRONMENT)) (T (* \; "A call to a lexical function") (LET ((LISP::ARGCOUNT 0)) (.COMPILER-SPREAD-ARGUMENTS. (CDR LISP::EXPRESSION) LISP::ARGCOUNT (CDR LISP::FN-DEFN) ((LISP:EVAL LISP::ENVIRONMENT)))))))))) (T (* |;;| "CLtL2 says all CLtL objects except symbols and lists are self-evaluating; I'm extending that to all objects (including Interlisp thingies).") LISP::EXPRESSION)))))) (\\EVAL-INVOKE-LAMBDA (LAMBDA (N LAM ENV) (DECLARE (LOCALVARS . T)) (* \;  "Edited 28-Apr-87 11:55 by Pavel") (LET ((ARGBLOCK (ADDSTACKBASE (- (FETCH (FX NEXTBLOCK) OF (\\MYALINK)) (+ (LISP:DECF N) N))))) (* |;;| "First sub-form is a list of (variable initialization) pairs. Initializes the variables, binding them to new values all at once, then executes the remaining forms as in a PROGN.") (LISP:MULTIPLE-VALUE-BIND (BODY SPECIALS) (\\REMOVE-DECLS (CDDR LAM) (LISP:SETQ ENV (\\MAKE-CHILD-ENVIRONMENT ENV))) (\\INTERPRET-ARGUMENTS "a LAMBDA as the CAR of a form" (CASE (CAR LAM) ((LAMBDA OPENLAMBDA) '&INTERLISP) ((LISP:LAMBDA) '&REQUIRED) (T (LISP:ERROR "(~S ...) is not legal as the CAR of a form." (CAR LAM)))) (CADR LAM) SPECIALS ENV BODY ARGBLOCK N 0))))) (\\INTERPRET-ARGUMENTS (LAMBDA (\\FN-NAME \\ARGTYPE \\ARGLIST \\SPECIALS \\ENVIRONMENT \\BODY \\ARGUMENT-BLOCK \\LENGTH \\INDEX) (* \; "Edited 7-Apr-88 16:16 by amd") (* |;;| "Written in a somewhat arcane style to avoid recursive calls whenever possible, & keep code inline. RECUR does a recursive call if under a PROGV, but otherwise does a GO. ") (LISP:MACROLET ((RECUR (TAG) `(GO ,TAG)) (WITH-BINDING (VAR VAL &REST FORMS) `(PROGN (CHECK-BINDABLE ,VAR) (LISP:IF (OR (FMEMB ,VAR \\SPECIALS) (VARIABLE-GLOBALLY-SPECIAL-P ,VAR)) (LISP:MACROLET ((RECUR (TAG) `(\\INTERPRET-ARGUMENTS \\FN-NAME ,(LISP:IF (EQ TAG 'IN-KEYWORDS) '\\ARGTYPE `',TAG) \\ARGLIST \\SPECIALS \\ENVIRONMENT \\BODY \\ARGUMENT-BLOCK \\LENGTH \\INDEX))) (LISP:PROGV (LIST ,VAR) (LIST ,VAL) ,@FORMS)) (PROGN (LISP:SETF (ENVIRONMENT-VARS \\ENVIRONMENT) (LIST* ,VAR ,VAL (ENVIRONMENT-VARS \\ENVIRONMENT))) ,@FORMS))))) (PROG (\\VAR \\VAL \\SVAR \\SP) (* |;;| "dispatch on input type. The in-keywords case is special, since it needs to pass down where the beginning of the keywords section is") (CASE \\ARGTYPE (&REQUIRED (GO &REQUIRED)) (&OPTIONAL (GO &OPTIONAL)) (&INTERLISP (GO &INTERLISP)) (&REST (GO &REST)) (&KEY (GO &KEY)) (&AUX (GO &AUX)) (&BODY (GO &BODY)) (T (GO IN-KEYWORDS))) &REQUIRED (RETURN (COND ((NULL \\ARGLIST) (LISP:IF (< \\INDEX \\LENGTH) (LISP:ERROR 'TOO-MANY-ARGUMENTS :CALLEE \\FN-NAME :ACTUAL \\LENGTH :MAXIMUM \\INDEX)) (RECUR &BODY)) (T (CASE (SETQ \\VAR (|pop| \\ARGLIST)) (&OPTIONAL (RECUR &OPTIONAL)) (&REST (RECUR &REST)) (&AUX (RECUR &AUX)) (&KEY (RECUR &KEY)) (T (COND ((>= \\INDEX \\LENGTH) (LISP:ERROR 'TOO-FEW-ARGUMENTS :CALLEE \\FN-NAME :ACTUAL \\LENGTH :MINIMUM (+ 1 \\INDEX (FOR ARG IN \\ARGLIST WHILE (NOT (FMEMB ARG '(&OPTIONAL &REST &AUX &KEY)) ) SUM 1))))) (SETQ \\VAL (ARG-REF \\ARGUMENT-BLOCK (PROG1 \\INDEX (LISP:INCF \\INDEX) ))) (WITH-BINDING \\VAR \\VAL (RECUR &REQUIRED))))))) &OPTIONAL (RETURN (COND ((NULL \\ARGLIST) (LISP:IF (< \\INDEX \\LENGTH) (LISP:ERROR 'TOO-MANY-ARGUMENTS :CALLEE \\FN-NAME :ACTUAL \\LENGTH :MAXIMUM \\INDEX)) (RECUR &BODY)) (T (CASE (SETQ \\VAR (|pop| \\ARGLIST)) (&REST (RECUR &REST)) (&AUX (RECUR &AUX)) (&KEY (RECUR &KEY)) (T (LISP:IF (>= \\INDEX \\LENGTH) (LISP:IF (LISP:CONSP \\VAR) (PROGN (SETQ \\VAL (LISP:EVAL (CADR \\VAR) \\ENVIRONMENT)) (SETQ \\SVAR (CADDR \\VAR)) (SETQ \\VAR (CAR \\VAR)) (SETQ \\SP NIL)) (SETQ \\VAL NIL)) (PROGN (COND ((LISP:CONSP \\VAR) (SETQ \\SVAR (CADDR \\VAR)) (SETQ \\SP T) (SETQ \\VAR (CAR \\VAR)))) (SETQ \\VAL (ARG-REF \\ARGUMENT-BLOCK \\INDEX)) (LISP:INCF \\INDEX))) (WITH-BINDING \\VAR \\VAL (LISP:IF \\SVAR (WITH-BINDING \\SVAR \\SP (RECUR &OPTIONAL)) (RECUR &OPTIONAL)))))))) &INTERLISP (RETURN (COND ((NULL \\ARGLIST) (RECUR &BODY)) (T (SETQ \\VAR (|pop| \\ARGLIST)) (LISP:IF (>= \\INDEX \\LENGTH) (SETQ \\VAL NIL) (PROGN (SETQ \\VAL (ARG-REF \\ARGUMENT-BLOCK \\INDEX)) (LISP:INCF \\INDEX))) (WITH-BINDING \\VAR \\VAL (RECUR &INTERLISP))))) &REST (SETQ \\VAR (|pop| \\ARGLIST)) (SETQ \\VAL (|for| I |from| \\INDEX |while| (< I \\LENGTH) |collect| (ARG-REF \\ARGUMENT-BLOCK I))) (RETURN (WITH-BINDING \\VAR \\VAL (LISP:IF (NULL \\ARGLIST) (RECUR &BODY) (CASE (|pop| \\ARGLIST) (&AUX (RECUR &AUX)) (&KEY (RECUR &KEY)) (T (LISP:ERROR 'INVALID-ARGUMENT-LIST :CALLEE \\FN-NAME)))))) &KEY (OR (EVENP (- \\LENGTH \\INDEX)) (LISP:ERROR "Not an even number of arguments for &KEY")) (SETQ \\ARGTYPE \\ARGLIST) (* \;  "Type is now the beginning of the keyword arguments") IN-KEYWORDS (RETURN (COND ((NULL \\ARGLIST) (CHECK-KEYWORDS \\ARGTYPE \\ARGUMENT-BLOCK \\LENGTH \\INDEX) (RECUR &BODY)) (T (CASE (SETQ \\VAR (|pop| \\ARGLIST)) (&AUX (CHECK-KEYWORDS \\ARGTYPE \\ARGUMENT-BLOCK \\LENGTH \\INDEX) (RECUR &AUX)) (&ALLOW-OTHER-KEYS (LISP:IF (NULL \\ARGLIST) (RECUR &BODY) (CASE (|pop| \\ARGLIST) (&AUX (RECUR &AUX)) (T (LISP:ERROR 'INVALID-ARGUMENT-LIST :CALLEE \\FN-NAME))))) (T (COND ((LISP:CONSP \\VAR) (SETQ \\VAL (CADR \\VAR)) (SETQ \\SVAR (CADDR \\VAR)) (SETQ \\VAR (CAR \\VAR))) (T (SETQ \\SVAR NIL) (SETQ \\VAL NIL))) (LET ((KEY (LISP:IF (LISP:CONSP \\VAR) (PROG1 (CAR \\VAR) (SETQ \\VAR (CADR \\VAR))) (MAKE-KEYWORD \\VAR)))) (|for| I |from| \\INDEX |while| (< I \\LENGTH) |by| 2 |do| (LISP:IF (EQ (ARG-REF \\ARGUMENT-BLOCK I) KEY) (RETURN (PROGN (SETQ \\VAL (ARG-REF \\ARGUMENT-BLOCK (+ I 1))) (SETQ \\SP T)))) |finally| (SETQ \\VAL (LISP:EVAL \\VAL \\ENVIRONMENT )) (SETQ \\SP NIL))) (WITH-BINDING \\VAR \\VAL (LISP:IF \\SVAR (WITH-BINDING \\SVAR \\SP (RECUR IN-KEYWORDS )) (RECUR IN-KEYWORDS)))))))) &AUX (RETURN (COND ((NULL \\ARGLIST) (RECUR &BODY)) (T (SETQ \\VAR (|pop| \\ARGLIST)) (LISP:IF (LISP:CONSP \\VAR) (PROGN (SETQ \\VAL (LISP:EVAL (CADR \\VAR) \\ENVIRONMENT)) (SETQ \\VAR (CAR \\VAR))) (SETQ \\VAL NIL)) (WITH-BINDING \\VAR \\VAL (RECUR &AUX))))) &BODY (RETURN (LISP:IF (NULL (CDR \\BODY)) (LISP:IF (LISP:CONSP (SETQ \\BODY (CAR \\BODY))) (CASE (CAR \\BODY) (LISP:BLOCK (* |;;| "special case to handle BLOCK to avoid consing two environments just to enter a normal LAMBDA function") (LET ((BLIP (CONS NIL NIL))) (LISP:SETF (ENVIRONMENT-BLOCKS \\ENVIRONMENT) (LIST* (CADR \\BODY) BLIP (ENVIRONMENT-BLOCKS \\ENVIRONMENT))) (LISP:CATCH BLIP (\\EVAL-PROGN (CDDR \\BODY) \\ENVIRONMENT)))) (T (LISP:EVAL \\BODY \\ENVIRONMENT))) (LISP:EVAL \\BODY \\ENVIRONMENT)) (PROGN (LISP:EVAL (POP \\BODY) \\ENVIRONMENT) (RECUR &BODY)))))))) (\\INTERPRETER-LAMBDA (LAMBDA (N DEF ENV FN) (* \;  "Edited 13-Feb-87 21:21 by Pavel") (DECLARE (LOCALVARS . T)) (LET ((ARGBLOCK (ADDSTACKBASE (|fetch| (BF IVAR) |of| (|fetch| (FX BLINK) |of| (\\MYALINK)))))) (SETQ ENV (\\MAKE-CHILD-ENVIRONMENT ENV)) (LISP:MULTIPLE-VALUE-BIND (BODY SPECIALS) (\\REMOVE-DECLS (CDR (CDR DEF)) ENV) (\\INTERPRET-ARGUMENTS FN '&REQUIRED (CAR (CDR DEF)) SPECIALS ENV BODY ARGBLOCK (- N 1) 0))))) (CHECK-BINDABLE (LAMBDA (VAR) (* \;  "Edited 13-Feb-87 22:06 by Pavel") (LISP:UNLESS (LISP:SYMBOLP VAR) (LISP:ERROR "Attempt to bind a non-symbol: ~S" VAR)) (LISP:WHEN (OR (LISP:CONSTANTP VAR) (FMEMB VAR LISP:LAMBDA-LIST-KEYWORDS)) (LISP:ERROR (LISP:IF (LISP:KEYWORDP VAR) "Attempt to bind a keyword: ~S" "Attempt to bind a constant: ~S") VAR)) (LISP:WHEN (VARIABLE-GLOBAL-P VAR) (LISP:CERROR "Go ahead and bind it anyway" "Attempt to bind a variable proclaimed global: ~S" VAR)) VAR)) (CHECK-KEYWORDS (LAMBDA (KEY-ARGUMENTS ARGBLOCK LENGTH N) (* \; "Edited 1-Dec-87 16:47 by amd") (* |;;| "check to see if any keywords in ARGBLOCK are not in the keys - not called if &ALLOW-OTHER-KEYS was set") (LISP:BLOCK CHECK-KEYS (LET (BADKEYWORD) (LISP:DO ((I N (+ I 2))) ((>= I LENGTH)) (LET ((GIVEN-KEY (ARG-REF ARGBLOCK I))) (LISP:IF (EQ GIVEN-KEY :ALLOW-OTHER-KEYS) (LISP:IF (ARG-REF ARGBLOCK (LISP:1+ I)) (LISP:RETURN-FROM CHECK-KEYS NIL) NIL) (LISP:DO ((KEYTAIL KEY-ARGUMENTS (CDR KEYTAIL))) ((OR (NULL KEYTAIL) (EQ (CAR KEYTAIL) '&AUX)) (* \; "got to end of keyword segment") (SETQ BADKEYWORD GIVEN-KEY)) (LET ((WANTED-KEY (CAR KEYTAIL))) (IF (LISP:CONSP WANTED-KEY) THEN (SETQ WANTED-KEY (CAR WANTED-KEY)) (LISP:IF (LISP:CONSP WANTED-KEY) (SETQ WANTED-KEY (CAR WANTED-KEY)) (SETQ WANTED-KEY (MAKE-KEYWORD WANTED-KEY))) ELSE (SETQ WANTED-KEY (MAKE-KEYWORD WANTED-KEY))) (LISP:IF (EQ WANTED-KEY GIVEN-KEY) (RETURN NIL))))))) (LISP:IF BADKEYWORD (LISP:ERROR "Keyword argument doesn't match expected list of keywords: ~A" BADKEYWORD)))))) ) (DEFMACRO ARG-REF (BLOCK N) `(\\GETBASEPTR ,BLOCK (LLSH ,N 1))) (PUTPROPS .COMPILER-SPREAD-ARGUMENTS. DMACRO (APPLY COMP.SPREAD)) (DEFINEQ (DECLARED-SPECIAL (LAMBDA (VAR DECLS) (* |lmm| "24-May-86 22:27") (AND DECLS (OR (AND (LISTP (CAR DECLS)) (EQ (CAAR DECLS) 'DECLARE) (|for| DEC |in| (CDAR DECLS) |when| (AND (EQ (CAR DEC) 'LISP:SPECIAL) (FMEMB VAR (CDR DEC))) |do| (RETURN T))) (DECLARED-SPECIAL VAR (CDR DECLS)))))) ) (* \; "FUNCALL and APPLY, not quite same as Interlisp") (DEFINEQ (LISP:FUNCALL (LISP:LAMBDA (LISP::FN &REST LISP::ARGS) (* \;  "Edited 14-Feb-87 00:16 by Pavel") (LISP:APPLY LISP::FN LISP::ARGS))) (LISP:APPLY (LAMBDA LISP::N (* \;  "Edited 14-Feb-87 00:16 by Pavel") (LISP:IF (EQ LISP::N 0) (ERROR "TOO FEW ARGUMENTS TO APPLY") (SPREADAPPLY (ARG LISP::N 1) (LET ((LISP::AV (ARG LISP::N LISP::N))) (FOR LISP::I FROM (LISP:1- LISP::N) TO 2 BY -1 DO (LISP:PUSH (ARG LISP::N LISP::I) LISP::AV)) LISP::AV))))) ) (PUTPROPS LISP:APPLY DMACRO (DEFMACRO (FN &REST ARGS) (CASE COMPILE.CONTEXT ((EFFECT RETURN) `(LET ((FN ,FN) (CNT ,(LENGTH (CDR ARGS)))) (.SPREAD. ((OPCODES) \,@ ARGS) CNT FN))) (T (* |;;|  "otherwise might not return multiple values") 'IGNOREMACRO)))) (PUTPROPS LISP:FUNCALL DMACRO (DEFMACRO (FN &REST ARGS) (COND ((AND (NLISTP FN) (EVERY ARGS (FUNCTION NLISTP))) `((OPCODES APPLYFN) ,@ARGS ,(LENGTH ARGS) ,FN)) (T (LET ((TEM (GENSYM))) `((LAMBDA (,TEM) ((OPCODES APPLYFN) ,@ARGS ,(LENGTH ARGS) ,TEM)) ,FN)))))) (* \; "COMPILER-LET needs to work differently compiled and interpreted") (DEFINEQ (LISP:COMPILER-LET (NLAMBDA $$COMPILER-LET-TAIL (* \; "Edited 7-Apr-88 16:05 by amd") (LISP:PROGV (|for| X |in| (CAR $$COMPILER-LET-TAIL) |collect| (COND ((LISP:CONSP X) (CAR X)) (T X))) (|for| X |in| (CAR $$COMPILER-LET-TAIL) |collect| (COND ((LISP:CONSP X) (\\EVAL (CADR X))))) (\\EVPROGN (CDR $$COMPILER-LET-TAIL))))) (COMP.COMPILER-LET (LAMBDA (\\A) (DECLARE (LOCALVARS . T)) (* \; "Edited 7-Apr-88 16:38 by amd") (* ENTRY POINT INTO BYTECOMPILER) (* |lmm| "27-May-86 11:17") (LISP:PROGV (|for| X |in| (CAR \\A) |collect| (|if| (LISP:CONSP X) |then| (CAR X) |else| X)) (|for| X |in| (CAR \\A) |collect| (COND ((LISP:CONSP X) (EVAL (CADR X))))) (COMP.PROGN (CDR \\A))))) ) (PUTPROPS LISP:COMPILER-LET DMACRO COMP.COMPILER-LET) (DEFINE-SPECIAL-FORM LISP:COMPILER-LET (LISP::ARGS &REST LISP::BODY &ENVIRONMENT LISP::ENV) (LET ((*IN-COMPILER-LET* T)) (DECLARE (LISP:SPECIAL *IN-COMPILER-LET*)) (* \;  "the *IN-COMPILER-LET* is for macro-caching. It says: don't cache macros under compiler lets") (LISP:PROGV (FOR LISP::X IN LISP::ARGS COLLECT (IF (LISP:CONSP LISP::X) THEN (CAR LISP::X) ELSE LISP::X)) (FOR LISP::X IN LISP::ARGS COLLECT (IF (LISP:CONSP LISP::X) THEN (LISP:EVAL (CADR LISP::X) LISP::ENV) ELSE NIL)) (\\EVAL-PROGN LISP::BODY LISP::ENV)))) (* \; "Lexical function- and macro-binding forms: FLET, LABELS, and MACROLET.") (DEFINE-SPECIAL-FORM LISP:MACROLET (LISP::MACRO-DEFNS &BODY LISP::BODY &ENVIRONMENT LISP::ENV) (LET (LISP::NEW-ENV LISP::FUNCTIONS) (* |;;|  "We parse and handle the declarations here, so they'll take effect in the new child environment") (LISP:MULTIPLE-VALUE-BIND (LISP::BODY LISP::SPECIALS) (\\REMOVE-DECLS LISP::BODY (LISP:SETQ LISP::NEW-ENV (\\MAKE-CHILD-ENVIRONMENT LISP::ENV))) (LISP:SETQ LISP::FUNCTIONS (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV)) (FOR LISP::MACRO-DEFN IN LISP::MACRO-DEFNS DO (LISP:SETQ LISP::FUNCTIONS (LIST* (CAR LISP::MACRO-DEFN) (CONS :MACRO `(LISP:LAMBDA (SI::$$MACRO-FORM SI::$$MACRO-ENVIRONMENT ) (LISP:BLOCK ,(CAR LISP::MACRO-DEFN) ,(PARSE-DEFMACRO (CADR LISP::MACRO-DEFN) 'SI::$$MACRO-FORM (CDDR LISP::MACRO-DEFN) (CAR LISP::MACRO-DEFN) NIL :ENVIRONMENT 'SI::$$MACRO-ENVIRONMENT)))) LISP::FUNCTIONS))) (LISP:SETF (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV) LISP::FUNCTIONS) (\\EVAL-PROGN LISP::BODY LISP::NEW-ENV)))) (DEFINE-SPECIAL-FORM LISP:FLET (LISP::FN-DEFNS &BODY LISP::BODY &ENVIRONMENT LISP::ENV) (LET (LISP::NEW-ENV LISP::FUNCTIONS) (* |;;|  "We parse and handle the declarations here, so they'll take effect in the new child environment") (LISP:MULTIPLE-VALUE-BIND (LISP::BODY LISP::SPECIALS) (\\REMOVE-DECLS LISP::BODY (LISP:SETQ LISP::NEW-ENV (\\MAKE-CHILD-ENVIRONMENT LISP::ENV))) (LISP:SETQ LISP::FUNCTIONS (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV)) (FOR LISP::FN-DEFN IN LISP::FN-DEFNS BIND LISP::FNAME DO (LISP:SETQ LISP::FNAME (LISP:FIRST LISP::FN-DEFN)) (LISP:SETQ LISP::FUNCTIONS (LIST* LISP::FNAME (CONS :FUNCTION (MAKE-CLOSURE :FUNCTION (LISP:MULTIPLE-VALUE-BIND (LISP::BODY LISP::DECLS) (PARSE-BODY (CDDR LISP::FN-DEFN) LISP::ENV T) `(LISP:LAMBDA ,(LISP:SECOND LISP::FN-DEFN) ,@LISP::DECLS (LISP:BLOCK ,(LISP:IF (LISP:SYMBOLP LISP::FNAME LISP::FNAME (LISP:SECOND LISP::FNAME))) ,@LISP::BODY))) :ENVIRONMENT LISP::ENV)) LISP::FUNCTIONS))) (LISP:SETF (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV) LISP::FUNCTIONS) (\\EVAL-PROGN LISP::BODY LISP::NEW-ENV)))) (DEFINE-SPECIAL-FORM LISP:LABELS (LISP::FN-DEFNS &BODY LISP::BODY &ENVIRONMENT LISP::ENV) (LET (LISP::NEW-ENV LISP::FUNCTIONS) (* |;;|  "We parse and handle the declarations here, so they'll take effect in the new child environment") (LISP:MULTIPLE-VALUE-BIND (LISP::BODY LISP::SPECIALS) (\\REMOVE-DECLS LISP::BODY (LISP:SETQ LISP::NEW-ENV (\\MAKE-CHILD-ENVIRONMENT LISP::ENV))) (LISP:SETQ LISP::FUNCTIONS (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV)) (FOR LISP::FN-DEFN IN LISP::FN-DEFNS BIND LISP::FNAME DO (LISP:SETQ LISP::FNAME (LISP:FIRST LISP::FN-DEFN)) (LISP:SETQ LISP::FUNCTIONS (LIST* LISP::FNAME (CONS :FUNCTION (* |;;| "Must share the environment object so that all of the new lexical function bindings appear in each new functions environment.") (MAKE-CLOSURE :FUNCTION (LISP:MULTIPLE-VALUE-BIND (LISP::BODY LISP::DECLS) (PARSE-BODY (CDDR LISP::FN-DEFN) LISP::NEW-ENV T) `(LISP:LAMBDA ,(LISP:SECOND LISP::FN-DEFN) ,@LISP::DECLS (LISP:BLOCK ,(LISP:IF (LISP:SYMBOLP LISP::FNAME) LISP::FNAME (LISP:SECOND LISP::FNAME)) ,@LISP::BODY))) :ENVIRONMENT LISP::NEW-ENV)) LISP::FUNCTIONS))) (LISP:SETF (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV) LISP::FUNCTIONS) (\\EVAL-PROGN LISP::BODY LISP::NEW-ENV)))) (DEFINE-SPECIAL-FORM QUOTE CAR) (DEFINE-SPECIAL-FORM THE (LISP::TYPE-SPEC LISP::FORM &ENVIRONMENT LISP::ENV) (LISP:IF (AND (LISP:CONSP LISP::TYPE-SPEC) (EQ (CAR LISP::TYPE-SPEC) 'LISP:VALUES)) (LET ((LISP:VALUES (LISP:MULTIPLE-VALUE-LIST (LISP:EVAL LISP::FORM LISP::ENV)))) (LISP:IF (LISP:NOTEVERY #'(LISP:LAMBDA (LISP::VALUE LISP::SPEC) (TYPEP LISP::VALUE LISP::SPEC)) LISP:VALUES (CDR LISP::TYPE-SPEC)) (CHECK-TYPE-FAIL T LISP::FORM LISP:VALUES LISP::TYPE-SPEC NIL) (LISP:VALUES-LIST LISP:VALUES))) (LET ((LISP::VALUE (LISP:EVAL LISP::FORM LISP::ENV))) (LISP:IF (TYPEP LISP::VALUE LISP::TYPE-SPEC) LISP::VALUE (CHECK-TYPE-FAIL T LISP::FORM LISP::VALUE LISP::TYPE-SPEC NIL))))) (PUTPROPS THE DMACRO ((SPEC FORM) FORM)) (PUTPROPS LISP:EVAL-WHEN DMACRO (DEFMACRO (OPTIONS &BODY BODY) (AND (OR (FMEMB 'COMPILE OPTIONS) (FMEMB 'LISP:COMPILE OPTIONS)) (MAPC BODY (FUNCTION LISP:EVAL))) (AND (OR (FMEMB 'LOAD OPTIONS) (FMEMB 'LISP:LOAD OPTIONS)) `(PROGN ,@BODY)))) (DEFINEQ (LISP:EVAL-WHEN (NLAMBDA OPTIONS.BODY (* |lmm| " 1-Jun-86 15:16") (AND (OR (FMEMB 'LISP:EVAL (CAR OPTIONS.BODY)) (FMEMB 'EVAL (CAR OPTIONS.BODY)) (FMEMB :EXECUTE (CAR OPTIONS.BODY))) (MAPC (CDR OPTIONS.BODY) (FUNCTION \\EVAL))))) ) (DEFINE-SPECIAL-FORM LISP:EVAL-WHEN (LISP::TAGS &REST LISP::BODY &ENVIRONMENT LISP::ENV) (AND (OR (LISP:MEMBER 'LISP:EVAL LISP::TAGS) (LISP:MEMBER 'EVAL LISP::TAGS) (LISP:MEMBER :EXECUTE LISP::TAGS)) (\\EVAL-PROGN LISP::BODY LISP::ENV))) (DEFINE-SPECIAL-FORM DECLARE FALSE) (DEFMACRO LISP:LOCALLY (&BODY LISP::BODY) (* |;;| "This is a macro and not a special form because, as near as I can tell, it doesn't matter to Medley; saying LOCALLY at the top level allows pervasive declarations of all the types Medley actually observes.") `(LET NIL ,@LISP::BODY)) (DEFMACRO LISP:LOCALLY (&BODY LISP::BODY) (* |;;| "This is a macro and not a special form because, as near as I can tell, it doesn't matter to Medley; saying LOCALLY at the top level allows pervasive declarations of all the types Medley actually observes.") `(LET NIL ,@LISP::BODY)) (* \; "Interlisp version on LLINTERP") (DEFINE-SPECIAL-FORM PROGN \\EVAL-PROGN) (DEFINEQ (\\EVAL-PROGN (LAMBDA (BODY ENVIRONMENT) (* \;  "Edited 12-Feb-87 20:25 by Pavel") (|if| (CDR BODY) |then| (LISP:EVAL (CAR BODY) ENVIRONMENT) (\\EVAL-PROGN (CDR BODY) ENVIRONMENT) |else| (LISP:EVAL (CAR BODY) ENVIRONMENT)))) ) (* \; "Confused because currently Interlisp special form, fixing MACRO-FUNCTION is complex") (* \; "The Interlisp function is on LLINTERP") (DEFINE-SPECIAL-FORM PROG1 (LISP:FIRST &REST LISP:REST &ENVIRONMENT LISP::ENV) (LET ((LISP::VAL (LISP:EVAL LISP:FIRST LISP::ENV))) (LISP:TAGBODY PROG1 (LISP:IF LISP:REST (PROGN (LISP:EVAL (CAR LISP:REST) LISP::ENV) (LISP:SETQ LISP:REST (CDR LISP:REST))) (LISP:RETURN-FROM PROG1 LISP::VAL)) (GO PROG1)))) (DEFMACRO PROG1 (LISP:FIRST &REST LISP:REST) `(LET ((SI::$PROG1-FIRST-EXPRESSION$ ,LISP:FIRST)) (DECLARE (LOCALVARS SI::$PROG1-FIRST-EXPRESSION$)) ,@LISP:REST SI::$PROG1-FIRST-EXPRESSION$)) (DEFINE-SPECIAL-FORM LET* (LISP::VARS &REST LISP::BODY &ENVIRONMENT LISP::ENV) (LISP:MULTIPLE-VALUE-BIND (LISP::BODY LISP::SPECIALS) (\\REMOVE-DECLS LISP::BODY (LISP:SETQ LISP::ENV (\\MAKE-CHILD-ENVIRONMENT LISP::ENV))) (\\LET*-RECURSION LISP::VARS LISP::SPECIALS LISP::ENV LISP::BODY))) (DEFINE-SPECIAL-FORM LET (LISP::VARS &BODY LISP::BODY &ENVIRONMENT LISP::ENV &AUX LISP::\\NEW-ENV ) (* |;;| "Initializes the variables, binding them to new values all at once, then executes the remaining forms as in a PROGN.") (LISP:MULTIPLE-VALUE-BIND (LISP::\\BODY LISP::SPECIALS) (\\REMOVE-DECLS LISP::BODY (LISP:SETQ LISP::\\NEW-ENV (\\MAKE-CHILD-ENVIRONMENT LISP::ENV))) (* |;;| "Note that since remove decls side-effects the environment, variables which are declared special inside this scope will cause references inside the variable value forms to do special reference.") (LET ((LISP::ENV-VARS (ENVIRONMENT-VARS LISP::\\NEW-ENV)) LISP::SPECVARS LISP::SPECVALS LISP::VALUE) (FOR LISP::VAR IN LISP::VARS DO (COND ((LISP:CONSP LISP::VAR) (* |;;| "NEW-ENV current has all of the new specials, but none of the new lexicals. This is the right environment to eval in.") (LISP:SETQ LISP::VALUE (LISP:EVAL (CADR LISP::VAR) LISP::\\NEW-ENV)) (LISP:SETQ LISP::VAR (CAR LISP::VAR))) (T (LISP:SETQ LISP::VALUE NIL))) (CHECK-BINDABLE LISP::VAR) (IF (OR (FMEMB LISP::VAR LISP::SPECIALS) (VARIABLE-GLOBALLY-SPECIAL-P LISP::VAR)) THEN (LISP:PUSH LISP::VAR LISP::SPECVARS) (LISP:PUSH LISP::VALUE LISP::SPECVALS) ELSE (LISP:SETQ LISP::ENV-VARS (LIST* LISP::VAR LISP::VALUE LISP::ENV-VARS)))) (LISP:SETF (ENVIRONMENT-VARS LISP::\\NEW-ENV) LISP::ENV-VARS) (LISP:IF LISP::SPECVARS (LISP:PROGV LISP::SPECVARS LISP::SPECVALS (\\EVAL-PROGN LISP::\\BODY LISP::\\NEW-ENV)) (\\EVAL-PROGN LISP::\\BODY LISP::\\NEW-ENV))))) (PUTPROPS LET MACRO (X (|\\LETtran| X))) (PUTPROPS LET* MACRO (X (|\\LETtran| X T))) (DEFINEQ (\\LET*-RECURSION (LAMBDA (VARS $$LET*-SPECIALS $$LET*-ENV $$LET*-BODY) (DECLARE (LOCALVARS . T)) (* \; "Edited 7-Apr-88 16:09 by amd") (|bind| VAR VALUE |for| $$LET*-TAIL |on| VARS |eachtime| (SETQ VAR (CAR $$LET*-TAIL)) |do| (COND ((LISP:CONSP VAR) (SETQ VALUE (LISP:EVAL (CADR VAR) $$LET*-ENV)) (SETQ VAR (CAR VAR))) (T (SETQ VALUE NIL))) (CHECK-BINDABLE VAR) (LISP:IF (OR (FMEMB VAR $$LET*-SPECIALS) (VARIABLE-GLOBALLY-SPECIAL-P VAR)) (RETURN (LISP:PROGV (LIST VAR) (LIST VALUE) (\\LET*-RECURSION (CDR $$LET*-TAIL) $$LET*-SPECIALS $$LET*-ENV $$LET*-BODY))) (LISP:SETF (ENVIRONMENT-VARS $$LET*-ENV) (LIST* VAR VALUE (ENVIRONMENT-VARS $$LET*-ENV)))) |finally| (RETURN (\\EVAL-PROGN $$LET*-BODY $$LET*-ENV))))) (|\\LETtran| (LAMBDA (LETTAIL SEQUENTIALP) (* \; "Edited 23-Dec-86 16:23 by lmm") (* |;;| "Interlisp version of LET/LET*/PROG*") (PROG ((VARS (MAPCAR (CAR LETTAIL) (FUNCTION (LAMBDA (BINDENTRY) (|if| (LISTP BINDENTRY) |then| (CAR BINDENTRY) |else| BINDENTRY))))) (VALS (MAPCAR (CAR LETTAIL) (FUNCTION (LAMBDA (BINDENTRY) (|if| (LISTP BINDENTRY) |then| (CADR BINDENTRY) |else| NIL))))) (BODY (CDR LETTAIL)) (DECLS NIL)) (LISP:MULTIPLE-VALUE-SETQ (BODY DECLS) (PARSE-BODY BODY NIL)) (RETURN (|if| (NOT SEQUENTIALP) |then| `((,'LAMBDA ,VARS ,@DECLS ,@BODY) ,@VALS) |elseif| (NULL (CDR VARS)) |then| (SELECTQ SEQUENTIALP (PROG* `(PROG ,@LETTAIL)) `((,'LAMBDA ,VARS ,@DECLS ,@BODY) ,@VALS)) |else| (* \;  "in the sequential case, all declarations must be included in each") (|if| (EQ SEQUENTIALP 'PROG*) |then| (SETQ BODY (LIST (LIST* 'PROG NIL BODY)))) (|for| VAR |in| (REVERSE (CDR VARS)) |as| VAL |in| (REVERSE (CDR VALS)) |do| (SETQ BODY `(((,'LAMBDA (,VAR) ,@DECLS ,@BODY) ,VAL)))) `((,'LAMBDA (,(CAR VARS)) ,@DECLS ,@BODY) ,(CAR VALS))))))) ) (DEFINE-SPECIAL-FORM COND (&REST LISP::COND-CLAUSES &ENVIRONMENT LISP::ENVIRONMENT) (PROG NIL LISP::CONDLOOP (COND ((NULL LISP::COND-CLAUSES) (RETURN NIL)) ((NULL (CDAR LISP::COND-CLAUSES)) (RETURN (OR (LISP:EVAL (CAAR LISP::COND-CLAUSES) LISP::ENVIRONMENT) (PROGN (LISP:SETQ LISP::COND-CLAUSES (CDR LISP::COND-CLAUSES) ) (GO LISP::CONDLOOP))))) ((LISP:EVAL (CAAR LISP::COND-CLAUSES) LISP::ENVIRONMENT) (RETURN (\\EVAL-PROGN (CDAR LISP::COND-CLAUSES) LISP::ENVIRONMENT))) (T (LISP:SETQ LISP::COND-CLAUSES (CDR LISP::COND-CLAUSES)) (GO LISP::CONDLOOP))))) (DEFMACRO COND (&REST LISP::TAIL) (LISP:IF LISP::TAIL (LISP:IF (NULL (CDAR LISP::TAIL)) (LISP:IF (CDR LISP::TAIL) (LET ((VAR (LISP:GENTEMP))) `(LET ((,VAR ,(CAAR LISP::TAIL))) (LISP:IF ,VAR ,VAR (COND ,@(CDR LISP::TAIL))))) `(LISP:VALUES ,(CAAR LISP::TAIL))) `(LISP:IF ,(CAAR LISP::TAIL) ,(MKPROGN (CDAR LISP::TAIL)) ,@(LISP:IF (CDR LISP::TAIL) (LIST (LISP:IF (EQ (CAADR LISP::TAIL) T) (LISP:IF (NULL (CDADR LISP::TAIL)) T (MKPROGN (CDADR LISP::TAIL))) `(COND ,@(CDR LISP::TAIL))))))))) (DEFINEQ (LISP:IF (NLAMBDA (LISP::TEST LISP::THEN LISP::ELSE) (DECLARE (LOCALVARS . T)) (* \;  "Edited 12-Feb-87 20:27 by Pavel") (LISP:IF (\\EVAL LISP::TEST) (\\EVAL LISP::THEN) (\\EVAL LISP::ELSE)))) ) (DEFINE-SPECIAL-FORM LISP:IF (LISP::TEST LISP::THEN &OPTIONAL LISP::ELSE &ENVIRONMENT LISP::ENVIRONMENT) (LISP:IF (LISP:EVAL LISP::TEST LISP::ENVIRONMENT) (LISP:EVAL LISP::THEN LISP::ENVIRONMENT) (LISP:EVAL LISP::ELSE LISP::ENVIRONMENT))) (PUTPROPS LISP:IF DMACRO COMP.IF) (* \; "Interlisp NLAMBDA definitions on LLINTERP") (* \; "both special form and macro") (DEFMACRO AND (&REST LISP::FORMS) (COND ((CDR LISP::FORMS) `(LISP:IF ,(CAR LISP::FORMS) (AND ,@(CDR LISP::FORMS)))) (LISP::FORMS (CAR LISP::FORMS)) (T T))) (DEFMACRO OR (&REST LISP::FORMS) (LISP:IF (NULL (CDR LISP::FORMS)) (CAR LISP::FORMS) `(LET ((SI::*OR-GENTEMP* ,(CAR LISP::FORMS))) (DECLARE (LOCALVARS SI::*OR-GENTEMP*)) (LISP:IF SI::*OR-GENTEMP* SI::*OR-GENTEMP* (OR ,@(CDR LISP::FORMS)))))) (DEFINE-SPECIAL-FORM AND (&REST LISP::AND-CLAUSES &ENVIRONMENT LISP::ENV) (LISP:LOOP (COND ((NULL LISP::AND-CLAUSES) (RETURN T)) ((NULL (CDR LISP::AND-CLAUSES)) (RETURN (LISP:EVAL (CAR LISP::AND-CLAUSES) LISP::ENV))) (T (LISP:IF (LISP:EVAL (CAR LISP::AND-CLAUSES) LISP::ENV) (LISP:POP LISP::AND-CLAUSES) (RETURN NIL)))))) (DEFINE-SPECIAL-FORM OR (&REST LISP::TAIL &ENVIRONMENT LISP::ENV) (BIND LISP::VAL FOR OLD LISP::TAIL ON LISP::TAIL (COND ((NULL (CDR LISP::TAIL)) (RETURN (LISP:EVAL (CAR LISP::TAIL ) LISP::ENV))) ((LISP:SETQ LISP::VAL (LISP:EVAL (CAR LISP::TAIL ) LISP::ENV)) (RETURN LISP::VAL))))) (* \; "BLOCK and RETURN go together") (DEFINEQ (LISP:BLOCK (NLAMBDA LISP::TAIL (* \;  "Edited 12-Feb-87 20:31 by Pavel") (\\EVPROGN (CDR LISP::TAIL)))) ) (PUTPROPS LISP:BLOCK DMACRO COMP.BLOCK) (DEFINE-SPECIAL-FORM LISP:BLOCK (LISP::NAME &REST LISP::\\BODY &ENVIRONMENT LISP::ENVIRONMENT) (* |;;| "Syntax is (BLOCK name . body). The body is evaluated as a PROGN, but it is possible to exit the block using (RETURN-FROM name value). The RETURN-FROM must be lexically contained within the block.") (LET* ((LISP::BLIP (CONS NIL NIL)) (LISP::\\NEW-ENV (\\MAKE-CHILD-ENVIRONMENT LISP::ENVIRONMENT :BLOCK (LISP::NAME LISP::BLIP)) )) (LISP:CATCH LISP::BLIP (\\EVAL-PROGN LISP::\\BODY LISP::\\NEW-ENV)))) (DEFMACRO RETURN (LISP::VALUE) `(LISP:RETURN-FROM NIL ,LISP::VALUE)) (DEFINEQ (LISP:RETURN-FROM (NLAMBDA (LISP::RETFROM-TAG LISP::RETFROM-VALUE) (DECLARE (LOCALVARS . T)) (* \;  "Edited 12-Feb-87 20:35 by Pavel") (LET ((LISP::RETVALUES (LISP:MULTIPLE-VALUE-LIST (\\EVAL LISP::RETFROM-VALUE)))) (LET ((LISP::FRAME (STKNTH 1))) (WHILE LISP::FRAME DO (LISP:IF (OR (AND (NULL LISP::RETFROM-TAG) (EQ (STKNAME LISP::FRAME) '\\PROG0)) (AND (EQ (STKNAME LISP::FRAME) 'LISP:BLOCK) (EQ (CAR (STKARG 1 LISP::FRAME)) LISP::RETFROM-TAG))) (RETVALUES LISP::FRAME LISP::RETVALUES T) (LISP:SETQ LISP::FRAME (STKNTH 1 LISP::FRAME LISP::FRAME))) FINALLY (LISP:ERROR 'ILLEGAL-RETURN :TAG LISP::RETFROM-TAG)))))) ) (DEFINE-SPECIAL-FORM LISP:RETURN-FROM (LISP::BLOCK-NAME LISP::EXPR &ENVIRONMENT LISP::ENV) (LET ((LISP::BLIP (AND LISP::ENV (LISP:GETF (ENVIRONMENT-BLOCKS LISP::ENV) LISP::BLOCK-NAME)))) (LISP:IF (AND LISP::BLOCK-NAME (NULL LISP::BLIP)) (LISP:ERROR 'ILLEGAL-RETURN :TAG LISP::BLOCK-NAME) (LET ((LISP::\\BLK LISP::BLOCK-NAME) (LISP::VALS (LISP:MULTIPLE-VALUE-LIST (LISP:EVAL LISP::EXPR LISP::ENV)))) (COND (LISP::BLIP (* \;  "This is a CL RETURN-FROM, so do the throw.") (HANDLER-BIND ((ILLEGAL-THROW #'(LISP:LAMBDA (LISP::C) (DECLARE (IGNORE LISP::C)) (LISP:ERROR 'ILLEGAL-RETURN :TAG LISP::\\BLK)))) (LISP:THROW LISP::BLIP (LISP:VALUES-LIST LISP::VALS)))) (T (* \;  "This is an IL RETURN, so return from the closest enclosing \\PROG0.") (RETVALUES (STKPOS '\\PROG0) LISP::VALS T))))))) (* \; "IL and CL versions of FUNCTION.") (DEFINEQ (LISP:FUNCTION (NLAMBDA (LISP::FN) (* \;  "Edited 30-Jan-87 19:07 by Pavel") (* |;;;| "Fake CL:FUNCTION for Interlisp --- no lexical closures") (LISP:IF (LISP:SYMBOLP LISP::FN) (LISP:SYMBOL-FUNCTION LISP::FN) LISP::FN))) ) (PUTPROPS LISP:FUNCTION DMACRO (DEFMACRO (X) (COND ((LISP:SYMBOLP X) `(LISP:SYMBOL-FUNCTION ',X)) (T `(FUNCTION ,X))))) (DEFINE-SPECIAL-FORM FUNCTION (FN &OPTIONAL FUNARGP &ENVIRONMENT ENVIRONMENT) (* |;;| "Interlisp FUNCTION in Common Lisp interpreter:") (* |;;| "like CL:FUNCTION except that (FUNCTION FOO) just returns FOO and not its definition.") (COND (FUNARGP (LISP:FUNCALL #'FUNCTION FN FUNARGP)) ((LISP:SYMBOLP FN) (LET (FN-DEFN) (COND ((OR (NULL ENVIRONMENT) (NULL (SETQ FN-DEFN (LISP:GETF (ENVIRONMENT-FUNCTIONS ENVIRONMENT) FN)))) FN) ((EQ (CAR FN-DEFN) :FUNCTION) (CDR FN-DEFN)) (T (LISP:ERROR "The lexical macro ~S is not a legal argument to ~S." FN 'FUNCTION))))) ((OR (NULL ENVIRONMENT) (AND (FOR VALUE IN (CDR (ENVIRONMENT-VARS ENVIRONMENT)) BY CDDR ALWAYS (EQ VALUE *SPECIAL-BINDING-MARK*)) (NULL (ENVIRONMENT-FUNCTIONS ENVIRONMENT)) (NULL (ENVIRONMENT-BLOCKS ENVIRONMENT)) (NULL (ENVIRONMENT-TAGBODIES ENVIRONMENT)))) FN) (T (MAKE-CLOSURE :FUNCTION (COND ((EQ (CAR FN) 'LAMBDA) `(LISP:LAMBDA (&OPTIONAL ,@(CADR FN) &REST IGNORE) ,@(CDDR FN))) (T FN)) :ENVIRONMENT ENVIRONMENT)))) (DEFINE-SPECIAL-FORM LISP:FUNCTION (LISP::FN &ENVIRONMENT LISP::ENVIRONMENT) (COND ((LISP:SYMBOLP LISP::FN) (LET (LISP::FN-DEFN) (COND ((OR (NULL LISP::ENVIRONMENT) (NULL (LISP:SETQ LISP::FN-DEFN (LISP:GETF (ENVIRONMENT-FUNCTIONS LISP::ENVIRONMENT) LISP::FN)))) (LISP:SYMBOL-FUNCTION LISP::FN)) ((EQ (CAR LISP::FN-DEFN) :FUNCTION) (CDR LISP::FN-DEFN)) (T (LISP:ERROR "The lexical macro ~S is not a legal argument to ~S." LISP::FN 'LISP:FUNCTION))))) ((LISP::SETF-NAME-P LISP::FN) (* \; "Like symbol case, sort of...") (LET (LISP::FN-DEFN) (COND ((OR (NULL LISP::ENVIRONMENT) (NULL (PROGN (LISP:DO ((LISP::EF (ENVIRONMENT-FUNCTIONS LISP::ENVIRONMENT) (CDDR LISP::EF))) ((NULL LISP::EF)) (LISP:WHEN (LISP:EQUAL (CAR LISP::EF) LISP::FN) (LISP:SETQ LISP::FN-DEFN (CADR LISP::EF)) (LISP:SETQ LISP::EF NIL))) LISP::FN-DEFN))) (LISP:FDEFINITION LISP::FN)) ((EQ (CAR LISP::FN-DEFN) :FUNCTION) (CDR LISP::FN-DEFN)) (T (LISP:ERROR "It is illegal to MACROLET ~s" LISP::FN))))) ((OR (NULL LISP::ENVIRONMENT) (AND (FOR LISP::VALUE IN (CDR (ENVIRONMENT-VARS LISP::ENVIRONMENT)) BY CDDR ALWAYS (EQ LISP::VALUE *SPECIAL-BINDING-MARK*)) (NULL (ENVIRONMENT-FUNCTIONS LISP::ENVIRONMENT)) (NULL (ENVIRONMENT-BLOCKS LISP::ENVIRONMENT)) (NULL (ENVIRONMENT-TAGBODIES LISP::ENVIRONMENT)))) (* |;;| "Environment is empty: don't have to make a closure.") LISP::FN) (T (MAKE-CLOSURE :FUNCTION (COND ((EQ (CAR LISP::FN) 'LAMBDA) `(LISP:LAMBDA (&OPTIONAL ,@(CADR LISP::FN) &REST IGNORE) ,@(CDDR LISP::FN))) (T LISP::FN)) :ENVIRONMENT (\\COPY-ENVIRONMENT LISP::ENVIRONMENT) (* \;  "environment is copied so that forms that side-effect it (such as LET*) will work correctly.") )))) (LISP:DEFUN LISP:FUNCTIONP (LISP::FN) (AND (OR (LISP:SYMBOLP LISP::FN) (LISP:COMPILED-FUNCTION-P LISP::FN) (AND (LISP:CONSP LISP::FN) (EQ (CAR LISP::FN) 'LISP:LAMBDA)) (CLOSURE-P LISP::FN)) T)) (LISP:DEFUN LISP:COMPILED-FUNCTION-P (LISP::FN) (OR (TYPEP LISP::FN 'COMPILED-CLOSURE) (AND (ARRAYP LISP::FN) (EQ (|fetch| (ARRAYP TYP) |of| LISP::FN) \\ST.CODE)))) (DEFINE-SPECIAL-FORM LISP:MULTIPLE-VALUE-CALL (LISP::FN &REST LISP::ARGS &ENVIRONMENT LISP::ENV) (* |;;|  "for interpreted calls only. The macro inserts a \\MVLIST call after the computation of TAIL") (LISP:APPLY (LISP:EVAL LISP::FN LISP::ENV) (FOR LISP::X IN LISP::ARGS JOIN (\\MVLIST (LISP:EVAL LISP::X LISP::ENV))))) (DEFINE-SPECIAL-FORM LISP:MULTIPLE-VALUE-PROG1 (LISP::FORM &REST LISP::OTHER-FORMS &ENVIRONMENT LISP::ENV) (LISP:VALUES-LIST (PROG1 (LISP:MULTIPLE-VALUE-LIST (LISP:EVAL LISP::FORM LISP::ENV)) (FOR LISP::X IN LISP::OTHER-FORMS DO (LISP:EVAL LISP::X LISP::ENV))))) (DEFINEQ (COMP.CL-EVAL (LAMBDA (EXP) (* |lmm| " 5-Jun-86 00:44") (COMP.SPREAD `(CDR ,@EXP) '*EVAL-ARGUMENT-COUNT* `(CAR ,@EXP) '((LISP:EVAL ENVIRONMENT))))) ) (LISP:DEFUN LISP:EVALHOOK (LISP::FORM LISP::EVALHOOKFN LISP::APPLYHOOKFN &OPTIONAL LISP::ENV) "Evaluates Form with *Evalhook* bound to Evalhookfn and *Applyhook* bound to applyhookfn. Ignores these hooks once, for the top-level evaluation of Form." (LET ((*EVALHOOK* LISP::EVALHOOKFN) (LISP::*SKIP-EVALHOOK* T) (*APPLYHOOK* LISP::APPLYHOOKFN) (LISP::*SKIP-APPLYHOOK* NIL)) (LISP:EVAL LISP::FORM LISP::ENV))) (LISP:DEFUN LISP:APPLYHOOK (LISP:FUNCTION LISP::ARGS LISP::EVALHOOKFN LISP::APPLYHOOKFN &OPTIONAL LISP::ENV) "Evaluates Form with *Evalhook* bound to Evalhookfn and *Applyhook* bound to applyhookfn. Ignores these hooks once, for the top-level evaluation of Form." (DECLARE (IGNORE LISP::ENV)) (* |;;| "the env argument is not used as agreed on the Common Lisp mailing list. (Arguments have already been evaluated.)") (LET ((*EVALHOOK* LISP::EVALHOOKFN) (LISP::*SKIP-EVALHOOK* T) (*APPLYHOOK* LISP::APPLYHOOKFN) (LISP::*SKIP-APPLYHOOK* NIL)) (LISP:APPLY LISP:FUNCTION LISP::ARGS))) (LISP:DEFVAR *EVALHOOK* NIL) (LISP:DEFVAR *APPLYHOOK* NIL) (LISP:DEFVAR LISP::*SKIP-EVALHOOK* NIL "Used with non-null *EVALHOOK* to suppress the use of the hook-function for one level of eval.") (LISP:DEFVAR LISP::*SKIP-APPLYHOOK* NIL "Used with non-null *APPLYHOOK* to suppress the use of the hook function for one level of eval.") (* \; "CONSTANTS mechanism") (DEFINEQ (LISP:CONSTANTP (LAMBDA (OBJECT ENVIRONMENT) (* |vanMelle| "19-Nov-86 21:43") (LISP:TYPECASE OBJECT (LISP:NUMBER T) (LISP:CHARACTER T) (STRING T) (LISP:BIT-VECTOR T) (LISP:SYMBOL (OR (EQ OBJECT NIL) (EQ OBJECT T) (LISP:KEYWORDP OBJECT) (AND COMPVARMACROHASH (SETQ OBJECT (GETHASH OBJECT COMPVARMACROHASH)) (LISP:CONSTANTP OBJECT)))) (CONS (CASE (CAR OBJECT) ((CONSTANT QUOTE) T) (LISP:OTHERWISE (COND ((FMEMB (CAR OBJECT) CONSTANTFOLDFNS) (EVERY (CDR OBJECT) (FUNCTION LISP:CONSTANTP))) (T (LISP:MULTIPLE-VALUE-BIND (NEW-FORM EXPANDED) (LISP:MACROEXPAND OBJECT ENVIRONMENT) (AND EXPANDED (LISP:CONSTANTP NEW-FORM))))))))) )) ) (LISP:DEFSETF LISP:CONSTANTP XCL::SET-CONSTANTP) (LISP:DEFUN XCL::SET-CONSTANTP (LISP:SYMBOL XCL::FLAG) (LISP:IF (NOT (NULL XCL::FLAG)) (LISP:SETF (GETHASH LISP:SYMBOL COMPVARMACROHASH) `(CONSTANT ,LISP:SYMBOL)) (LISP:WHEN (TYPEP COMPVARMACROHASH 'LISP:HASH-TABLE) (REMHASH LISP:SYMBOL COMPVARMACROHASH)))) (* \; "Interlisp SETQ for Common Lisp and vice versa") (DEFINE-SPECIAL-FORM LISP:SETQ (&REST LISP::TAIL &ENVIRONMENT LISP::ENV) (LET (LISP::VALUE) (WHILE LISP::TAIL DO (LISP:SETQ LISP::VALUE (SET-SYMBOL (LISP:POP LISP::TAIL) (LISP:EVAL (LISP:POP LISP::TAIL) LISP::ENV) LISP::ENV))) LISP::VALUE)) (DEFINE-SPECIAL-FORM SETQ (VAR VALUE &ENVIRONMENT ENV) (SET-SYMBOL VAR (LISP:EVAL VALUE ENV) ENV)) (PUTPROPS LISP:SETQ DMACRO (DEFMACRO (X Y &REST LISP:REST) `(PROGN (SETQ ,X ,Y) ,@(AND LISP:REST `((LISP:SETQ ,@LISP:REST)))))) (* |;;| "An nlambda definition for cl:setq so cmldeffer may use cl:setq will run in the init") (DEFINEQ (LISP:SETQ (NLAMBDA LISP::TAIL (* \; "Edited 15-Nov-87 17:34 by jop") (LET ((LISP::VALUE NIL)) (LISP:LOOP (LISP:IF (NULL LISP::TAIL) (RETURN LISP::VALUE)) (LISP:SETQ LISP::VALUE (SET (LISP:POP LISP::TAIL) (LISP:IF (NOT (BOUNDP *EVALHOOK*)) (PROGN (* |;;| "CMLEVAL Init-forms not yet run") (EVAL (LISP:POP LISP::TAIL))) (LISP:EVAL (LISP:POP LISP::TAIL))))))))) ) (DEFMACRO SETQ (VAR &REST VALUE-FORMS) (COND ((NULL VALUE-FORMS) `(LISP:SETQ ,VAR NIL)) ((NULL (CDR VALUE-FORMS)) `(LISP:SETQ ,VAR ,(CAR VALUE-FORMS))) (T `(LISP:SETQ ,VAR (PROG1 ,@VALUE-FORMS))))) (DEFINEQ (SET-SYMBOL (LAMBDA (LISP:SYMBOL VALUE ENVIRONMENT) (* \; "Edited 7-Jan-87 15:37 by gbn") (LISP:BLOCK SET-SYMBOL (|if| ENVIRONMENT |then| (SETQ ENVIRONMENT (ENVIRONMENT-VARS ENVIRONMENT)) (WHILE ENVIRONMENT DO (IF (EQ LISP:SYMBOL (CAR ENVIRONMENT)) THEN (* |;;| "found a binding for this symbol") (IF (EQ (CAR (SETQ ENVIRONMENT (CDR ENVIRONMENT))) *SPECIAL-BINDING-MARK*) THEN (* |;;|  "it is a special binding, or a mark that we are using the special value") (RETURN NIL) (* \; "return from WHILE")) (RPLACA ENVIRONMENT VALUE) (* |;;| "smash new value in") (LISP:RETURN-FROM SET-SYMBOL VALUE) ELSE (SETQ ENVIRONMENT (CDDR ENVIRONMENT))))) (* |;;| "no environment, or not found") (SETQ ENVIRONMENT (\\STKSCAN LISP:SYMBOL)) (COND ((EQ (\\HILOC ENVIRONMENT) \\STACKHI) (\\PUTBASEPTR ENVIRONMENT 0 VALUE)) (T (\\RPLPTR ENVIRONMENT 0 VALUE))) VALUE))) ) (DEFMACRO LISP:PSETQ (&REST TAIL) (AND TAIL `(PROGN (SETQ ,(|pop| TAIL) ,(LISP:IF (CDR TAIL) `(PROG1 ,(POP TAIL) (LISP:PSETQ ,@TAIL)) (CAR TAIL))) NIL))) (DEFMACRO SETQQ (SYMBOL VALUE) (* \;  "so common lisp interpreter will know about it") `(SETQ ,SYMBOL ',VALUE)) (DEFINE-SPECIAL-FORM LISP:CATCH (LISP::CATCH-TAG &REST LISP::\\CATCH-FORMS &ENVIRONMENT LISP::\\CATCH-ENV) (LISP:CATCH (LISP:EVAL LISP::CATCH-TAG LISP::\\CATCH-ENV) (\\EVAL-PROGN LISP::\\CATCH-FORMS LISP::\\CATCH-ENV))) (DEFINE-SPECIAL-FORM LISP:THROW (LISP::TAG LISP::VALUE &ENVIRONMENT LISP::ENV) (LISP:THROW (LISP:EVAL LISP::TAG LISP::ENV) (LISP:EVAL LISP::VALUE LISP::ENV))) (DEFINE-SPECIAL-FORM LISP:UNWIND-PROTECT (LISP::\\FORM &REST LISP::\\CLEANUPS &ENVIRONMENT LISP::\\ENV) (LISP:UNWIND-PROTECT (LISP:EVAL LISP::\\FORM LISP::\\ENV) (\\EVAL-PROGN LISP::\\CLEANUPS LISP::\\ENV))) (DEFINEQ (LISP:THROW (NLAMBDA (THROW-TAG THROW-VALUE) (DECLARE (LOCALVARS . T)) (* |lmm| "30-May-86 00:09") (LISP:THROW (\\EVAL THROW-TAG) (\\EVAL THROW-VALUE)))) (LISP:CATCH (NLAMBDA \\CATCH-FORMS (* \; "Edited 7-Apr-88 16:53 by amd") (LISP:CATCH (\\EVAL (CAR \\CATCH-FORMS)) (\\EVPROGN (CDR \\CATCH-FORMS))))) (LISP:UNWIND-PROTECT (NLAMBDA \\UNWIND-FORMS (* \; "Edited 7-Apr-88 16:54 by amd") (LISP:UNWIND-PROTECT (\\EVAL (CAR \\UNWIND-FORMS)) (\\EVPROGN (CDR \\UNWIND-FORMS))))) ) (DEFMACRO PROG (VARS &BODY (BODY DECLS)) `(LISP:BLOCK NIL (LET ,VARS ,@DECLS (LISP:TAGBODY ,@BODY)))) (DEFMACRO PROG* (VARS &BODY (BODY DECLS)) `(LISP:BLOCK NIL (LET* ,VARS ,@DECLS (LISP:TAGBODY ,@BODY)))) (DEFINE-SPECIAL-FORM GO (LISP::\\TAG &ENVIRONMENT LISP::ENV) (BIND LISP::TAIL FOR LISP::TAGBODIES ON (AND LISP::ENV (ENVIRONMENT-TAGBODIES LISP::ENV)) BY CDDR WHEN (LISP:SETQ LISP::TAIL (LISP:MEMBER LISP::\\TAG (CAR LISP::TAGBODIES))) (* |;;| "MUST use EQL, as tags may be integers.") DO (HANDLER-BIND ((ILLEGAL-THROW #'(LISP:LAMBDA (LISP::C) (LISP:ERROR 'ILLEGAL-GO :TAG LISP::\\TAG)))) (LISP:THROW (CADR LISP::TAGBODIES) LISP::TAIL)) FINALLY (LISP:ERROR 'ILLEGAL-GO :TAG LISP::\\TAG))) (DEFINE-SPECIAL-FORM LISP:TAGBODY (&REST LISP::\\TAGBODY-TAIL &ENVIRONMENT LISP::ENV) (LET* ((LISP::BLIP (CONS NIL NIL)) (LISP::\\NEW-ENV (\\MAKE-CHILD-ENVIRONMENT LISP::ENV :TAGBODY (LISP::\\TAGBODY-TAIL LISP::BLIP)))) (WHILE (LISP:SETQ LISP::\\TAGBODY-TAIL (LISP:CATCH LISP::BLIP (FOR LISP::X IN LISP::\\TAGBODY-TAIL UNLESS (LISP:SYMBOLP LISP::X) DO (LISP:EVAL LISP::X LISP::\\NEW-ENV))))))) (DEFINEQ (LISP:TAGBODY (NLAMBDA TAIL (* |lmm| "23-May-86 16:05") (* |like| PROG |with| |no|  |variables|) (LET ((TL (CONS NIL TAIL))) (\\PROG0 TL TL)))) ) (* \; "for macro caching") (DEFINEQ (CACHEMACRO (LAMBDA (FN BODY ENV) (* \; "Edited 25-Sep-87 18:32 by jop") (* |;;;| "We want to cache the expansion unless") (* |;;| "1) the env is not an interpreted env (including NIL), ") (* |;;| "2) there are lexical macros in force, OR") (* |;;| "3) There is a compiler-let in force.") (LISP:IF (OR (NOT (TYPEP ENV 'ENVIRONMENT)) (AND ENV (FOR FN IN (CDR (ENVIRONMENT-FUNCTIONS ENV)) BY CDDR THEREIS (EQ (CAR FN) :MACRO))) *IN-COMPILER-LET*) (LISP:FUNCALL FN BODY ENV) (OR (GETHASH BODY CLISPARRAY) (PUTHASH BODY (LISP:FUNCALL FN BODY ENV) CLISPARRAY))))) ) (LISP:DEFPARAMETER *MACROEXPAND-HOOK* 'CACHEMACRO) (RPAQQ *IN-COMPILER-LET* NIL) (* |;;| "PROCLAIM and friends.") (* |;;| "Needs to come first because DEFVARs put it out. With package code in the init, also need this here rather than CMLEVAL" ) (LISP:DEFUN LISP:PROCLAIM (LISP::PROCLAMATION) (* |;;| "PROCLAIM is a top-level form used to pass assorted information to the compiler. This interpreter ignores proclamations except for those declaring variables to be SPECIAL.") (LISP:WHEN (LISP:CONSP LISP::PROCLAMATION) (CASE (CAR LISP::PROCLAMATION) (LISP:SPECIAL (FOR LISP::X IN (CDR LISP::PROCLAMATION) DO (LISP:SETF (VARIABLE-GLOBALLY-SPECIAL-P LISP::X) T) (LISP:SETF (VARIABLE-GLOBAL-P LISP::X) NIL) (LISP:SETF (LISP:CONSTANTP LISP::X) NIL))) (GLOBAL (FOR LISP::X IN (CDR LISP::PROCLAMATION) DO (LISP:SETF ( VARIABLE-GLOBAL-P LISP::X) T) (LISP:SETF ( VARIABLE-GLOBALLY-SPECIAL-P LISP::X) NIL) (LISP:SETF (  LISP:CONSTANTP LISP::X) NIL))) (SI::CONSTANT (FOR LISP::X IN (CDR LISP::PROCLAMATION) DO (LISP:SETF (LISP:CONSTANTP LISP::X) T) (LISP:SETF (VARIABLE-GLOBAL-P LISP::X) NIL) (LISP:SETF (VARIABLE-GLOBALLY-SPECIAL-P LISP::X) NIL))) (LISP:DECLARATION (FOR LISP::X IN (CDR LISP::PROCLAMATION) DO (LISP:SETF (XCL::DECL-SPECIFIER-P LISP::X) T))) (LISP:NOTINLINE (FOR LISP::X IN (CDR LISP::PROCLAMATION) DO (LISP:SETF (XCL::GLOBALLY-NOTINLINE-P LISP::X) T))) (LISP:INLINE (FOR LISP::X IN (CDR LISP::PROCLAMATION) DO (LISP:SETF (XCL::GLOBALLY-NOTINLINE-P LISP::X) NIL)))))) (* \; "used by the codewalker, too") (DECLARE\: EVAL@COMPILE (PUTPROPS VARIABLE-GLOBALLY-SPECIAL-P MACRO ((VARIABLE) (GET VARIABLE 'GLOBALLY-SPECIAL))) (PUTPROPS VARIABLE-GLOBAL-P MACRO ((VARIABLE) (GET VARIABLE 'GLOBALVAR))) ) (LISP:DEFUN XCL::DECL-SPECIFIER-P (LISP:SYMBOL) (GET LISP:SYMBOL 'SI::DECLARATION-SPECIFIER)) (LISP:DEFUN XCL::SET-DECL-SPECIFIER-P (XCL::SPEC XCL::VAL) (LISP:SETF (GET XCL::SPEC 'SI::DECLARATION-SPECIFIER) XCL::VAL)) (LISP:DEFUN XCL::GLOBALLY-NOTINLINE-P (XCL::FN) (GET XCL::FN 'SI::GLOBALLY-NOTINLINE)) (LISP:DEFUN XCL::SET-GLOBALLY-NOTINLINE-P (XCL::FN XCL::VAL) (LISP:SETF (GET XCL::FN 'SI::GLOBALLY-NOTINLINE) XCL::VAL)) (LISP:DEFSETF XCL::DECL-SPECIFIER-P XCL::SET-DECL-SPECIFIER-P) (LISP:DEFSETF XCL::GLOBALLY-NOTINLINE-P XCL::SET-GLOBALLY-NOTINLINE-P) (PUTPROPS GLOBALLY-SPECIAL PROPTYPE IGNORE) (PUTPROPS GLOBALVAR PROPTYPE IGNORE) (PUTPROPS SI::DECLARATION-SPECIFIER PROPTYPE IGNORE) (PUTPROPS SI::GLOBALLY-NOTINLINE PROPTYPE IGNORE) (PUTPROPS SPECIAL-FORM PROPTYPE IGNORE) (DEFMACRO LISP:DECLAIM (&REST LISP::DECL-SPECS) `(LISP:EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (LISP:MAPC #'LISP:PROCLAIM ',LISP::DECL-SPECS))) (* |;;| "This proclamation is here to shut DECLARE up about CLtL2 declarations that we ignore anyway") (* |;;| "We don't need one of these for (OPTIMIZE DEBUG) since we throw all OPTIMIZE declarations away already" ) (LISP:PROCLAIM '(LISP:DECLARATION DYNAMIC-EXTENT)) (PUTPROPS CMLEVAL FILETYPE LISP:COMPILE-FILE) (PUTPROPS CMLEVAL MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "INTERLISP")) (DECLARE\: EVAL@COMPILE DONTCOPY (DEFOPTIMIZER CL-EVAL-FN3-CALL (ARG1 ARG2 &ENVIRONMENT ENV) (* |;;| "Emit a call to FN3 after pushing only 2 arguments (the other having been pushed by IL:.COMPILER-SPREAD-ARGUMENTS. earlier in the game). Used in CL:EVAL.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) `((OPCODES FN3 0 0 (FN . \\EVAL-INVOKE-LAMBDA) RETURN) ,ARG1 ,ARG2)) (T `((OPCODES FN3 0 (FN . \\EVAL-INVOKE-LAMBDA) RETURN) ,ARG1 ,ARG2)))) ) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (DECLARE\: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) ) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA LISP:TAGBODY LISP:UNWIND-PROTECT LISP:CATCH LISP:SETQ LISP:BLOCK LISP:EVAL-WHEN LISP:COMPILER-LET COMMON-LISP) (ADDTOVAR NLAML LISP:THROW LISP:FUNCTION LISP:RETURN-FROM LISP:IF) (ADDTOVAR LAMA LISP:APPLY LISP:FUNCALL) ) (PUTPROPS CMLEVAL COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1992 1993)) (DECLARE\: DONTCOPY (FILEMAP (NIL (17862 18109 (COMMON-LISP 17872 . 18107)) (18150 23722 (\\TRANSLATE-CL\:LAMBDA 18160 . 23720)) (27353 54374 (LISP:EVAL 27363 . 36956) (\\EVAL-INVOKE-LAMBDA 36958 . 38163) ( \\INTERPRET-ARGUMENTS 38165 . 50863) (\\INTERPRETER-LAMBDA 50865 . 51630) (CHECK-BINDABLE 51632 . 52393) (CHECK-KEYWORDS 52395 . 54372)) (54522 55231 (DECLARED-SPECIAL 54532 . 55229)) (55296 56123 ( LISP:FUNCALL 55306 . 55541) (LISP:APPLY 55543 . 56121)) (58786 60461 (LISP:COMPILER-LET 58796 . 59612) (COMP.COMPILER-LET 59614 . 60459)) (69251 69619 (LISP:EVAL-WHEN 69261 . 69617)) (70664 71132 ( \\EVAL-PROGN 70674 . 71130)) (74895 78849 (\\LET*-RECURSION 74905 . 76181) (|\\LETtran| 76183 . 78847) ) (80818 81150 (LISP:IF 80828 . 81148)) (84128 84360 (LISP:BLOCK 84138 . 84358)) (85158 86554 ( LISP:RETURN-FROM 85168 . 86552)) (88065 88435 (LISP:FUNCTION 88075 . 88433)) (94781 95036 ( COMP.CL-EVAL 94791 . 95034)) (96600 97892 (LISP:CONSTANTP 96610 . 97890)) (99557 100327 (LISP:SETQ 99567 . 100325)) (100588 102252 (SET-SYMBOL 100598 . 102250)) (103570 104245 (LISP:THROW 103580 . 103797) (LISP:CATCH 103799 . 104006) (LISP:UNWIND-PROTECT 104008 . 104243)) (106096 106449 (LISP:TAGBODY 106106 . 106447)) (106485 107356 (CACHEMACRO 106495 . 107354))))) STOP