Google
 

Trailing-Edge - PDP-10 Archives - -
Click to see without markup as text/plain
There are no other files named in the archive.
00100	
00200	
00300	(DEFPROP GRINFNS 
00400	 (NIL GRINDEF SPRINT HUNOZ PANL PPOS) 
00500	VALUE)
00600	
00700	(DEFPROP GRINDEF 
00800	 (LAMBDA (%%L)
00900	  (PROG (%%F %%G %%H)
01000		(PROG (%%UBD))
01100		(SETQ %%H (QUOTE (EXPR FEXPR VALUE MACRO SPECIAL)))
01200	   A    (COND ((NULL %%L) (RETURN NIL)))
01300		(SETQ %%F %%H)
01400		(COND ((ATOM (CAR %%L))))
01500	   C    (COND ((NOT (ATOM (CAR %%L))) (SETQ %%H (CAR %%L)) (GO D))
01600		      ((AND (SETQ %%G (GET (CAR %%L) (CAR %%F)))
01700			    (OR (ATOM %%G) (NOT (EQ (CDR %%G) (CDR (GET (QUOTE %%UBD) (QUOTE VALUE)))))))
01800		       (TERPRI)
01900		       (TERPRI)
02000		       (PRINC (QUOTE /(DEFPROP/ ))
02100		       (PRIN1 (CAR %%L))
02200		       (PRINC (QUOTE / ))
02300		       (TERPRI)
02400		       (SPRINT %%G 2 0)
02500		       (PRINC (QUOTE / ))
02600		       (TERPRI)
02700		       (SPRINT (CAR %%F) 1 1)
02800		       (PRINC (QUOTE /)))))
02900		(COND ((SETQ %%F (CDR %%F)) (GO C)))
03000	   D    (SETQ %%L (CDR %%L))
03100		(GO A))) 
03200	FEXPR)
03300	
03400	(DEFPROP SPRINT 
03500	 (LAMBDA (%%L N M)
03600	  (PROG NIL
03700	   A    (COND ((LESSP (DIFFERENCE (PLUS (LINELENGTH NIL) 1) (CHRCT)) N) (PPOS (SUB1 N)) (GO A))
03800		      ((OR (ATOM %%L) (LESSP (PLUS M (FLATSIZE %%L)) (CHRCT))) (RETURN (PRIN1 %%L)))
03900		      ((AND (PRINC (QUOTE /())
04000			    (LESSP 1 (LENGTH %%L))
04100			    (LESSP (DIFFERENCE (PLUS 1 (FLATSIZE %%L) (PANL (LAST %%L))) (FLATSIZE (LAST %%L)))
04200				   (CHRCT)))
04300		       (PROG NIL
04400	 		A    (PRIN1 (CAR %%L))
04500			     (PRINC (QUOTE / ))
04600			     (COND ((CDR (SETQ %%L (CDR %%L))) (GO A)))
04700			     (HUNOZ M %%L (CHRCT))))
04800		      ((AND (LESSP 2 (LENGTH %%L)) (LESSP (PANL %%L) (CHRCT)))
04900		       (PROG (F)
05000			     (SETQ F (MEMQ (PRIN1 (CAR %%L)) (QUOTE (PROG LAMBDA))))
05100			     (SETQ N
05200				   (DIFFERENCE (COND ((EQ (CAR %%L) (QUOTE LAMBDA)) (PRINC (QUOTE / ))
05300										    (*DIF (LINELENGTH NIL) 6))
05400						     ((PLUS (LINELENGTH NIL) 2)))
05500					       (CHRCT)))
05600	 		A    (COND
05700			      ((HUNOZ M
05800				      (CDR %%L)
05900				      (PLUS N (COND ((AND (ATOM (CADR %%L)) (PRINC (QUOTE / )) F (CADR %%L)) -5) (0))))
06000			       (RETURN (PRIN1 (CDDR %%L)))))
06100			     (COND
06200			      ((CDR (SETQ %%L (CDR %%L)))
06300			       (COND ((LESSP N (DIFFERENCE (PLUS (LINELENGTH NIL) 1) (CHRCT))) (TERPRI)))
06400			       (GO A)))))
06500		      ((PROG NIL
06600			     (SETQ N (DIFFERENCE (PLUS (LINELENGTH NIL) 1) (CHRCT)))
06700	 		A    (COND ((HUNOZ M %%L N) (RETURN (PRIN1 (CDR %%L)))))
06800			     (COND ((SETQ %%L (CDR %%L)) (TERPRI) (GO A))))))
06900		(PRINC (QUOTE /))))) 
07000	EXPR)
07100	
07200	(DEFPROP HUNOZ 
07300	 (LAMBDA (M L N)
07400	  (PROG2 (SPRINT (CAR L) N (COND ((NULL (SETQ L (CDR L))) (ADD1 M)) ((ATOM L) (PLUS 4 M (FLATSIZE L))) (0)))
07500		 (COND ((AND L (ATOM L)) (PRINC (QUOTE / /./ )))))) 
07600	EXPR)
07700	
07800	(DEFPROP PANL 
07900	 (LAMBDA (L)
08000	  (COND ((OR (ATOM L) (ATOM (CDR L))) (PLUS 15 (FLATSIZE L))) ((PLUS (PANL (CADR L)) 2 (FLATSIZE (CAR L)))))) 
08100	EXPR)
08200	
08300	(DEFPROP PPOS 
08400	 (LAMBDA (N)
08500	  (PROG NIL
08600		(COND ((OR (LESSP N 1) (LESSP N (*DIF (LINELENGTH NIL) (CHRCT)))) (TERPRI)))
08700	   L1   (COND ((GREATERP N (DIFFERENCE (LINELENGTH NIL) (CHRCT) -7)) (TYO 11) (GO L1)))
08800		(SETQ N (*DIF N (*DIF (LINELENGTH NIL) (CHRCT))))
08900	   L2   (COND ((LESSP N 1) (RETURN NIL)))
09000		(TYO 40)
09100		(SETQ N (SUB1 N))
09200		(GO L2))) 
09300	EXPR)