(FILECREATED "11-SEP-78 15:57:55" <MASINTER>STRINGMACRO.;8
 3812   


     changes to:  STRMACRO STRINGMACROCOMS COPYALL MKCONS COPYMACRO

     previous date: "23-AUG-78 16:16:07" <MASINTER>STRINGMACRO.;7)


(PRETTYCOMPRINT STRINGMACROCOMS)

(RPAQQ STRINGMACROCOMS
 ((PROP MACRO COPYALL COPYSTRING PRINTSTRING)
			(PROP OPD BYTES)
			(FNS COPYMACRO MKCONS STRMACRO)
			(PROP MACRO ERROR HELP PRIN1)
			(PROP BYTEMACRO PRINTSTRING COPYSTRING PRIN1 
			      ERROR HELP)))

(PUTPROPS COPYALL MACRO
 (X (COND
			     ((AND (LISTP (CAR X))
				   (EQ (CAAR X)
				       (QUOTE QUOTE)))
			       (COPYMACRO (CADAR X)))
			     (T (QUOTE INGOREMACRO)))))

(PUTPROPS COPYSTRING MACRO
 (X (STRMACRO (CAR X)
					(QUOTE ((JSP 6 , COPYSTRING)))))
)

(PUTPROPS PRINTSTRING MACRO
 (X (STRMACRO (CAR X)
					 (LIST (LIST (QUOTE CQ)
						     (CADR X))
					       (QUOTE (JSP 6 , 
							PRINTSTRING)))))
)

(PUTPROPS BYTES OPD
 (LAMBDA (B1 B2 B3 B4 B5)
			    (LIST (LIST (IPLUS (LLSH B1 29)
					       (LLSH B2 22)
					       (LLSH B3 15)
					       (LLSH B4 8)
					       (LLSH B5 1))))))
(DEFINEQ

(COPYMACRO

  (LAMBDA (X)                           (* lmm "11-SEP-78 15:52")

    (COND
      ((LISTP X)
	(MKCONS
 (COPYMACRO
 (CAR X))
		(COPYMACRO
 (CDR X))))
      ((OR (LITATOM X)
	   (SMALLP X))
	(KWOTE X))
      ((STRINGP X)
	(LIST (QUOTE COPYSTRING)
	      (KWOTE X)))
      ((FIXP X)
	(LIST (QUOTE LOC)
	      (LIST (QUOTE VAG)
		    X)))
      ((FLOATP X)
	(LIST (QUOTE FLOC)
	      (LIST (QUOTE VAG)
		    X)))
      (T (HELP)))))

(MKCONS

  (LAMBDA (X Y)                         (* lmm "11-SEP-78 15:53")

    (COND
      ((NULL Y)
	(LIST (QUOTE LIST)
	      X))
      ((AND (LISTP Y)
	    (EQ (CAR Y)
		(QUOTE LIST)))
	(CONS (QUOTE LIST)
	      (CONS X (CDR Y))))
      (T (LIST (QUOTE CONS)
	       X Y)))))

(STRMACRO

  (LAMBDA (STRING CODE)                 (* lmm "23-AUG-78 11:20")

    (COND
      ((AND (OR (STRINGP STRING)
		(AND (LISTP STRING)
		     (EQ (CAR STRING)
			 (QUOTE QUOTE))
		     (STRINGP (SETQ STRING (CADR STRING)))))
	    (NOT (STRPOS (CHARACTER 0)
			 STRING)))
	(APPEND (QUOTE (ASSEMBLE NIL))
		CODE
		(for (Y _(NCONC1 (CHCON STRING)
				 0))
		   collect (CONS (QUOTE BYTES)
				 (for I from 1 to 5
				    collect (OR (pop Y)
						0)))
		   repeatwhile Y)))
      (T (QUOTE IGNOREMACRO)))))
)

(PUTPROPS ERROR MACRO
 (X
	    (COND
	      ((OR (STRINGP (CAR X))
		   (STRINGP (CADR X)))
		(CONS (QUOTE ERROR)
		      (CONS (COND
			      ((STRINGP (CAR X))
				(LIST (QUOTE COPYSTRING)
				      (CAR X)))
			      (T (CAR X)))
			    (AND (CDR X)
				 (CONS (COND
					 ((STRINGP (CADR X))
					   (LIST (QUOTE COPYSTRING)
						 (CADR X)))
					 (T (CADR X)))
				       (CDDR X))))))
	      (T (QUOTE IGNOREMACRO)))))

(PUTPROPS HELP MACRO
 (X
	    (COND
	      ((OR (STRINGP (CAR X))
		   (STRINGP (CADR X)))
		(CONS (QUOTE HELP)
		      (CONS (COND
			      ((STRINGP (CAR X))
				(LIST (QUOTE COPYSTRING)
				      (CAR X)))
			      (T (CAR X)))
			    (AND (CDR X)
				 (CONS (COND
					 ((STRINGP (CADR X))
					   (LIST (QUOTE COPYSTRING)
						 (CADR X)))
					 (T (CADR X)))
				       (CDDR X))))))
	      (T (QUOTE IGNOREMACRO)))))

(PUTPROPS PRIN1 MACRO
 (X (COND
			   (VCF (QUOTE IGNOREMACRO))
			   (T (STRMACRO (CAR X)
					(LIST (LIST (QUOTE CQ)
						    (CADR X))
					      (QUOTE (JSP 6 , 
							PRINTSTRING)))))
			   )))

(PUTPROPS PRINTSTRING BYTEMACRO
 T)

(PUTPROPS COPYSTRING BYTEMACRO
 ((X)
				X))

(PUTPROPS PRIN1 BYTEMACRO
 T)

(PUTPROPS ERROR BYTEMACRO
 T)

(PUTPROPS HELP BYTEMACRO
 T)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1145 2477 (COPYMACRO 1157 . 1633) (MKCONS 1637 . 1934) (
STRMACRO 1938 . 2474)))))
STOP