Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED " 4-SEP-81 21:44:36" <LISPUSERS>PERFORMTRAN.;8 5085
changes to: PERFORMTRANCOMS PERFORMTRAN PT.RECREDECLARE1
previous date: "30-AUG-81 22:20:11" <LISPUSERS>PERFORMTRAN.;7)
(PRETTYCOMPRINT PERFORMTRANCOMS)
(RPAQQ PERFORMTRANCOMS ((LOCALVARS . T)
(FNS PERFORMOPSTRAN PERFORMTRAN PT.RECREDECLARE1)
(P (MOVD? (QUOTE RECREDECLARE1)
(QUOTE PT.OLDRECREDECLARE1))
(MOVD (QUOTE PT.RECREDECLARE1)
(QUOTE RECREDECLARE1)))
(PROP CLISPWORD PERFORM perform)
(ADDVARS (CLISPRECORDTYPES PERFORMOPS)
(PERFORMOPS))
(P (MOVD (QUOTE RECORD)
(QUOTE PERFORMOPS))
[SETTEMPLATE (QUOTE PERFORM)
(QUOTE (MACRO ARGS (PERFORMTRAN ARGS T]
(SETTEMPLATE (QUOTE perform)
(GETTEMPLATE (QUOTE PERFORM)))
(SETSYNONYM (QUOTE PERFORM)
(QUOTE FETCH)
T)
(SETSYNONYM (QUOTE PERFORMS)
(QUOTE FETCHES)
T)
(SETSYNONYM (QUOTE PERFORMING)
(QUOTE FETCHING)
T)
(SETSYNONYM (QUOTE PERFORMED)
(QUOTE FETCHED)
T))
(PROP USERRECORDTYPE PERFORMOPS)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(PERFORMOPSTRAN
[LAMBDA (DECL) (* DECLARATIONS:)
(* rmk: "24-AUG-81 13:33")
(NCONC [CONS (QUOTE ACCESSFNS)
(COND
((LITATOM (CADR DECL))
(LIST (CAR (SETQ DECL (CDR DECL]
(LIST (LIST (QUOTE PERFORMOPS)
(QUOTE DATUM))
(LIST (QUOTE ACCESSFNS)
(QUOTE PERFORMOPS)
(for OP in (CDR DECL) collect (LIST (CAR OP)
(KWOTE (CDR OP])
(PERFORMTRAN
[LAMBDA (FORM MASTERSCOPEFLAG)
(CLISP:(RECORD FORM (perform PATH . ARGS))) (* rmk: " 4-SEP-81 21:39")
(* Translates PERFORM expressions, where the record FOO has a PERFORMOPS access field, e.g. (PERFORMOPS (MAP (FN)
(MAPC X FN)) (PRINT (X FILE) (PPV X FILE))) The CDR of the PERFORMOPS specification is an ALIST indexed by the operation name
(e.g. MAP) The element after the operation name (FN) is a list of dummy arguments, and the 3rd element is a form into which the true
args will be substituted.)
(* If MASTERSCOPEFLAG, then we are being called from a Masterscope template. FORM is CDR of the perform expression.
We return an appropriate FETCH form, so that the user can ask about the operation as a field name.)
(if MASTERSCOPEFLAG
then (FORM_ <'perform ! FORM>))
(PROG (OP TEMP OPDEF (DWIMESSGAG (OR MASTERSCOPEFLAG DWIMESSGAG))
(PATH (FORM:PATH)))
(DECLARE (SPECVARS DWIMESSGAG))
[PATH_(if (LISTP PATH)
then < ! PATH>
else (bind I_0 while I collect (I_I+1)
(SUBATOM PATH I (AND I_(STRPOS "." PATH I)
I-1]
(OP_(TEMP_PATH::-1):1)
(ATTACH 'PERFORMOPS TEMP)
(if OPDEF_(CAR (NLSETQ (RECORDACCESS PATH)))
elseif OPDEF_(CDR (ASSOC OP PERFORMOPS))
then (AND DWIMESSGAG (LISPXPRIN1 (CONCAT "{in " FAULTFN
"} Using global perform definition
")
T)))
(if (AND ~DWIMESSGAG (NLISTP OPDEF))
then (LISPXPRIN1 (CONCAT " {in " FAULTFN "} Undefined PERFORM operator in form
")
T)
(LISPXPRINT FORM T)
(ERROR!))
(if ~MASTERSCOPEFLAG
then (DWIMIFY0? FORM:ARGS FORM NIL NIL NIL FAULTFN))
(OPDEF_(SUBPAIR OPDEF:1 FORM:ARGS (MKPROGN OPDEF::1)))
(RETURN (if MASTERSCOPEFLAG
then (<'fetch PATH 'of (OR (LISTP OPDEF)
<'ppe >)
>)
else (if LCASEFLG
then (FORM:perform_'perform))
(CLISPTRAN FORM OPDEF])
(PT.RECREDECLARE1
[LAMBDA (TRAN ORIG)
(CLISP:) (* rmk: " 4-SEP-81 21:42")
(DECLARE (GLOBALVARS CLISPARRAY))
(SELECTQ ORIG:1
((perform PERFORM)
(/PUTHASH ORIG NIL CLISPARRAY))
(PT.OLDRECREDECLARE1 TRAN ORIG])
)
(MOVD? (QUOTE RECREDECLARE1)
(QUOTE PT.OLDRECREDECLARE1))
(MOVD (QUOTE PT.RECREDECLARE1)
(QUOTE RECREDECLARE1))
(PUTPROPS PERFORM CLISPWORD (PERFORMTRAN . perform))
(PUTPROPS perform CLISPWORD (PERFORMTRAN . perform))
(ADDTOVAR CLISPRECORDTYPES PERFORMOPS)
(ADDTOVAR PERFORMOPS )
(MOVD (QUOTE RECORD)
(QUOTE PERFORMOPS))
[SETTEMPLATE (QUOTE PERFORM)
(QUOTE (MACRO ARGS (PERFORMTRAN ARGS T]
(SETTEMPLATE (QUOTE perform)
(GETTEMPLATE (QUOTE PERFORM)))
(SETSYNONYM (QUOTE PERFORM)
(QUOTE FETCH)
T)
(SETSYNONYM (QUOTE PERFORMS)
(QUOTE FETCHES)
T)
(SETSYNONYM (QUOTE PERFORMING)
(QUOTE FETCHING)
T)
(SETSYNONYM (QUOTE PERFORMED)
(QUOTE FETCHED)
T)
(PUTPROPS PERFORMOPS USERRECORDTYPE PERFORMOPSTRAN)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1214 4238 (PERFORMOPSTRAN 1226 . 1749) (PERFORMTRAN 1753 . 3921) (PT.RECREDECLARE1 3925
. 4235)))))
STOP