Google
 

Trailing-Edge - PDP-10 Archives - -
Click to see without markup as text/plain
There are no other files named in the archive.

(DEFPROP GRINFNS 
 (NIL GRINDEF SPRINT HUNOZ PANL PPOS) 
VALUE)

(DEFPROP GRINDEF 
 (LAMBDA (%%L)
  (PROG (%%F %%G %%H)
	(PROG (%%UBD))
	(SETQ %%H (QUOTE (EXPR FEXPR VALUE MACRO SPECIAL)))
   A    (COND ((NULL %%L) (RETURN NIL)))
	(SETQ %%F %%H)
	(COND ((ATOM (CAR %%L))))
   C    (COND ((NOT (ATOM (CAR %%L))) (SETQ %%H (CAR %%L)) (GO D))
	      ((AND (SETQ %%G (GET (CAR %%L) (CAR %%F)))
		    (OR (ATOM %%G) (NOT (EQ (CDR %%G) (CDR (GET (QUOTE %%UBD) (QUOTE VALUE)))))))
	       (TERPRI)
	       (TERPRI)
	       (PRINC (QUOTE /(DEFPROP/ ))
	       (PRIN1 (CAR %%L))
	       (PRINC (QUOTE / ))
	       (TERPRI)
	       (SPRINT %%G 2 0)
	       (PRINC (QUOTE / ))
	       (TERPRI)
	       (SPRINT (CAR %%F) 1 1)
	       (PRINC (QUOTE /)))))
	(COND ((SETQ %%F (CDR %%F)) (GO C)))
   D    (SETQ %%L (CDR %%L))
	(GO A))) 
FEXPR)

(DEFPROP SPRINT 
 (LAMBDA (%%L N M)
  (PROG NIL
   A    (COND ((LESSP (DIFFERENCE (PLUS (LINELENGTH NIL) 1) (CHRCT)) N) (PPOS (SUB1 N)) (GO A))
	      ((OR (ATOM %%L) (LESSP (PLUS M (FLATSIZE %%L)) (CHRCT))) (RETURN (PRIN1 %%L)))
	      ((AND (PRINC (QUOTE /())
		    (LESSP 1 (LENGTH %%L))
		    (LESSP (DIFFERENCE (PLUS 1 (FLATSIZE %%L) (PANL (LAST %%L))) (FLATSIZE (LAST %%L)))
			   (CHRCT)))
	       (PROG NIL
 		A    (PRIN1 (CAR %%L))
		     (PRINC (QUOTE / ))
		     (COND ((CDR (SETQ %%L (CDR %%L))) (GO A)))
		     (HUNOZ M %%L (CHRCT))))
	      ((AND (LESSP 2 (LENGTH %%L)) (LESSP (PANL %%L) (CHRCT)))
	       (PROG (F)
		     (SETQ F (MEMQ (PRIN1 (CAR %%L)) (QUOTE (PROG LAMBDA))))
		     (SETQ N
			   (DIFFERENCE (COND ((EQ (CAR %%L) (QUOTE LAMBDA)) (PRINC (QUOTE / ))
									    (*DIF (LINELENGTH NIL) 6))
					     ((PLUS (LINELENGTH NIL) 2)))
				       (CHRCT)))
 		A    (COND
		      ((HUNOZ M
			      (CDR %%L)
			      (PLUS N (COND ((AND (ATOM (CADR %%L)) (PRINC (QUOTE / )) F (CADR %%L)) -5) (0))))
		       (RETURN (PRIN1 (CDDR %%L)))))
		     (COND
		      ((CDR (SETQ %%L (CDR %%L)))
		       (COND ((LESSP N (DIFFERENCE (PLUS (LINELENGTH NIL) 1) (CHRCT))) (TERPRI)))
		       (GO A)))))
	      ((PROG NIL
		     (SETQ N (DIFFERENCE (PLUS (LINELENGTH NIL) 1) (CHRCT)))
 		A    (COND ((HUNOZ M %%L N) (RETURN (PRIN1 (CDR %%L)))))
		     (COND ((SETQ %%L (CDR %%L)) (TERPRI) (GO A))))))
	(PRINC (QUOTE /))))) 
EXPR)

(DEFPROP HUNOZ 
 (LAMBDA (M L N)
  (PROG2 (SPRINT (CAR L) N (COND ((NULL (SETQ L (CDR L))) (ADD1 M)) ((ATOM L) (PLUS 4 M (FLATSIZE L))) (0)))
	 (COND ((AND L (ATOM L)) (PRINC (QUOTE / /./ )))))) 
EXPR)

(DEFPROP PANL 
 (LAMBDA (L)
  (COND ((OR (ATOM L) (ATOM (CDR L))) (PLUS 15 (FLATSIZE L))) ((PLUS (PANL (CADR L)) 2 (FLATSIZE (CAR L)))))) 
EXPR)

(DEFPROP PPOS 
 (LAMBDA (N)
  (PROG NIL
	(COND ((OR (LESSP N 1) (LESSP N (*DIF (LINELENGTH NIL) (CHRCT)))) (TERPRI)))
   L1   (COND ((GREATERP N (DIFFERENCE (LINELENGTH NIL) (CHRCT) -7)) (TYO 11) (GO L1)))
	(SETQ N (*DIF N (*DIF (LINELENGTH NIL) (CHRCT))))
   L2   (COND ((LESSP N 1) (RETURN NIL)))
	(TYO 40)
	(SETQ N (SUB1 N))
	(GO L2))) 
EXPR)