(FILECREATED "16-Oct-85 19:19:10" {ERINYES}<HERRING>COMPILER>DOPVALSEARCH.;8 8077
changes to: (VARS DOPVALSEARCHCOMS)
(FNS OPPRINTSEARCH OPPRINTSEARCH1 LEVADJSEARCH DOPVALSEARCH1)
previous date: " 1-Oct-85 15:49:49" {ERINYES}<HERRING>COMPILER>DOPVALSEARCH.;7)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DOPVALSEARCHCOMS)
(RPAQQ DOPVALSEARCHCOMS ((* * for searching for DOPVALS, DOPCODEs, etc)
(FNS DOPVALSEARCH DMACROSEARCH BYTEMACROSEARCH)
(FNS OPPRINTSEARCH OPPRINTSEARCH1 LEVADJSEARCH DOPVALSEARCH1)
(FNS DOPVALSEARCH0 PRINTDOPVALSLIST DMACROSEARCH0 PRINTDMACROSLIST
BYTEMACROSEARCH0 PRINTBYTEMACROSLIST)))
(* * for searching for DOPVALS, DOPCODEs, etc)
(DEFINEQ
(DOPVALSEARCH
[LAMBDA NIL (* jmh "27-Sep-85 12:14")
(DOPVALSEARCH0)
(SETQ DOPVALSATOMSLIST (SORT DOPVALSATOMSLIST))
(OUTFILE (QUOTE DOPVALSLIST))
(PRINTDOPVALSLIST)
(CLOSEF (QUOTE DOPVALSLIST))
(SEND.FILE.TO.PRINTER (QUOTE DOPVALSLIST])
(DMACROSEARCH
[LAMBDA NIL (* jmh "27-Sep-85 12:43")
(PROG (F)
(DMACROSEARCH0)
(SETQ DMACROSATOMSLIST (SORT DMACROSATOMSLIST))
(SETQ F (OUTFILE (QUOTE DMACROSATOMSLIST)))
(PRINTDMACROSLIST F)
(CLOSEF F)
(SEND.FILE.TO.PRINTER F])
(BYTEMACROSEARCH
[LAMBDA NIL (* jmh " 1-Oct-85 15:49")
(PROG (F)
(BYTEMACROSEARCH0)
(SETQ BYTEMACROSATOMSLIST (SORT BYTEMACROSATOMSLIST))
(SETQ F (OUTFILE (QUOTE BYTEMACROSATOMSLIST)))
(PRINTBYTEMACROSLIST F)
(CLOSEF F)
(SEND.FILE.TO.PRINTER F])
)
(DEFINEQ
(OPPRINTSEARCH
[LAMBDA (FILE) (* jmh "16-Oct-85 18:32")
(* * print OPPRINTs other than T/NIL, with the DOPCODEs that use them)
(LET (L)
(DECLARE (SPECVARS L))
[MAPATOMS (FUNCTION (LAMBDA (A)
(LET (D O EL)
(if (SETQ D (GETPROP A (QUOTE DOPCODE)))
then (SETQ O (fetch OPPRINT of D))
(if (AND O (NEQ O T)
(NLISTP O))
then (if (SETQ EL (for EL in L
thereis
(EQ (CAR EL)
O)))
then (NCONC1 EL D)
else (SETQ L (NCONC1 L (LIST O D]
(SETQ L (SORT L T))
(printout FILE "opprint NLISTP and other than T/NIL -> dopcode --" T .PPV L T])
(OPPRINTSEARCH1
[LAMBDA (FILE) (* jmh "16-Oct-85 18:47")
(* * print DOPCODEs with OPPRINTs T/NIL and OPNARGS > 1)
(LET (L)
(DECLARE (SPECVARS L))
[MAPATOMS (FUNCTION (LAMBDA (A)
(LET (D O EL N)
(if (SETQ D (GETPROP A (QUOTE DOPCODE)))
then (SETQ O (fetch OPPRINT of D))
(if (AND (OR (NULL O)
(EQ O T))
(NUMBERP (SETQ N (fetch OPNARGS
of D)))
(IGREATERP N 1))
then (if (SETQ EL (for EL in L
thereis
(EQ (CAR EL)
O)))
then (NCONC1 EL D)
else (SETQ L (NCONC1 L (LIST O D]
(SETQ L (SORT L T))
(printout FILE "dopcodes with opprint T/NIL and opnargs > 1 --" T .PPV L T])
(LEVADJSEARCH
[LAMBDA (FILE) (* jmh "16-Oct-85 18:35")
(* * print LEVADJs other than NIL and numbers, with the DOPCODEs that use them)
(LET (L)
(DECLARE (SPECVARS L))
[MAPATOMS (FUNCTION (LAMBDA (A)
(LET (D LA EL)
(if (SETQ D (GETPROP A (QUOTE DOPCODE)))
then (SETQ LA (fetch LEVADJ of D))
(if (AND LA (NOT (NUMBERP LA)))
then (if (SETQ EL (for EL in L
thereis
(EQ (CAR EL)
LA)))
then (NCONC1 EL D)
else (SETQ L (NCONC1 L (LIST LA D]
(SETQ L (SORT L T))
(printout FILE "levadj not NIL nor number -> dopcodes --" T .PPV L T])
(DOPVALSEARCH1
[LAMBDA (WORD FILE) (* jmh "16-Oct-85 19:15")
(printout FILE "DOPVALs containing " WORD " --" T)
(MAPATOMS (FUNCTION (LAMBDA (A)
(LET (D O EL N)
(if (AND (SETQ D (GETPROP A (QUOTE DOPVAL)))
(NOT (EQUAL (SUBST (CONCAT WORD WORD)
WORD D)
D)))
then (printout T A 16 .PPV D T])
)
(DEFINEQ
(DOPVALSEARCH0
[LAMBDA NIL (* jmh "25-Sep-85 18:29")
(* * construct (reversed) list of all atoms that have either DOPCODEs or DOPVALs, for printing)
(SETQ DOPVALSATOMSLIST NIL)
(MAPATOMS (FUNCTION (LAMBDA (A)
(if (OR (GETPROP A (QUOTE DOPCODE))
(GETPROP A (QUOTE DOPVAL)))
then (push DOPVALSATOMSLIST A])
(PRINTDOPVALSLIST
[LAMBDA NIL (* jmh "25-Sep-85 20:41")
(* * dump list -- in whatever order it's in)
(PROG ((NDOPVALS 0)
(NDOPCODES 0))
(printout NIL T "DOPVALSATOMSLIST : atom, dopval, dopcode" T)
(for A in DOPVALSATOMSLIST
do (printout NIL A)
[if (GETPROP A (QUOTE DOPVAL))
then (add NDOPVALS 1)
(printout NIL 16 (GETPROP A (QUOTE DOPVAL]
[if (GETPROP A (QUOTE DOPCODE))
then (add NDOPCODES 1)
(printout NIL 36 (GETPROP A (QUOTE DOPCODE]
(printout NIL T))
(printout NIL "... end, " NDOPVALS " dopvals, " NDOPCODES " dopcodes" T])
(DMACROSEARCH0
[LAMBDA NIL (* jmh "27-Sep-85 12:23")
(* * construct (reversed) list of all atoms that have DMACROs)
(SETQ DMACROSATOMSLIST NIL)
(MAPATOMS (FUNCTION (LAMBDA (A)
(if (GETPROP A (QUOTE DMACRO))
then (push DMACROSATOMSLIST A])
(PRINTDMACROSLIST
[LAMBDA (F) (* jmh "27-Sep-85 12:38")
(* * dump list -- in whatever order it's in)
(PROG NIL
(printout F T "DMACROSATOMSLIST : atom, dmacro" T)
(for A in DMACROSATOMSLIST do (printout F A 16 .PPF (GETPROP A (QUOTE DMACRO))
T))
(printout F "... end, " (LENGTH DMACROSATOMSLIST)
" dmacros" T])
(BYTEMACROSEARCH0
[LAMBDA NIL (* jmh " 1-Oct-85 15:47")
(* * construct (reversed) list of all atoms that have BYTEMACROs)
(SETQ BYTEMACROSATOMSLIST NIL)
(MAPATOMS (FUNCTION (LAMBDA (A)
(if (GETPROP A (QUOTE BYTEMACRO))
then (push BYTEMACROSATOMSLIST A])
(PRINTBYTEMACROSLIST
[LAMBDA (F) (* jmh " 1-Oct-85 15:48")
(* * dump list -- in whatever order it's in)
(PROG NIL
(printout F T "BYTEMACROSATOMSLIST : atom, bytemacro" T)
(for A in BYTEMACROSATOMSLIST do (printout F A 16 .PPF (GETPROP A (QUOTE BYTEMACRO))
T))
(printout F "... end, " (LENGTH BYTEMACROSATOMSLIST)
" dmacros" T])
)
(PUTPROPS DOPVALSEARCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (762 1929 (DOPVALSEARCH 772 . 1129) (DMACROSEARCH 1131 . 1519) (BYTEMACROSEARCH 1521 .
1927)) (1930 5084 (OPPRINTSEARCH 1940 . 2803) (OPPRINTSEARCH1 2805 . 3772) (LEVADJSEARCH 3774 . 4626)
(DOPVALSEARCH1 4628 . 5082)) (5085 7994 (DOPVALSEARCH0 5095 . 5542) (PRINTDOPVALSLIST 5544 . 6296) (
DMACROSEARCH0 6298 . 6662) (PRINTDMACROSLIST 6664 . 7126) (BYTEMACROSEARCH0 7128 . 7507) (
PRINTBYTEMACROSLIST 7509 . 7992)))))
STOP