Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
00010	
00020	
00030	(DEFPROP GRINDEF 
00040	 (LAMBDA(%%L)
00050	  (PROG (%%F %%G %%H)
00060		(PROG (%%UBD))
00070		(SETQ %%H (QUOTE (EXPR FEXPR VALUE MACRO SPECIAL)))
00080	   A    (COND ((NULL %%L) (RETURN NIL)))
00090		(SETQ %%F %%H)
00100		(COND ((ATOM (CAR %%L))))
00110	   C    (COND ((NOT (ATOM (CAR %%L))) (SETQ %%H (CAR %%L)) (GO D))
00120		      ((AND (SETQ %%G (GET (CAR %%L) (CAR %%F)))
00130			    (OR (ATOM %%G) (NOT (EQ (CDR %%G) (CDR (GET (QUOTE %%UBD) (QUOTE VALUE)))))))
00140		       (TERPRI)
00150		       (TERPRI)
00160		       (PRINC (QUOTE /(DEFPROP/ ))
00170		       (PRIN1 (CAR %%L))
00180		       (PRINC (QUOTE / ))
00190		       (TERPRI)
00200		       (SPRINT %%G 2. 0.)
00210		       (PRINC (QUOTE / ))
00220		       (TERPRI)
00230		       (SPRINT (CAR %%F) 1. 1.)
00240		       (PRINC (QUOTE /)))))
00250		(COND ((SETQ %%F (CDR %%F)) (GO C)))
00260	   D    (SETQ %%L (CDR %%L))
00270		(GO A))) 
00280	FEXPR)
00290	
00300	(DEFPROP SPRINT 
00310	 (LAMBDA(%%L N M)
00320	  (PROG NIL
00330	   A    (COND ((LESSP (DIFFERENCE (PLUS (LINELENGTH NIL) 1.) (CHRCT)) N) (PPOS (SUB1 N)) (GO A))
00340		      ((OR (ATOM %%L) (LESSP (PLUS M (FLATSIZE %%L)) (CHRCT))) (RETURN (PRIN1 %%L)))
00350		      ((AND (PRINC (QUOTE /())
00360			    (LESSP 1. (LENGTH %%L))
00370			    (LESSP (DIFFERENCE (PLUS 1. (FLATSIZE %%L) (PANL (LAST %%L))) (FLATSIZE (LAST %%L)))
00380				   (CHRCT)))
00390		       (PROG NIL
00400	 		A    (PRIN1 (CAR %%L))
00410			     (PRINC (QUOTE / ))
00420			     (COND ((CDR (SETQ %%L (CDR %%L))) (GO A)))
00430			     (HUNOZ M %%L (CHRCT))))
00440		      ((AND (LESSP 2. (LENGTH %%L)) (LESSP (PANL %%L) (CHRCT)))
00450		       (PROG (F)
00460			     (SETQ F (MEMQ (PRIN1 (CAR %%L)) (QUOTE (PROG LAMBDA))))
00470			     (SETQ N
00480				   (DIFFERENCE (COND ((EQ (CAR %%L) (QUOTE LAMBDA)) (PRINC (QUOTE / ))
00490										    (*DIF (LINELENGTH NIL) 6.))
00500						     ((PLUS (LINELENGTH NIL) 2.)))
00510					       (CHRCT)))
00520	 		A    (COND
00530			      ((HUNOZ M
00540				      (CDR %%L)
00550				      (PLUS N
00560					    (COND ((AND (ATOM (CADR %%L)) (PRINC (QUOTE / )) F (CADR %%L)) -5.) (0.))))
00570			       (RETURN (PRIN1 (CDDR %%L)))))
00580			     (COND
00590			      ((CDR (SETQ %%L (CDR %%L)))
00600			       (COND ((LESSP N (DIFFERENCE (PLUS (LINELENGTH NIL) 1.) (CHRCT))) (TERPRI)))
00610			       (GO A)))))
00620		      ((PROG NIL
00630			     (SETQ N (DIFFERENCE (PLUS (LINELENGTH NIL) 1.) (CHRCT)))
00640	 		A    (COND ((HUNOZ M %%L N) (RETURN (PRIN1 (CDR %%L)))))
00650			     (COND ((SETQ %%L (CDR %%L)) (TERPRI) (GO A))))))
00660		(PRINC (QUOTE /))))) 
00670	EXPR)
00680	
00690	(DEFPROP HUNOZ 
00700	 (LAMBDA(M L N)
00710	  (PROG2 (SPRINT (CAR L) N (COND ((NULL (SETQ L (CDR L))) (ADD1 M)) ((ATOM L) (PLUS 4. M (FLATSIZE L))) (0.)))
00720		 (COND ((AND L (ATOM L)) (PRINC (QUOTE / /./ )))))) 
00730	EXPR)
00740	
00750	(DEFPROP PANL 
00760	 (LAMBDA(L)
00770	  (COND ((OR (ATOM L) (ATOM (CDR L))) (PLUS 13. (FLATSIZE L))) ((PLUS (PANL (CADR L)) 2. (FLATSIZE (CAR L)))))) 
00780	EXPR)
00790	
00800	(DEFPROP PPOS 
00810	 (LAMBDA(N)
00820	  (PROG NIL
00830		(COND ((OR (LESSP N 1.) (LESSP N (*DIF (LINELENGTH NIL) (CHRCT)))) (TERPRI)))
00840	   L1   (COND ((GREATERP N (DIFFERENCE (LINELENGTH NIL) (CHRCT) -7.)) (TYO 9.) (GO L1)))
00850		(SETQ N (*DIF N (*DIF (LINELENGTH NIL) (CHRCT))))
00860	   L2   (COND ((LESSP N 1.) (RETURN NIL)))
00870		(TYO 32.)
00880		(SETQ N (SUB1 N))
00890		(GO L2))) 
00900	EXPR)