(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