reduce-historical/r30/rprint.red

COMMENT MODULE RPRINT;

COMMENT THE STANDARD LISP TO REDUCE PRETTY PRINTER;

FLUID '(PRETOP PRETOPRINF);

PRETOP := 'OP; PRETOPRINF := 'OPRINF;

FLUID '(COMBUFF);

FLUID '(CURMARK BUFFP RMAR !*N);

SYMBOLIC PROCEDURE RPRINT U;
   BEGIN INTEGER !*N; SCALAR BUFF,BUFFP,CURMARK,RMAR,X;
      CURMARK := 0;
      BUFF := BUFFP := LIST LIST(0,0);
      RMAR := LINELENGTH NIL;
      X := GET('!*SEMICOL!*,PRETOP);
      !*N := 0;
      MPRINO1(U,LIST(CAAR X,CADAR X));
      PRIN2OX ";";
      OMARKO CURMARK;
      PRINOS BUFF
   END;

SYMBOLIC PROCEDURE RPRIN1 U;
   BEGIN SCALAR BUFF,BUFFP,CURMARK,X;
      CURMARK := 0;
      BUFF := BUFFP := LIST LIST(0,0);
      X := GET('!*SEMICOL!*,PRETOP);
      MPRINO1(U,LIST(CAAR X,CADAR X));
      OMARKO CURMARK;
      PRINOS BUFF
   END;

SYMBOLIC PROCEDURE MPRINO U; MPRINO1(U,LIST(0,0));

SYMBOLIC PROCEDURE MPRINO1(U,V);
   BEGIN SCALAR X;
	IF X := ATSOC(U,COMBUFF)
	  THEN <<FOR EACH Y IN CDR X DO COMPROX Y;
		 COMBUFF := DELETE(X,COMBUFF)>>;
      IF NUMBERP U AND U<0 AND (X := GET('DIFFERENCE,PRETOP))
        THEN RETURN BEGIN SCALAR P;
	X := CAR X;
	P := (NOT CAR X>CADR V) OR (NOT CADR X>CAR V);
	IF P THEN PRIN2OX "(";
	PRINOX U;
	IF P THEN PRINOX ")"
       END
       ELSE IF ATOM U THEN RETURN PRINOX U
      ELSE IF NOT ATOM CAR U 
	   THEN <<CURMARK := CURMARK+1;
	  PRIN2OX "("; MPRINO CAR U; PRIN2OX ")";
	  OMARK LIST(CURMARK,3); CURMARK := CURMARK-1>>
       ELSE IF X := GET(CAR U,PRETOPRINF)
	THEN RETURN BEGIN SCALAR P;
	   P := CAR V>0 AND NOT CAR U MEMQ '(BLOCK PROG QUOTE STRING);
	   IF P THEN PRIN2OX "(";
	   APPLY(X,LIST CDR U);
	   IF P THEN PRIN2OX ")"
	 END
       ELSE IF X := GET(CAR U,PRETOP)
        THEN RETURN IF CAR X THEN INPRINOX(U,CAR X,V)
		     ELSE IF CDDR U THEN REDERR "Syntax error"
		     ELSE IF NULL CADR X THEN INPRINOX(U,LIST(100,1),V)
		     ELSE INPRINOX(U,LIST(100,CADR X),V)
       ELSE PRINOX CAR U;
      IF RLISTATP CAR U THEN RETURN RLPRI(CDR U,V);
      U := CDR U;
      IF NULL U THEN PRIN2OX "()"
      ELSE MPRARGS(U,V)
   END;

SYMBOLIC PROCEDURE MPRARGS(U,V);
   IF NULL CDR U THEN <<PRIN2OX " "; MPRINO1(CAR U,LIST(100,100))>>
   ELSE INPRINOX('!*COMMA!* . U,LIST(0,0),V);

SYMBOLIC PROCEDURE INPRINOX(U,X,V);
   BEGIN SCALAR P;
      P := (NOT CAR X>CADR V) OR (NOT CADR X>CAR V);
      IF P THEN PRIN2OX "("; OMARK '(M U);
      INPRINO(CAR U,X,CDR U);
      IF P THEN PRIN2OX ")"; OMARK '(M D)
   END;

SYMBOLIC PROCEDURE INPRINO(OPR,V,L);
   BEGIN SCALAR FLG,X;
      CURMARK := CURMARK+2;
      X := GET(OPR,PRETOP);
      IF X AND CAR X
	THEN <<MPRINO1(CAR L,LIST(CAR V,0)); L := CDR L; FLG := T>>;
      WHILE L DO
      	<<IF OPR EQ '!*COMMA!* THEN <<PRIN2OX ","; OMARKO CURMARK>>
	   ELSE IF OPR EQ 'SETQ
	    THEN <<PRIN2OX " := "; OMARK LIST(CURMARK,1)>>
        ELSE IF ATOM CAR L OR NOT OPR EQ GET!*(CAAR L,'ALT)
	THEN <<OMARK LIST(CURMARK,1); OPRINO(OPR,FLG); FLG := T>>;
      MPRINO1(CAR L,LIST(IF NULL CDR L THEN 0 ELSE CAR V,
			  IF NULL FLG THEN 0 ELSE CADR V));
	 L := CDR L>>;
      CURMARK := CURMARK-2
   END;

SYMBOLIC PROCEDURE OPRINO(OPR,B);
   (LAMBDA X; IF NULL X
		 THEN <<IF B THEN PRIN2OX " "; PRINOX OPR; PRIN2OX " ">>
	       ELSE PRIN2OX CAR X)
   GET(OPR,'PRTCH);

SYMBOLIC PROCEDURE PRIN2OX U;
   <<RPLACD(BUFFP,EXPLODE2 U);
     WHILE CDR BUFFP DO BUFFP := CDR BUFFP>>;

SYMBOLIC PROCEDURE PRINOX U;
   <<RPLACD(BUFFP,EXPLODE U);
     WHILE CDR BUFFP DO BUFFP := CDR BUFFP>>;

SYMBOLIC PROCEDURE GET!*(U,V);
   IF NUMBERP U THEN NIL ELSE GET(U,V);

SYMBOLIC PROCEDURE OMARK U;
   <<RPLACD(BUFFP,LIST U); BUFFP := CDR BUFFP>>;

SYMBOLIC PROCEDURE OMARKO U; OMARK LIST(U,0);

SYMBOLIC PROCEDURE COMPROX U;
   BEGIN SCALAR X;
	IF CAR BUFFP = '(0 0)
	  THEN RETURN <<FOR EACH J IN U DO PRIN2OX J;
			OMARK '(0 0)>>;
	X := CAR BUFFP;
	RPLACA(BUFFP,LIST(CURMARK+1,3));
	FOR EACH J IN U DO PRIN2OX J;
	OMARK X
   END;

SYMBOLIC PROCEDURE RLISTATP U;
   GET(U,'STAT) MEMBER '(ENDSTAT RLIS);

SYMBOLIC PROCEDURE RLPRI(U,V);
   IF NULL U THEN NIL
    ELSE BEGIN
      PRIN2OX " ";
      OMARK '(M U);
      INPRINO('!*COMMA!*,LIST(0,0),U);
      OMARK '(M D)
   END;

SYMBOLIC PROCEDURE CONDOX U;
   BEGIN SCALAR X;
      OMARK '(M U);
      CURMARK := CURMARK+2;
      WHILE U DO
	<<PRIN2OX "IF "; MPRINO CAAR U; OMARK LIST(CURMARK,1);
	  PRIN2OX " THEN ";
	  IF CDR U AND EQCAR(CADAR U,'COND)
		 AND NOT EQCAR(CAR REVERSE CADAR U,'T)
	   THEN <<X := T; PRIN2OX "(">>;
	  MPRINO CADAR U;
	  IF X THEN PRIN2OX ")";
	  U := CDR U;
          IF U THEN <<OMARKO(CURMARK-1); PRIN2OX " ELSE ">>;
	  IF U AND NULL CDR U AND CAAR U EQ 'T
	    THEN <<MPRINO CADAR U; U := NIL>>>>;
      CURMARK := CURMARK-2;
      OMARK '(M D)
   END;

PUT('COND,PRETOPRINF,'CONDOX);

SYMBOLIC PROCEDURE BLOCKOX U;
   BEGIN
      OMARK '(M U);
      CURMARK := CURMARK+2;
      PRIN2OX "BEGIN ";
      IF CAR U THEN VARPRX CAR U;
      U := LABCHK CDR U;
      OMARK LIST(CURMARK,IF EQCAR(CAR U,'!*LABEL) THEN 1 ELSE 3);
      WHILE U DO
	<<MPRINO CAR U;
	IF NOT EQCAR(CAR U,'!*LABEL) AND CDR U THEN PRIN2OX "; ";
 	U := CDR U;
	IF U
	  THEN OMARK LIST(CURMARK,
			  IF EQCAR(CAR U,'!*LABEL) THEN 1 ELSE 3)>>;
      OMARK LIST(CURMARK-1,-1);
      PRIN2OX " END";
      CURMARK := CURMARK-2;
      OMARK '(M D)
   END;

SYMBOLIC PROCEDURE RETOX U;
   BEGIN
      OMARK '(M U);
      CURMARK := CURMARK+2;
      PRIN2OX "RETURN ";
      OMARK '(M U);
      MPRINO CAR U;
      CURMARK := CURMARK-2;
      OMARK '(M D);
      OMARK '(M D)
   END;

PUT('RETURN,PRETOPRINF,'RETOX);

SYMBOLIC PROCEDURE VARPRX U;
      MAPC(CDR U,FUNCTION (LAMBDA J;
			<<PRIN2OX CAR J;
			PRIN2OX " ";
			INPRINO('!*COMMA!*,LIST(0,0),CDR J);
			PRIN2OX "; ";
			OMARK LIST(CURMARK,6)>>));

COMMENT a version for the old parser;

SYMBOLIC PROCEDURE VARPRX U;
   BEGIN SCALAR TYP;
      U := REVERSE U;
       WHILE U DO
	<<IF CDAR U EQ TYP
	    THEN <<PRIN2OX ","; OMARKO(CURMARK+1); PRINOX CAAR U>>
	   ELSE <<IF TYP THEN <<PRIN2OX "; "; OMARK '(M D)>>;
		PRINOX (TYP := CDAR U);
	  	  PRIN2OX " "; OMARK '(M U); PRINOX CAAR U>>;
	   U := CDR U>>;
      PRIN2OX "; ";
      OMARK '(M D)
   END;

PUT('BLOCK,PRETOPRINF,'BLOCKOX);

SYMBOLIC PROCEDURE PROGOX U;
   BLOCKOX(MAPCAR(REVERSE CAR U,FUNCTION (LAMBDA J; J . 'SCALAR)) 
	. CDR U);

SYMBOLIC PROCEDURE LABCHK U;
   BEGIN SCALAR X;
      FOR EACH Z IN U DO IF ATOM Z
	THEN X := LIST('!*LABEL,Z) . X ELSE X := Z . X;
       RETURN REVERSIP X
   END;

PUT('PROG,PRETOPRINF,'PROGOX);

SYMBOLIC PROCEDURE GOX U;
   <<PRIN2OX "GO TO "; PRINOX CAR U>>;

PUT('GO,PRETOPRINF,'GOX);

SYMBOLIC PROCEDURE LABOX U;
   <<PRINOX CAR U; PRIN2OX ": ">>;

PUT('!*LABEL,PRETOPRINF,'LABOX);

SYMBOLIC PROCEDURE QUOTOX U;
   IF STRINGP U THEN PRINOX U ELSE <<PRIN2OX "'"; PRINSOX CAR U>>;

SYMBOLIC PROCEDURE PRINSOX U;
   IF ATOM U THEN PRINOX U
    ELSE <<PRIN2OX "(";
	   OMARK '(M U);
	   CURMARK := CURMARK+1;
	WHILE U DO <<PRINSOX CAR U;
			U := CDR U;
			IF U THEN <<OMARK LIST(CURMARK,-1);
			IF ATOM U
			  THEN <<PRIN2OX " . "; PRINSOX U; U := NIL>>
			 ELSE PRIN2OX " ">>>>;
	   CURMARK := CURMARK-1;
	   OMARK '(M D);
	PRIN2OX ")">>;

PUT('QUOTE,PRETOPRINF,'QUOTOX);

SYMBOLIC PROCEDURE PROGNOX U;
   BEGIN
      CURMARK := CURMARK+1;
      PRIN2OX "<<";
      OMARK '(M U);
      WHILE U DO <<MPRINO CAR U; U := CDR U;
		IF U THEN <<PRIN2OX "; "; OMARKO CURMARK>>>>;
      OMARK '(M D);
      PRIN2OX ">>";
      CURMARK := CURMARK-1
   END;

PUT('PROG2,PRETOPRINF,'PROGNOX);

PUT('PROGN,PRETOPRINF,'PROGNOX);

SYMBOLIC PROCEDURE REPEATOX U;
   BEGIN
      CURMARK := CURMARK+1;
      OMARK '(M U);
      PRIN2OX "REPEAT ";
      MPRINO CAR U;
      PRIN2OX " UNTIL ";
      OMARK LIST(CURMARK,3);
      MPRINO CADR U;
      OMARK '(M D);
      CURMARK := CURMARK-1
   END;

PUT('REPEAT,PRETOPRINF,'REPEATOX);

SYMBOLIC PROCEDURE WHILEOX U;
   BEGIN
      CURMARK := CURMARK+1;
     OMARK '(M U);
      PRIN2OX "WHILE ";
      MPRINO CAR U;
      PRIN2OX " DO ";
      OMARK LIST(CURMARK,3);
      MPRINO CADR U;
      OMARK '(M D);
      CURMARK := CURMARK-1
   END;

PUT('WHILE,PRETOPRINF,'WHILEOX);

SYMBOLIC PROCEDURE PROCOX U;
   BEGIN
      OMARK '(M U);
      CURMARK := CURMARK+1;
      IF CADDDR CDR U THEN <<MPRINO CADDDR CDR U; PRIN2OX " ">>;
      PRIN2OX "PROCEDURE ";
      PROCOX1(CAR U,CADR U,CADDR U)
   END;

SYMBOLIC PROCEDURE PROCOX1(U,V,W);
   BEGIN
      PRINOX U;
      IF V THEN MPRARGS(V,LIST(0,0));
      PRIN2OX "; ";
      OMARK LIST(CURMARK,3);
      MPRINO W;
      CURMARK := CURMARK-1;
      OMARK '(M D)
   END;

PUT('PROC,PRETOPRINF,'PROCOX);

SYMBOLIC PROCEDURE PROCEOX U;
   BEGIN
      OMARK '(M U);
      CURMARK := CURMARK+1;
      MPRINO CADR U; PRIN2OX " ";
      IF NOT CADDR U EQ 'EXPR THEN <<MPRINO CADDR U; PRIN2OX " ">>;
      PRIN2OX "PROCEDURE ";
      PROCEOX1(CAR U,CADDDR U,CAR CDDDDR U)
   END;

SYMBOLIC PROCEDURE PROCEOX1(U,V,W);
   BEGIN
      PRINOX U;
      IF V
	THEN <<IF NOT ATOM CAR V THEN V:= FOR EACH J IN V COLLECT CAR J;
	       %allows for typing to be included with proc arguments;
	       MPRARGS(V,LIST(0,0))>>;
      PRIN2OX "; ";
      OMARK LIST(CURMARK,3);
      MPRINO W;
      CURMARK := CURMARK -1;
      OMARK '(M D)
   END;

PUT('PROCEDURE,PRETOPRINF,'PROCEOX);

SYMBOLIC PROCEDURE PROCEOX0(U,V,W,X);
   PROCEOX LIST(U,'SYMBOLIC,V,
		MAPCAR(W,FUNCTION (LAMBDA J; J . 'SYMBOLIC)),X);

SYMBOLIC PROCEDURE DEOX U;
   PROCEOX0(CAR U,'EXPR,CADR U,CADDR U);

PUT('DE,PRETOPRINF,'DEOX);

SYMBOLIC PROCEDURE DFOX U;
   PROCEOX0(CAR U,'FEXPR,CADR U,CADDR U);

%PUT('DF,PRETOPRINF,'DFOX);   %commented out because of confusion with
			      %differentiation;

SYMBOLIC PROCEDURE STRINGOX U;
   <<PRIN2OX '!"; PRIN2OX CAR U; PRIN2OX '!">>;

PUT('STRING,PRETOPRINF,'STRINGOX);

SYMBOLIC PROCEDURE LAMBDOX U;
   BEGIN
      OMARK '(M U);
      CURMARK := CURMARK+1;
      PROCOX1('LAMBDA,CAR U,CADR U)
   END;

PUT('LAMBDA,PRETOPRINF,'LAMBDOX);

SYMBOLIC PROCEDURE EACHOX U;
   <<PRIN2OX "FOR EACH ";
     WHILE CDR U DO <<MPRINO CAR U; PRIN2OX " "; U := CDR U>>;
     MPRINO CAR U>>;

PUT('FOREACH,PRETOPRINF,'EACHOX);

SYMBOLIC PROCEDURE FOROX U;
   BEGIN
      CURMARK := CURMARK+1;
      OMARK '(M U);
      PRIN2OX "FOR ";
      MPRINO CAR U;
      PRIN2OX " := ";
      MPRINO CAADR U;
      IF CADR CADR U NEQ 1
	THEN <<PRIN2OX " STEP "; MPRINO CADR CADR U; PRIN2OX " UNTIL ">>
       ELSE PRIN2OX ":";
      MPRINO CADDR CADR U;
      PRIN2OX " ";
      MPRINO CADDR U;
      PRIN2OX " ";
      OMARK LIST(CURMARK,3);
      MPRINO CADDDR U;
      OMARK '(M D);
      CURMARK := CURMARK-1
   END;

PUT('FOR,PRETOPRINF,'FOROX);

SYMBOLIC PROCEDURE FORALLOX U;
   BEGIN
      CURMARK := CURMARK+1;
      OMARK '(M U);
      PRIN2OX "FOR ALL ";
      INPRINO('!*COMMA!*,LIST(0,0),CAR U);
      IF CADR U
	THEN <<OMARK LIST(CURMARK,3);
	       PRIN2OX " SUCH THAT ";
	       MPRINO CADR U>>;
      PRIN2OX " ";
      OMARK LIST(CURMARK,3);
      MPRINO CADDR U;
      OMARK '(M D);
      CURMARK := CURMARK-1
   END;

PUT('FORALL,PRETOPRINF,'FORALLOX);


COMMENT Declarations needed by old parser;

IF NULL GET('!*SEMICOL!*,'OP)
  THEN <<PUT('!*SEMICOL!*,'OP,'((-1 0)));
	 PUT('!*COMMA!*,'OP,'((5 6)))>>;


COMMENT RPRINT MODULE, Part 2;

FLUID '(ORIG CURPOS);

SYMBOLIC PROCEDURE PRINOS U;
   BEGIN INTEGER CURPOS;
   	SCALAR ORIG;
      ORIG := LIST POSN();
      CURPOS := CAR ORIG;
      PRINOY(U,0);
      TERPRI0X()
   END;

SYMBOLIC PROCEDURE PRINOY(U,N);
   BEGIN SCALAR X;
      IF CAR(X := SPACELEFT(U,N)) THEN RETURN PRINOM(U,N)
       ELSE IF NULL CDR X THEN RETURN IF CAR ORIG<10 THEN PRINOM(U,N)
       ELSE <<ORIG := 9 . CDR ORIG;
		TERPRI0X();
		SPACES2(CURPOS := 9+CADAR U);
		PRINOY(U,N)>>
      ELSE BEGIN
	A: U := PRINOY(U,N+1);
	   IF NULL CDR U OR CAAR U<=N THEN RETURN;
	   TERPRI0X();
	   SPACES2(CURPOS := CAR ORIG+CADAR U);
	   GO TO A END;
      RETURN U
   END;

SYMBOLIC PROCEDURE SPACELEFT(U,MARK);
   %U is an expanded buffer of characters delimited by non-atom marks
   %of the form: '(M ...) or '(INT INT))
   %MARK is an integer;
   BEGIN INTEGER N; SCALAR FLG,MFLG;
      N := RMAR - CURPOS;
      U := CDR U;   %move over the first mark;
      WHILE U AND NOT FLG AND N>=0 DO
	<<IF ATOM CAR U THEN N := N-1
	   ELSE IF CAAR U EQ 'M THEN NIL
	   ELSE IF MARK>=CAAR U THEN <<FLG := T; U := NIL . U>>
	   ELSE MFLG := T;
	  U := CDR U>>;
      RETURN ((N>=0) . MFLG)
   END;

SYMBOLIC PROCEDURE PRINOM(U,MARK);
   BEGIN INTEGER N; SCALAR FLG,X;
      N := CURPOS;
      U := CDR U;
      WHILE U AND NOT FLG DO
	<<IF ATOM CAR U THEN <<X := PRIN20X CAR U; N := N+1>>
	  ELSE IF CAAR U EQ 'M
	   THEN IF CADAR U EQ 'U THEN ORIG := N . ORIG
		 ELSE ORIG := CDR ORIG
	   ELSE IF MARK>=CAAR U
	     AND NOT(X='!, AND RMAR-N-6>CHARSPACE(U,X,MARK))
	    THEN <<FLG := T; U := NIL . U>>;
	  U := CDR U>>;
      CURPOS := N;
	IF MARK=0 AND CDR U
	  THEN <<TERPRI0X();
		 TERPRI0X();
		 ORIG := LIST 0; CURPOS := 0; PRINOY(U,MARK)>>;
	  %must be a top level constant;
      RETURN U
   END;

SYMBOLIC PROCEDURE CHARSPACE(U,CHAR,MARK);
   %determines if there is space until the next character CHAR;
   BEGIN INTEGER N;
      N := 0;
      WHILE U DO
	<<IF CAR U = CHAR THEN U := LIST NIL
	   ELSE IF ATOM CAR U THEN N := N+1
	   ELSE IF CAR U='(M U) THEN <<N := 1000; U := LIST NIL>>
	   ELSE IF NUMBERP CAAR U AND CAAR U<MARK THEN U := LIST NIL;
	  U := CDR U>>;
      RETURN N
   END;

SYMBOLIC PROCEDURE SPACES2 N;
   %FOR I := 1:N DO PRIN20X '! ;
   WHILE N>0 DO <<PRIN20X '! ; N := N-1>>;

SYMBOLIC PROCEDURE PRIN2ROX U;
   BEGIN INTEGER M,N; SCALAR X,Y;
      M := RMAR-12;
      N := RMAR-1;
      WHILE U DO
	IF CAR U EQ '!"
	  THEN <<IF NOT STRINGSPACE(CDR U,N-!*N)
		   THEN <<TERPRI0X(); !*N := 0>>
		  ELSE NIL;
		 PRIN20X '!";
		 U := CDR U;
		 WHILE NOT CAR U EQ '!" DO
		   <<PRIN20X CAR U; U := CDR U; !*N := !*N+1>>;
		 PRIN20X '!";
		 U := CDR U;
		 !*N := !*N+2;
		 X := Y := NIL>>
	 ELSE IF ATOM CAR U AND NOT(CAR U EQ '!  AND (!*N=0 OR NULL X
	       OR CDR U AND BREAKP CADR U OR BREAKP X AND NOT Y EQ '!!))
	  THEN <<Y := X; PRIN20X(X := CAR U); !*N := !*N+1;
	 U := CDR U;
	 IF !*N=N OR !*N>M AND NOT BREAKP CAR U AND NOSPACE(U,N-!*N)
	  THEN <<TERPRI0X(); X := Y := NIL>> ELSE NIL>>
	 ELSE U := CDR U
   END;

SYMBOLIC PROCEDURE NOSPACE(U,N);
   IF N<1 THEN T
    ELSE IF NULL U THEN NIL
    ELSE IF NOT ATOM CAR U THEN NOSPACE(CDR U,N)
    ELSE IF NOT CAR U EQ '!! AND (CADR U EQ '!  OR BREAKP CADR U)
     THEN NIL
    ELSE NOSPACE(CDR U,N-1);

SYMBOLIC PROCEDURE BREAKP U;
   U MEMBER '(!< !> !; !: != !) !+ !- !, !' !");

SYMBOLIC PROCEDURE STRINGSPACE(U,N);
   IF N<1 THEN NIL ELSE IF CAR U EQ '!" THEN T
    ELSE STRINGSPACE(CDR U,N-1);


COMMENT Some interfaces needed;

PUT('CONS,'PRTCH,'(! !.!  !.));

GLOBAL '(RPRIFN!* RTERFN!*);

COMMENT RPRIFN!* allows output from RPRINT to be handled differently,
	RTERFN!* allows end of lines to be handled differently;

SYMBOLIC PROCEDURE PRIN20X U;
   IF RPRIFN!* THEN APPLY(RPRIFN!*,LIST U) ELSE PRIN2 U;

SYMBOLIC PROCEDURE TERPRI0X;
   IF RTERFN!* THEN APPLY(RTERFN!*,NIL) ELSE TERPRI();


END;