PROGRAM WARNIER(INFLE,OUTFLE,PLIPUNCH,OUTDIAG,SRCPUNCH);
  (*DECLARATIONS*)
   CONST
    NMDEL=13;MAXCPP=10;MAXNW=30;MAXPW=10;MAXLLO=160;
     MAXLLIP1=161;MAXDEPTH=40;NBRSTRPGS=20;LENSTRPGS=5000;DDSTL=100;
      (*CHARACTER CONSTANTS*)
       REGZERO='0';CAPA='A';SMALLA='a';
       HD1='ECHO OF INPUT  /  DIAGNOSTIC LOG';
   TYPE
    WPTRT=^WNODE;LPTRT=^LINEORD;QPTRT=^QEL;SPPTRT=^STRP;
    (*MORE TYPES*)
     VMT=PACKED ARRAY[1..MAXLLO] OF CHAR;
     WORDT=PACKED ARRAY[1..9] OF CHAR;
     STRPGTP=PACKED ARRAY[1..LENSTRPGS] OF CHAR;
    TDSTRING = STRING[8];

     CARDIMAGE=STRING[MAXLLIP1];
    (*ARBITRARY DEEPENER*)
     (*RECORD DECLARATIONS*)
      (*WARNIER NODE DEFINITION*)
       WNODE=PACKED RECORD
        (*POINTER TO SUBPAGE QUEUE ELEMENT IN PAGINATION*)
         SUBPAGE:QPTRT;
 (*(NEXT LVL, BACK, NEXT BRO)WARNIER POINTERS,(LEFT,RIGHT)LEX PTRS*)
         NLVL,BCK,NXT,LLINK,RLINK:WPTRT;
        (*START,LOCAL START,(NODE,REP) STRING OFFSET,MAXMOVE*)
         ST,LS,NDSOFF,RPSOFF,MXM:INTEGER;
 (*LEN(PRE,VAL,INFX,REP,OUT),LVL,LINES/NODE,LCL DEPTH,(STR,REP)PGNO*)
         LP,LV,LI,LR,LO,LVL,LPN,LD,SPN,RSPN:CHAR
       END;
      LINEORD=RECORD
       (*CURRENT NODE OF COUSIN SET*)
       WPTR:WPTRT;
       (*NEXT SET OF COUSINS*)
       NXTSC:LPTRT;
       (*START POSITION, LAST POSITION IN LAYOUT*)
       STARTP,LASTP:INTEGER
      END (*LINEORD NODE DEFINITION*);
      STRP=RECORD STRNG:STRPGTP;END (*STRP DEFINITION*);
      (*PAGE QEL NODE DEFINITION *)
       QEL=PACKED RECORD
        (*DEWEY DECIMAL STRING*)
         DDNSTR:STRING[DDSTL];
        (*FORWARD AND BACKWARD IN QUEUE*)
         NEXTQ,LASTQ:QPTRT;
        (*POINTERS*)
         SPPTR,NXTH,NLVLH:WPTRT;
        (*FULLWORD HELD VALUES, PRIORITY*)
         PRTY,LSPH,STSH,STPH,NDSOFFH:INTEGER;
        (*BYTE HELD VALUES*)
         LPH,LVH,LIH,LRH,LPNH,SPNH,LDPH,DDL:CHAR
       END;
     THREEDIG=STRING[3];
     BRKCHRS=SET OF CHAR;
   VAR
    LNOEC,PCNTEC,GMXD,PCNT,NCT,NPCNT,LPCNT,NQ,GMXH,PASSCNT,
     ECPL,COLPP,DGMPL,LPP,TOPM,LLO,LLOM4,LLI,LLIM4,LLIP1,CTRL,
      TITLEN,LASTNQ,NODEWIDTH,PREWIDTH,NODEWPPW,NODEWPP3,
       I,J,NDDN,CHDEL,GST,NQLIM,RETC,DISAMNO,NSP,LSP,FROFF,BROFF:INTEGER;
    WHEAD,WLAST,H,TWPTR,T,WNTOP,FRPTR,BRPTR:WPTRT;
    LPG,CPAGE:SPPTRT;
    LOTOP:LPTRT;
    QH,QR,FPORD,TPTR,QLTOP:QPTRT;
    (*ARRAYS & STRINGS*)
     KEYS:ARRAY[1..22] OF WORDT;
     START,REAR:ARRAY[1..MAXCPP] OF LPTRT;
     SPADDR:ARRAY[1..NBRSTRPGS] OF SPPTRT;
     BP,NP,NNE,NBE:ARRAY[1..MAXCPP] OF INTEGER;
     (*CHARACTER VARS*)

      BLNW:STRING[MAXNW];
      (*DEWEY DECIMAL HOLDERS*)
       DDN,PDN:STRING[DDSTL];
      HDRPC:STRING[24];
      BACKREF:STRING[28];
      CSTR:STRING[47];
      CPN:THREEDIG;
      (*MORE ARRAYS*)
       CN1,CN2,CN3:STRING[60];
       NOTITLE,EWD,LCEWD,SEEPG:PACKED ARRAY[1..24] OF CHAR;
       TINFX,TREP:STRING[12];
       TPRE:STRING[MAXPW];
       D,TIM:STRING[8];
      VBAR,TBR,BBR:PACKED ARRAY[1..3] OF CHAR;
      TITLE,EWDL,LCEWDL,BLANKV,TVAL:VMT;
      INCARD:CARDIMAGE;WORD:WORDT;
     MAXLEN:ARRAY[1..3] OF INTEGER;
     MAXM,TOTWIDTH:ARRAY[1..MAXDEPTH] OF INTEGER;
    BREAKERS,PRES,POSTS,INDIFFS:BRKCHRS;
    TAB,ICH,COM,SEMI,PCT,PEJ,QOT,SUPERZERO,SUPERNINE:CHAR;
    PLIFLAG,INDFLAG,SRCFLAG,PRINTABLE:BOOLEAN;
    INFLE,OUTFLE,PLIPUNCH,OUTDIAG,SRCPUNCH:TEXT;
  (*PROCEDURES*)
   (*GENERAL SUPPORT ROUTINES*)
    (*$I TIMEDATE.PAS*)
    PROCEDURE CONVERT(I:INTEGER;VAR TPN:THREEDIG);
     (*PRODUCE THREE DIGIT CHARACTER EQUIVALENT OF I*)
     BEGIN
      IF I>1000 THEN I:=I MOD 1000;
       IF I>=100 THEN BEGIN
        TPN[1]:=CHR(ORD(REGZERO)+I DIV 100);
        TPN[2]:='0'; I:=I MOD 100
       END
       ELSE BEGIN
        TPN[1]:=' '; TPN[2]:=' '
       END;
      IF I>=10 THEN BEGIN
       TPN[2]:=CHR(ORD(REGZERO)+I DIV 10);
       I:=I MOD 10
      END;
      TPN[3]:=CHR(ORD(REGZERO)+I)
     END(*CONVERT SUBROUTINE*);
    PROCEDURE OUTP;
     (*ADVANCE LINENO, PAGINATE IN ECHOFILE*)
     BEGIN
      LNOEC:=SUCC(LNOEC);
       IF LNOEC>ECPL THEN BEGIN
        PCNTEC:=SUCC(PCNTEC);LNOEC:=3;
        WRITELN(OUTDIAG,PEJ,HD1:32,' ':64,HDRPC,PCNTEC:3);
        WRITELN(OUTDIAG,'     ')
       END
     END (*PROCEDURE OUTP*);
    PROCEDURE NEWNODE;
     BEGIN
      IF WNTOP<>NIL THEN BEGIN
       TWPTR:=WNTOP;WNTOP:=TWPTR^.NXT
      END ELSE NEW(TWPTR);
      (*INIT NODE*)
       WITH TWPTR^ DO BEGIN
        SUBPAGE:=NIL;NLVL:=NIL;BCK:=NIL;NXT:=NIL;
        LLINK:=NIL;RLINK:=NIL;LD:=CHR(0);
        LI:=CHR(0);LR:=CHR(0);RSPN:=CHR(0);RPSOFF:=0;LS:=0; MXM:=0;
        SPN:=CHR(NSP);NDSOFF:=LSP
       END;
     END;
   PROCEDURE INITIALIZE;VAR I:INTEGER;BEGIN;
    BACKREF:='**(REPEATED FROM PAGE000)** ';
    SEEPG:='**SEE PAGE000**         ';
    EWD:='ENDWARNIERDIAGRAM       ';
    LCEWD:='endwarnierdiagram       ';
    (*CHARACTERS*)
     DDN:='ROOT                                              '+
           '                                                  ';


     HDRPC:='SPA:WN 1.5          PAGE';
     NOTITLE:='UNTITLED WARNIER DIAGRAM';
     (*XREFS,KEYS*)
      KEYS[1]:='COMMA    ';KEYS[2]:='TITLE    ';KEYS[3]:='QUOTE    ';
      (*TRAILERS*)
 CN1:=' SPA:WN - STRUCTURED PROGRAMMING AUTOMATED: WARNIER NOTATION';
 CN2:=' COPYRIGHT 1984, KSU RESEARCH FOUNDATION, MANHATTAN,KS 66506';
 CN3:=' LICENSE GRANTED TO COPY, BUT NOT FOR SALE OR PROFIT        ';
      KEYS[4] :='SEMI     ';KEYS[5] :='SRCPUNCH ';KEYS[6] :='PLIPUNCH ';
      KEYS[7] :='SEMICOLON';KEYS[8] :='INDENT   ';KEYS[9] :='VERTBAR  ';
      KEYS[10]:='PERCENT  ';KEYS[11]:='TOPBRACK ';
      (*MORE KEYS*)
       KEYS[12]:='BOTBRACK ';KEYS[13]:='DIAGCOLS ';KEYS[14]:='DIAGPAGEL';
       KEYS[15]:='NODEWIDTH';KEYS[16]:='PREFWIDTH';KEYS[17]:='ECHOPAGEL';
       KEYS[18]:='LINESPHYS';KEYS[19]:='TOPMARGIN';KEYS[20]:='LENLINOUT';
      KEYS[21]:='LENLININ ';KEYS[22]:='         ';
     CSTR:='MAYaGS4bcDJPV17.defBEHKNQTWZ258ghijCFILORUX0369';
     VBAR:=' | ';
     TBR:=' .-';BBR:=' ''-';
     PEJ:=CHR(12);
    ICH:=' ';COM:=',';SEMI:=';';PCT:='%';QOT:='"';
    PCNTEC:=0;NDDN:=4
   END;
   (*INPUT PHASE ROUTINES*)
    PROCEDURE INFILE(VAR INCARD:CARDIMAGE);
     (*READ INPUT RECORD, SKIP COMMENTS*)
     BEGIN
      INCARD:=BLANKV;
      READLN(INFLE,INCARD);
      (*ASTERISK IN COLUMN 1 ==> SPA:WN COMMENT*)
      WHILE INCARD[1]='*' DO BEGIN
       OUTP;WRITELN(OUTDIAG,' ',COPY(INCARD,1,LLO));
       IF SRCFLAG THEN WRITELN(SRCPUNCH,INCARD);
        INCARD[1]:=' ';
        IF PLIFLAG THEN WRITELN(PLIPUNCH,INCARD);
        INCARD:=BLANKV;
       READLN(INFLE,INCARD)
      END
     END(*OF INFILE PROCEDURE*);
    PROCEDURE HEADERS;
     VAR TOK:CHAR;HDRCARD:BOOLEAN;I,J:INTEGER;
     PROCEDURE NUM(VAR VAL:INTEGER);BEGIN;
      VAL:=ORD(TOK)-ORD(REGZERO);
       IF (VAL<0) OR (VAL>9) THEN BEGIN
 OUTP;WRITELN(OUTDIAG,' ***** NON-NUMERIC FOUND UNEXPECTEDLY: ',TOK);
       END;
      I:=SUCC(I);
       WHILE INCARD[I]<>' ' DO BEGIN;
        VAL:=VAL*10+ORD(INCARD[I])-ORD(REGZERO);
        I:=SUCC(I)
       END
     END;
     BEGIN
      (*PARSE HEADER CARD(S)*)
       HDRCARD:=TRUE;PRINTABLE:=TRUE;
       WHILE HDRCARD DO BEGIN
 OUTP;WRITELN(OUTDIAG,' ',COPY(INCARD,1,LLO));
        NSP:=1; I:=1;
        WHILE I<=LLI DO BEGIN
         WHILE (I<=LLI) AND (INCARD[I]=' ') DO
          I:=SUCC(I);
         (*PARSE CONTROL CARD*)
         IF I<=LLIM4 THEN BEGIN
          J:=1;
          WHILE(INCARD[I]<>' ') AND (J<=9) DO BEGIN
           IF (INCARD[I]<='z') AND (INCARD[I]>=SMALLA) THEN
            (*CAPITALIZE LETTERS OF KEYWORDS*)
            WORD[J]:=CHR(ORD(INCARD[I])+CHDEL)
           ELSE WORD[J]:=INCARD[I];
           J:=SUCC(J);I:=SUCC(I)
          END;
          FOR J:=J TO 9 DO WORD[J]:=' ';
          WHILE((INCARD[I]=' ') AND (I<=LLI)) DO I:=SUCC(I);
          IF I<=LLI THEN BEGIN
           TOK:=INCARD[I];
           IF (TOK<='z') AND (TOK>=SMALLA) THEN TOK:=CHR(ORD(TOK)+CHDEL);
           J:=1;
           WHILE(KEYS[J]<>WORD)AND(J<=21)DO J:=SUCC(J);
           CASE J OF
            1:(*COMMA    *)COM:=TOK;
            2:(*TITLE    *)BEGIN
             J:=1;TITLE:=BLANKV;
             IF SRCFLAG THEN WRITELN(SRCPUNCH,INCARD);
             WHILE I<=LLI DO BEGIN
              TITLE[J]:=INCARD[I];
              IF TITLE[J]<>' ' THEN TITLEN:=J;
              J:=SUCC(J);I:=SUCC(I)
             END;
             TITLE[J+2]:='/';TITLEN:=TITLEN+3;IF TITLEN<5 THEN TITLEN:=5
            END;
            3:(*QUOTE    *)QOT:=TOK;
            4:(*SEMI     *)SEMI:=TOK;
            (*OUTPUT OPTIONS*)
             5:(*SRCPUNCH *)BEGIN
              SRCFLAG:=TOK='Y';
             END;
             6:(*PLIPUNCH *)PLIFLAG:=TOK='Y';
             8:(*INDENT   *)BEGIN
              INDFLAG:=NOT(TOK='N');
              IF TOK='Y' THEN ICH:=' '
              ELSE ICH:=TOK
             END;
            7:(*SEMICOLON*)SEMI:=TOK;
            9:(*VERTBAR  *)VBAR[2]:=TOK;
            10:(*PERCENT  *)PCT:=TOK;
            11:(*TOPBRACK *)BEGIN
             TBR[2]:=TOK;TBR[3]:=' '
            END;
            12:(*BOTBRACK *)BEGIN
             BBR[2]:=TOK;BBR[3]:=' '
            END;
            13:(*DIAGCOLS *)BEGIN;NUM(COLPP);
             IF COLPP>MAXCPP THEN BEGIN
 OUTP;WRITELN(OUTDIAG,' ***** DIAGCOLS VALUE EXCEEDS ',MAXCPP,
               ' EXPECT CRASH.')
             END;
            END;
            14:(*DIAGPAGEL*)NUM(DGMPL);
            (*DEEPEN THE LEVEL*)
             15:(*NODEWIDTH*)BEGIN;NUM(NODEWIDTH);
              IF NODEWIDTH>MAXNW THEN BEGIN
 OUTP;WRITELN(OUTDIAG,' ***** NODEWIDTH VALUE EXCEEDS ',MAXNW,
               ' EXPECT CRASH.')
              END
             END;
             16:(*PREFWIDTH*)BEGIN;NUM(PREWIDTH);
              IF PREWIDTH>MAXPW THEN BEGIN
               OUTP;WRITELN(OUTDIAG,' ***** PREWIDTH VALUE EXCEEDS ',MAXPW,
               ' EXPECT CRASH.')
              END
             END;
             (*DEEPEN IT*)
              17:(*ECHOPAGEL*)NUM(ECPL);
              18:(*LINESPHYS*)NUM(LPP);
             19:(*TOPMARGIN*)NUM(TOPM);
             20:(*LENLINOUT*)BEGIN;NUM(LLO);
              IF LLO>MAXLLO THEN BEGIN
 OUTP;WRITELN(OUTDIAG,' ***** LENLINOUT VALUE EXCEEDS ',MAXLLO,
               ' EXPECT CRASH.')
              END
             END;
            21:(*LENLININ *)BEGIN
             NUM(LLI);LLIM4:=LLI-4
            END;
            22:(*OTHERWISE*)BEGIN
             IF NSP=0 THEN BEGIN
              OUTP;WRITELN(OUTDIAG,' ***** KEYWORD UNKNOWN: ',WORD);
             END;
             I:=SUCC(LLI);HDRCARD:=FALSE
            END
           END(*CASE WORD*);
           I:=SUCC(I);
           IF (I>LLI) AND HDRCARD THEN INFILE(INCARD)
          END
          ELSE HDRCARD:=FALSE
         END
         ELSE BEGIN
          IF SRCFLAG THEN WRITELN(SRCPUNCH,INCARD);
          INFILE(INCARD);I:=SUCC(LLI);
          IF EOF(INFLE) THEN BEGIN
           HDRCARD:=FALSE; INCARD:=EWDL

          END
         END;
         NSP:=0
        END;
       END;
     END;
    PROCEDURE LATTACH(T,N:WPTRT);
     VAR SEARCHING,INWORD:BOOLEAN;
      I,J:INTEGER;TCH:CHAR;LPG:SPPTRT;
     (*ATTACH NODE IN LEXICAL TREE*)
      BEGIN
       SEARCHING:=TRUE;
       WHILE SEARCHING DO WITH T^ DO BEGIN
        INWORD:=TRUE;LPG:=SPADDR[ORD(SPN)];
        J:=1;I:=NDSOFF;
        WHILE INWORD DO BEGIN
         TCH:=LPG^.STRNG[I];
         IF TVAL[J]=TCH THEN BEGIN
          I:=SUCC(I);J:=SUCC(J);
          IF LPG^.STRNG[I]=PCT THEN I:=SUCC(I);
          IF TVAL[J]=PCT THEN J:=SUCC(J);
          IF J>ORD(N^.LV) THEN BEGIN
           (*END OF NEW NODE REACHED*)
           INWORD:=FALSE;
           IF I<NDSOFF+ORD(LV)-1 THEN BEGIN
            (*OLDER COMPARAND LONGER*)
            IF LLINK<>NIL THEN T:=LLINK ELSE BEGIN
             LLINK:=N;SEARCHING:=FALSE
            END
           END
           ELSE (*END OF BOTH NODES REACHED*)BEGIN
            (*INTO DISAMBIGUATION*)
             T^.LD:=CHR(SUCC(ORD(T^.LD)));
             IF ORD(N^.LV)<=LLOM4 THEN BEGIN
              DISAMNO:=SUCC(DISAMNO);
              (*SUPPLY THE CHARACTERS*)
               TVAL[ORD(N^.LV)+1]:=QOT;
               TVAL[ORD(N^.LV)+2]:=QOT;
               TVAL[ORD(N^.LV)+3]:=CSTR[(1+DISAMNO DIV 47)];
               TVAL[ORD(N^.LV)+4]:=CSTR[(1+DISAMNO MOD 47)];
              N^.LV:=CHR(ORD(N^.LV)+4)
             END
             ELSE BEGIN
              OUTP;WRITELN(OUTDIAG,' ***** NODE TOO BIG TO DISAMBIGUATE.')
             END;
            IF RLINK<>NIL THEN
             (*LET SEARCH GO ON -- NOT DONE YET*)T:=RLINK
            ELSE BEGIN
             RLINK:=N;SEARCHING:=FALSE
            END
           END
          END
          ELSE IF I>=NDSOFF+ORD(LV) THEN BEGIN
           INWORD:=FALSE;IF RLINK<>NIL THEN T:=RLINK ELSE BEGIN
            RLINK:=N;SEARCHING:=FALSE
           END
          END
         END
         ELSE IF TVAL[J]>TCH THEN BEGIN
          INWORD:=FALSE;
          IF RLINK=NIL THEN BEGIN
           RLINK:=N;SEARCHING:=FALSE
          END
          ELSE T:=RLINK
         END
         ELSE (*TVAL[J]<TCH THEN*) BEGIN
          (*EXTEND IT ONCE*)
           INWORD:=FALSE;
           IF LLINK=NIL THEN BEGIN
            LLINK:=N;SEARCHING:=FALSE
           END
           ELSE T:=LLINK
         END
        END
       END
      END (*LATTACH FUNCTION*);
    FUNCTION NLINES(T:WPTRT):INTEGER;
     VAR II,IS,IM,IL,I,LC,EL,ILC:INTEGER;TCH:CHAR;
      DIVIDING,DISAMB:BOOLEAN;LABEL 10;
     (*COUNT LINES FOR NODE IN OUTPUT FORM*)
      BEGIN
       DIVIDING:=TRUE;DISAMB:=FALSE;
       IF SRCFLAG THEN EL:=5+ORD(T^.LR)+ORD(T^.LI)
       ELSE EL:=3;
       IF ORD(T^.LR)=0 THEN LC:=0 ELSE LC:=1;
       IS:=0;II:=0;ILC:=LC;
       WHILE DIVIDING DO BEGIN
        IL:=0;IM:=NODEWIDTH+1;IF NOT DISAMB THEN LC:=SUCC(LC);
        IF ORD(T^.LV)-II<=NODEWIDTH THEN IM:=ORD(T^.LV)-II;
        IF IS+II+IM+EL>LLO THEN BEGIN
         OUTP;WRITELN(OUTDIAG,' ***** TOO MUCH LINE DIVISION',
          '.  NODE TRUNCATED.');
          DIVIDING:=FALSE
        END
        ELSE FOR I:=1 TO IM DO BEGIN
         II:=SUCC(II);TCH:=TVAL[II];
          CPAGE^.STRNG[LSP]:=TCH;LSP:=SUCC(LSP);
         (*QOT STARTS DISAMBIGUATION STRING*)
         IF TCH=QOT THEN BEGIN
          IL:=I;IF (I=1) AND (LC>ILC) THEN IF NOT DISAMB THEN
           LC:=PRED(LC);
          IF (ORD(T^.LV)-II)>8 THEN BEGIN OUTP; WRITELN(OUTDIAG,' ***** ',
           'OVERLONG DISAMBIGUATION; PROBABLE PUNCTUATION CONFLICT.') END;
          IF IM<>I THEN DISAMB:=TRUE;
         END
         (*PCT STARTS A NEW LINE IN OUTPUT FORM*)
         ELSE IF TCH=PCT THEN BEGIN
          IF I=1 THEN IF NOT DISAMB THEN BEGIN
           LC:=PRED(LC);IS:=PRED(IS);LSP:=PRED(LSP)
          END;
          GOTO 10
         END
         ELSE IF (TCH IN BREAKERS) THEN
          IF TCH IN PRES THEN BEGIN
           IF II>1 THEN IF NOT(TVAL[II-1] IN PRES) THEN IL:=I-1
          END
          ELSE IF TCH IN POSTS THEN BEGIN
           IF I<=NODEWIDTH THEN IL:=I
          END
          ELSE IF TCH IN INDIFFS THEN
           IF I<=NODEWIDTH THEN IL:=I
           ELSE IL:=NODEWIDTH
        END;
        IF (II>=ORD(T^.LV)) AND (IM<=NODEWIDTH) THEN DIVIDING:=FALSE
        ELSE BEGIN
         IF IL<>IM THEN IF (IL>0) THEN BEGIN
          II:=II-(IM-IL);LSP:=LSP-(IM-IL)
         END;
         IF IL=0 THEN BEGIN
          II:=PRED(II); LSP:=PRED(LSP)
         END;
         IF NOT DISAMB THEN BEGIN
          IS:=SUCC(IS);CPAGE^.STRNG[LSP]:=PCT;LSP:=SUCC(LSP);
          IF TCH=QOT THEN
           DISAMB:=TRUE
         END
        END;
       10:END;
       IF TVAL[II]<>PCT THEN BEGIN
        CPAGE^.STRNG[LSP]:=PCT;LSP:=SUCC(LSP);IS:=SUCC(IS)
       END;
       T^.LV:=CHR(II+IS);
       NLINES:=LC
      END (*NLINES FUNCTION*);
    FUNCTION WHFIND(RPTR:WPTRT):BOOLEAN;
     VAR RESULT,INWORD:BOOLEAN;
     I,J:INTEGER;TCH:CHAR;LPG:SPPTRT;
     BEGIN
      (*SEARCH TREE*)
       (*FIND WARNIER PARENT NODE IN EXISTING LEXICAL TREE*)
       RESULT:=FALSE;
       WHILE (RPTR<>NIL) AND (NOT RESULT) DO
       WITH RPTR^ DO BEGIN
        INWORD:=TRUE;LPG:=SPADDR[ORD(SPN)];
        J:=1;I:=NDSOFF;
        WHILE INWORD DO BEGIN
         TCH:=LPG^.STRNG[I];
         IF TVAL[J]=TCH THEN BEGIN
          I:=SUCC(I);J:=SUCC(J);
          IF LPG^.STRNG[I]=PCT THEN I:=SUCC(I);
          IF TVAL[J]=PCT THEN J:=SUCC(J);
          IF J>ORD(TWPTR^.LV) THEN BEGIN
           INWORD:=FALSE;
           IF I<ORD(LV)+NDSOFF THEN RPTR:=LLINK
           ELSE RESULT:=TRUE
          END
          ELSE IF I>=NDSOFF+ORD(LV) THEN BEGIN
           INWORD:=FALSE;RPTR:=RLINK
          END
         END
         ELSE IF TVAL[J]>TCH THEN BEGIN
          RPTR:=RLINK;INWORD:=FALSE
         END
         ELSE (*TVAL[J]<TCH*) BEGIN
          RPTR:=LLINK;INWORD:=FALSE
         END
        END
       END;
      IF RPTR=NIL THEN BEGIN
       (*FAILS IF NOT FOUND*)
        WRITELN(OUTDIAG,' ***** NOT FOUND IN PREVIOUS INPUT NODES');
       RESULT:=FALSE;OUTP
      END
      (*FAILS IF PARENT AMBIGUOUS*)
      (*OR IF ALREADY A PARENT*)
      ELSE WITH RPTR^ DO BEGIN
       IF ORD(LD)<>0 THEN BEGIN
        RESULT:=FALSE;
        OUTP;WRITELN(OUTDIAG,' ***** PARENT NODE IS AMBIGUOUS.')
       END;
       WLAST:=RPTR;
       IF NLVL<>NIL THEN BEGIN
        RESULT:=FALSE;
        OUTP;WRITELN(OUTDIAG,' ***** ALREADY A PARENT.')
       END;
       IF ORD(LVL)+1>GMXD THEN GMXD:=ORD(LVL)+1;
       IF GMXD>MAXDEPTH THEN BEGIN
        OUTP;WRITELN(OUTDIAG,' ***** MAXIMUM LOGICAL DEPTH EXCEEDED.');
        PRINTABLE:=FALSE
       END
      END;
      WHFIND:=RESULT
     END (*WHFIND FUNCTION*);
    FUNCTION PARSE(M:CHAR;T:WPTRT):INTEGER;
     VAR I,II,J,K,JL,RESULT:INTEGER;LABEL 10;
     (*PARSE NODES FROM INPUT STREAM*)
     BEGIN
      CASE M OF
       'H':BEGIN
        II:=2;T^.LP:=CHR(0);T^.LI:=CHR(0)
       END;
       'C':II:=1
      END;
      I:=1;J:=1;
      (*BLANKS*)
       WHILE(I<=LLI)AND((INCARD[I]=' ')OR(INCARD[I]=TAB))DO I:=SUCC(I);
       (*IF ALL BLANKS*)
        IF I>LLI THEN BEGIN
         OUTP;WRITELN(OUTDIAG,' ***** BLANK LINE ENCOUNTERED.');
         RESULT:=2;GOTO 10
        END;
      FOR K:=II TO 3 DO BEGIN
       JL:=MAXLEN[K]+1;
       WHILE (I<=LLI) AND (INCARD[I]<>COM) AND (INCARD[I]<>SEMI)
        AND (J<JL) DO BEGIN
         CASE K OF
          1:BEGIN
           TVAL[J]:=INCARD[I];TPRE[J]:=INCARD[I]
          END;
          2:TVAL[J]:=INCARD[I];
          3:CASE M OF
           'C':TINFX[J]:=INCARD[I];
           'H':TREP[J]:=INCARD[I]
          END
         END;
         I:=SUCC(I);J:=SUCC(J)
        END;
       IF (TVAL=EWDL) OR (TVAL=LCEWDL) THEN BEGIN
        RESULT:=1;GOTO 10
       END;
       IF I>LLI THEN BEGIN
        OUTP;WRITELN(OUTDIAG,' ***** PUNCTUATION MISSING.');
        RESULT:=2;GOTO 10
       END;
       IF J=JL THEN
        IF (INCARD[I]<>COM) AND (INCARD[I]<>SEMI) THEN BEGIN
         OUTP;WRITELN(OUTDIAG,' ***** COMMA ABSENT --OR--',
          ' FIELD TOO LONG. TRUNCATED.');
         WHILE (I<=LLIM4) AND (INCARD[I]<>COM)
         AND (INCARD[I]<>SEMI) DO BEGIN
          IF (M='C') THEN IF (K=1) THEN IF (J<=LLIM4) THEN BEGIN
           TVAL[J]:=INCARD[I];J:=SUCC(J)
          END;
          (*IDLE TO PUNCT*)
          I:=SUCC(I)
         END;
         IF (TVAL=EWDL) OR (TVAL=LCEWDL) THEN RESULT:=1 ELSE RESULT:=2;
         J:=JL; GOTO 10
        END;
       I:=SUCC(I);
       CASE K OF
        1:T^.LP:=CHR(J-1);
        2:BEGIN
         IF J=1+ORD(T^.LP) THEN BEGIN
          OUTP;WRITELN(OUTDIAG,' ***** INCORRECT LEADING COMMA --OR--',
           ' NULL NODE VALUE.  DISALLOWED.');
          RESULT:=2;GOTO 10
         END;
         T^.LV:=CHR(J-1);J:=1
        END;
        3:CASE M OF
         'H':T^.LR:=CHR(J-1);
         'C':T^.LI:=CHR(J-1)
        END
       END
      END;
      I:=PRED(I);
      CASE M OF
       'H':BEGIN
        IF INCARD[I]<>COM THEN BEGIN
         OUTP;WRITELN(OUTDIAG,' ***** COMMA MUST CLOSE PARENT.');
         RESULT:=2;GOTO 10
        END;
        RESULT:=0
       END;
       'C':BEGIN
        IF INCARD[I]=COM THEN RESULT:=3;
        IF INCARD[I]=SEMI THEN RESULT:=4
       END
      END;
      ;;
      (*CHECK NEXT CHARS*)
       FOR I:=SUCC(I) TO LENGTH(INCARD) DO BEGIN
        IF INCARD[I]<>' ' THEN BEGIN
         OUTP;WRITELN(OUTDIAG,' ***** EXTRA FIELD PRESENT.');
         GOTO 10
        END
       END;
     10:PARSE:=RESULT END(*PARSE FUNCTION*);
   PROCEDURE SRCOUT(PPTR:WPTRT);
    VAR TPTR:WPTRT;
    LPG:SPPTRT;
    OUTLINE:VMT;
    I,J,K:INTEGER;
    (*OUTPUT WARNIER SOURCE CODE*)
    BEGIN
     OUTLINE:=BLANKV;LPG:=SPADDR[ORD(PPTR^.SPN)];
     WITH PPTR^ DO
      IF INDFLAG AND(ORD(LV)+ORD(LR)+ORD(LVL)<=LLO)THEN BEGIN
       FOR I:=1 TO ORD(LVL) DO OUTLINE[I]:=ICH;
       I:=ORD(LVL)+1
      END
      ELSE I:=2;
     (*PREPARE PARENT NODE*)
      (*DO NODE VALUE*)K:=PPTR^.NDSOFF;
       FOR J:=1 TO ORD(PPTR^.LV) DO BEGIN
        OUTLINE[I]:=LPG^.STRNG[K];I:=SUCC(I);K:=SUCC(K)
       END;
      OUTLINE[I]:=COM;I:=SUCC(I);
      IF ORD(PPTR^.LR)<>0 THEN(*DO REPETITION FACTOR*)BEGIN
       K:=PPTR^.RPSOFF;
        LPG:=SPADDR[ORD(PPTR^.RSPN)];
       FOR J:=1 TO ORD(PPTR^.LR) DO BEGIN
        OUTLINE[I]:=LPG^.STRNG[K];I:=SUCC(I);K:=SUCC(K)
       END
      END;
     OUTLINE[I]:=COM;
     WRITELN(SRCPUNCH,OUTLINE:I);
     TPTR:=PPTR^.NLVL;
     (*OUTPUT THE CHILDREN*)
     WHILE TPTR<>NIL DO WITH TPTR^ DO BEGIN
      OUTLINE:=BLANKV;LPG:=SPADDR[ORD(SPN)];K:=NDSOFF;
      IF INDFLAG AND(ORD(LV)+ORD(LI)+ORD(LVL)+2<=LLO)THEN BEGIN
       FOR I:=1 TO ORD(LVL) DO OUTLINE[I]:=ICH;
       I:=ORD(LVL)+2
      END
      ELSE I:=3;
      (*PREPARE A CHILD NODE*)WITH LPG^ DO BEGIN
       FOR J:=1 TO ORD(LP) DO BEGIN
        OUTLINE[I]:=STRNG[K];I:=SUCC(I);K:=SUCC(K)
       END;
       OUTLINE[I]:=COM;I:=SUCC(I);
       FOR J:=ORD(LP)+1 TO ORD(LV) DO BEGIN
        OUTLINE[I]:=STRNG[K];
        I:=SUCC(I);K:=SUCC(K)
       END;
       OUTLINE[I]:=COM;I:=SUCC(I);
       FOR J:=1 TO ORD(LI) DO BEGIN
        OUTLINE[I]:=STRNG[K];
        I:=SUCC(I);K:=SUCC(K)
       END;
       IF NXT<>NIL THEN OUTLINE[I]:=COM
       ELSE OUTLINE[I]:=SEMI;
      END;
      WRITELN(SRCPUNCH,OUTLINE:I);TPTR:=NXT
     END;
     TPTR:=PPTR^.NLVL;
     (*DO RECURSION*)
     WHILE TPTR<>NIL DO WITH TPTR^ DO BEGIN
      IF NLVL<>NIL THEN SRCOUT(TPTR);
      TPTR:=NXT
     END
    END;(*PROCEDURE SRCOUT*)
   PROCEDURE PLIOUT(TPTR:WPTRT);
    VAR CALLEDDOWN:BOOLEAN;LPG:SPPTRT;
     IS,II,I,J,K,KK:INTEGER;T:VMT;LABEL 10;
    BEGIN
     (*OUTPUT TARGET LANGUAGE SOURCE CODE*)
     T:=BLANKV;
     REPEAT
      WITH TPTR^ DO BEGIN
       II:=SUCC(ORD(LP));KK:=0;
       IF INDFLAG THEN
        IF ORD(LV)-ORD(LP)+ORD(LVL)+1<=LLO
        THEN BEGIN
         IS:=ORD(LP)-ORD(LVL);KK:=ORD(LVL);
         FOR J:=2 TO ORD(LVL)+1 DO T[J]:=ICH
        END
        ELSE IS:=ORD(LP)-1
       ELSE IS:=ORD(LP);
       CALLEDDOWN:=FALSE;
       LPG:=SPADDR[ORD(SPN)];K:=NDSOFF+ORD(LP);
       WITH LPG^ DO REPEAT
        FOR I:=II TO ORD(LV) DO BEGIN
         IF STRNG[K]=PCT THEN BEGIN
          T[I-IS]:=' ';IS:=SUCC(IS);
          IF STRNG[K+1]='-' THEN
          IF STRNG[K+2]='-' THEN
          IF STRNG[K+3]='-' THEN
          IF STRNG[K+4]=PCT THEN BEGIN
           IF CALLEDDOWN THEN BEGIN
            OUTP;WRITELN(OUTDIAG,' ***** ONLY ONE ',
             '%---% ALLOWED; FRAGMENT IS:%---%',T:I-II+KK+1,'%---% . . .');
            II:=ORD(LV);GOTO 10
           END;
           IF INDFLAG THEN IF T[2]<>ICH THEN
            IF I-IS+ORD(LVL)<LLO THEN BEGIN
             FOR J:=I-IS DOWNTO 2 DO T[J+ORD(LVL)-1]:=T[J];
             FOR J:=ORD(LVL) DOWNTO 2 DO T[J]:=ICH;
             IS:=IS-ORD(LVL)
            END;
           WRITELN(PLIPUNCH,COPY(T,1,I-IS));
           (* RECURSIVE CALL *)
           IF NLVL<>NIL THEN PLIOUT(NLVL)
           ELSE
            IF K-NDSOFF+4<=ORD(LV) THEN BEGIN
             OUTP;WRITELN(OUTDIAG,' ***** CHILDLESS %---% APPEARS: ',
             T:I-II+KK+1,'%---% . . .')
            END;
           II:=I+5;K:=K+5;
           T:=BLANKV;CALLEDDOWN:=TRUE;
           IF INDFLAG THEN BEGIN
            IS:=II-1-ORD(LVL);
            FOR J:=2 TO ORD(LVL)+1 DO T[J]:=ICH
           END ELSE IS:=II-1;
           GOTO 10
          END
         END
         ELSE IF STRNG[K]=QOT THEN BEGIN
          IS:=IS+ORD(LV)-I+1;
          II:=ORD(LV);GOTO 10
         END
         ELSE T[I-IS]:=STRNG[K];
         K:=SUCC(K)
        END (*FOR I LOOP*);
        II:=ORD(LV);
       10:UNTIL II>=ORD(LV);
       WRITELN(PLIPUNCH,COPY(T,1,II-IS));
       (*RECURSIVE CALL*)
       IF (NOT CALLEDDOWN) AND (NLVL<>NIL) THEN PLIOUT(NLVL)
      END (*WITH TPTR^*);
      T:=BLANKV;
      TPTR:=TPTR^.NXT
     UNTIL TPTR=NIL
    END (*PLIOUT PROCEDURE*);
   (*LOGICAL LAYOUT PHASE ROUTINES*)
    FUNCTION LAYOUT(TPTR:WPTRT):INTEGER;
     VAR K,L,LMXD,M,MM,A:BYTE;
      SPT,N,I,LST,LMXH,NN,W:INTEGER;
     MPTR:WPTRT;QP:QPTRT;
     PROCEDURE ADJSTS(N:INTEGER;TPTR:WPTRT);
      VAR I:0..MAXDEPTH;
      (*ADJUSTS START BY N FOR TPTR'S SUBTREE*)
      BEGIN
       I:=ORD(TPTR^.LVL);
       REPEAT
        WITH TPTR^ DO BEGIN
         ST:=ST+N;LS:=LS+N;MXM:=MXM+N;
         IF NLVL<>NIL THEN ADJSTS(N,NLVL);
         TPTR:=NXT
        END(*WITH TPTR^*);
        IF TPTR<>NIL THEN IF TPTR^.ST=0 THEN TPTR:=NIL
       UNTIL TPTR=NIL;
       (*LEAVE A TRAIL AT AFFECTED LEVELS*)
       IF TOTWIDTH[I]>0 THEN
        TOTWIDTH[I]:=-TOTWIDTH[I]
      END (*ADJSTS PROCEDURE*);
     FUNCTION LIMMOVE(TPTR:WPTRT;VAR CTRL:INTEGER;N:INTEGER):INTEGER;
      VAR DWNL,RESULT:INTEGER;
      BEGIN
       IF ORD(TPTR^.LVL)>=CTRL THEN RESULT:=TPTR^.MXM ELSE RESULT:=32767;
        IF ORD(TPTR^.LVL)>CTRL THEN CTRL:=SUCC(CTRL);
       WHILE TPTR<>NIL DO BEGIN
        IF (ORD(TPTR^.LD)>CTRL) AND (ORD(TPTR^.LVL)<N) THEN BEGIN
         DWNL:=LIMMOVE(TPTR^.NLVL,CTRL,N);
         IF DWNL<RESULT THEN RESULT:=DWNL
        END;
        TPTR:=TPTR^.NXT
       END;
       LIMMOVE:=RESULT;
      END (*LIMMOVE FUNCTION*);
     PROCEDURE ENQ(T:WPTRT);
      VAR LPTR,TPTR,QP:QPTRT;
      (*ENQUEUE PAGE CANDIDATE IN PAGE PRIORITY QUEUE*)
       BEGIN
        IF NDDN+4>DDSTL THEN BEGIN
         OUTP;WRITELN(OUTDIAG,
          ' ***** DEWEY DECIMAL STRING LENGTH EXCEEDED ',
           DDSTL,'. ABORTING.');HALT
        END;
        (*NEW QUEUE ELEMENT*)
         IF QLTOP<>NIL THEN BEGIN
          QP:=QLTOP;QLTOP:=QP^.NEXTQ
         END ELSE NEW(QP);
         NQ:=SUCC(NQ);
          WITH QP^ DO BEGIN
           SPPTR:=T^.NLVL;
           WITH SPPTR^ DO BEGIN
            NXTH:=NXT;NDSOFFH:=NDSOFF;SPNH:=SPN;NLVLH:=NLVL;
            LRH:=LR;LIH:=LI;LPH:=LP;LPNH:=LPN;LVH:=LV;
            (*3 ONLY TENTATIVE*)
            STSH:=ST;LSPH:=T^.LS;STPH:=T^.ST;LDPH:=T^.LD
           END;
           PRTY:=W;DDNSTR:=DDN;DDL:=CHR(NDDN)
          END(*WITH QP^*);
        QP^.DDNSTR[NDDN+2]:='-';
        QP^.DDNSTR[NDDN+3]:=CPN[2];QP^.DDNSTR[NDDN+4]:=CPN[3];
        IF NQ=1 THEN BEGIN QH:=QP;QR:=QP;
        QP^.NEXTQ:=NIL;QP^.LASTQ:=NIL;END
        ELSE BEGIN
         IF QP^.PRTY>=QH^.PRTY THEN BEGIN
          QP^.NEXTQ:=QH;QH^.LASTQ:=QP;QH:=QP
         END
         ELSE IF QP^.PRTY<=QR^.PRTY THEN BEGIN
          QP^.NEXTQ:=NIL;QP^.LASTQ:=QR;QR^.NEXTQ:=QP;QR:=QP
         END
         ELSE
          BEGIN
           TPTR:=QH;
           WHILE TPTR^.PRTY>QP^.PRTY DO BEGIN
            (*FIND WHERE*)
            LPTR:=TPTR;TPTR:=TPTR^.NEXTQ
           END;
           (*INSERT*)
           LPTR^.NEXTQ:=QP;QP^.LASTQ:=LPTR;TPTR^.LASTQ:=QP;QP^.NEXTQ:=TPTR
          END;
         (*KEEP QUEUE DOWN TO NQLIM SIZE*)
         IF NQ>NQLIM THEN BEGIN
          NQ:=PRED(NQ);LPTR:=QR;QR:=QR^.LASTQ;QR^.NEXTQ:=NIL;
          LPTR^.NEXTQ:=QLTOP;QLTOP:=LPTR
         END
        END
       END (* PROCEDURE ENQ*);
     (*LAYOUT THE WHOLE WARNIER DIAGRAM*)
      BEGIN
       (*INITIALIZATIONS*)
        (*MAX DEPTH*)
         LMXD:=ORD(TPTR^.LVL);
         M:=LMXD;
        (*MAX WIDTH*)
         LMXH:=TOTWIDTH[LMXD];
        K:=0;MAXM[M]:=0;
        (*START POINTS*)
         SPT:=LMXH+2;LST:=SPT;
        TOTWIDTH[LMXD]:=SUCC(LMXH); L:=NDDN;
       (*EXTENTS IN (LMXD,GMXD),(LMXH,GMXH),(LST,GST)*)
       (*LOCAL/GLOBAL*)
       (*SWEEP THE BROTHERS*)
        REPEAT
         WITH TPTR^ DO BEGIN
          (*INITIALIZE GLOBALS, THIS LEVEL*)
          GMXD:=M;
          ST:=TOTWIDTH[GMXD]+2;GST:=ST;
          GMXH:=ST+ORD(LPN);K:=SUCC(K);
          TOTWIDTH[GMXD]:=GMXH;
          IF NLVL<>NIL THEN BEGIN
           MM:=K;DDN[L+1]:='.';NDDN:=L+2;
            IF MM>=10 THEN BEGIN
             DDN[NDDN]:=CHR(ORD(REGZERO)+MM DIV 10);
             NDDN:=NDDN+1;MM:=MM MOD 10
            END;
            DDN[NDDN]:=CHR(ORD(SUPERZERO)+MM);
           (*RECURSIVE CALL*)
            I:=LAYOUT(NLVL);
           (*I IS CENTER OF CHILDREN AS LAID OUT*)
           N:=ST+ORD(LPN) DIV 2;
           IF I<>N THEN BEGIN
            (*MOVE PIECES*)
            IF I>N THEN BEGIN
             NN:=I-N;ST:=ST+NN;
              TOTWIDTH[M]:=TOTWIDTH[M]+NN;
             IF K=1 THEN BEGIN
              (*JUST ONE NODE TO MOVE*)
               MAXM[M]:=NN;
               MXM:=NN;LST:=LST+NN;SPT:=SPT+NN;
             END
             ELSE BEGIN
              MM:=M;MPTR:=TPTR;
              (*HOW MUCH CAN WE MOVE DOWN*)
               FOR A:=PRED(K) DOWNTO 1 DO BEGIN
                MPTR:=MPTR^.BCK;
                 IF ORD(MPTR^.LD)>MM THEN MM:=ORD(MPTR^.LD);
               END;
              (*MM HAS DEEPEST LEVEL OF LEAF IN PART TO MOVE*)
              CTRL:=M+1;
              IF MM>=CTRL THEN W:=LIMMOVE(NLVL,CTRL,MM) ELSE W:=NN;
              IF W<NN THEN NN:=W;
              IF NN>0 THEN BEGIN
               (*RAZZLE DAZZLE ADJSTS WITH 0 ST VALUE*)
                W:=ST;ST:=0;ADJSTS(NN,MPTR);ST:=W;A:=M;
                 LST:=LST+NN;SPT:=SPT+NN;
               (*RESTORE AFTER ADJSTS*)
               REPEAT
                IF TOTWIDTH[A]<-1 THEN
                 TOTWIDTH[A]:=-TOTWIDTH[A];
                MAXM[A]:=MAXM[A]+NN;
                A:=SUCC(A);
               UNTIL TOTWIDTH[A]>=-1
              END;
             END
            END
            ELSE BEGIN
             ADJSTS(N-I,NLVL);
             A:=M;
             (*RESTORE MARKED LEVELS AFTER ADJSTS*)
             REPEAT
              IF TOTWIDTH[A]<-1 THEN TOTWIDTH[A]:=N-I-TOTWIDTH[A];
              A:=SUCC(A);
             UNTIL TOTWIDTH[A]>=-1;
             GMXH:=GMXH+N-I;GST:=GST+N-I
            END
           END
          END;
          LD:=CHR(GMXD);MXM:=MAXM[M];
          (*UPDATE EXTENTS*)
           IF TOTWIDTH[M]>GMXH THEN GMXH:=TOTWIDTH[M];
           IF GST<LST THEN LST:=GST;
           IF GMXH>LMXH THEN LMXH:=GMXH;
           IF GMXD>LMXD THEN LMXD:=GMXD;
          LS:=GST;W:=GMXH-GST+1;A:=GMXD-M+1;
          IF (M<GMXD) AND (M>1) AND (W>=10) AND (W<=DGMPL) AND (A<=COLPP)
           THEN BEGIN
            (*PAGES NON-TRIVIAL AND FIT IN DIAGRAMPAGE*)
            W:=GMXD*W;
            IF NQ<NQLIM THEN ENQ(TPTR)
            ELSE IF W>QR^.PRTY THEN ENQ(TPTR)
           END
         END (*WITH TPTR^*);
         MPTR:=TPTR;TPTR:=TPTR^.NXT
        UNTIL TPTR=NIL;
       (*FINISH THE RECURSIVE LEVEL*)
        FOR K:=L+1 TO NDDN DO DDN[K]:=' ';
        IF SPT+3=TOTWIDTH[M] THEN BEGIN
         MPTR^.LPN:=CHR(3);
         TOTWIDTH[M]:=SUCC(TOTWIDTH[M]);
         IF TOTWIDTH[M]>LMXH THEN LMXH:=TOTWIDTH[M]
        END;
        NDDN:=L;GMXD:=LMXD;GMXH:=LMXH;GST:=LST;
        (*RETURN THE CENTER OF THE SUBTREE*)
         LAYOUT:=(TOTWIDTH[M]+SPT) DIV 2
      END (*LAYOUT FUNCTION*);
    PROCEDURE DOPAGES;
     (*DOPAGE DECLARES*)
      VAR PLTT,PLT,HQH,TPTR,LPTR:QPTRT;
      PSNODE:WPTRT;I,J:BYTE;M:INTEGER;LABEL 10,11,12;
     (*SELECT HIGH PRIORITY NON-OVERLAPPING PAGES FROM CANDIDATES*)
     BEGIN
      IF NQ>2 THEN BEGIN
       NQLIM:=NQ;
       HQH:=QH;
       (*SEARCH FOR & REMOVE CONTAINED SUBPAGES*)
       REPEAT
        PLTT:=QH;
        PLT:=QH^.NEXTQ;
        10:WHILE(PLTT<>QR)AND (PLT<>NIL)DO
         IF ORD(QH^.DDL)<ORD(PLT^.DDL) THEN BEGIN
          FOR I:=1 TO ORD(QH^.DDL) DO
          IF QH^.DDNSTR[I]<>PLT^.DDNSTR[I] THEN BEGIN
           (*A NOT-NESTED PAGE CANDIDATE*)
           PLTT:=PLT;PLT:=PLT^.NEXTQ;GOTO 10
          END;
          (*ELIMINATE IDENTIFIED NESTED CANDIDATE*)
           NQ:=PRED(NQ);PLTT^.NEXTQ:=PLT^.NEXTQ;
           IF QR=PLT THEN QR:=PLTT;
           PLT^.NEXTQ:=QLTOP;QLTOP:=PLT;PLT:=PLTT^.NEXTQ
         END
         ELSE BEGIN
          PLTT:=PLT;PLT:=PLT^.NEXTQ
         END;
        (*ALL NESTED IN THIS NOW GONE*)
        QH:=QH^.NEXTQ
       UNTIL(QR=QH)OR (QH=NIL);
       QH:=HQH;
       (*HOW MANY TO KEEP*)
       IF NQ<=2 THEN NQ:=1
       ELSE BEGIN
        IF NQLIM DIV 3<NQ THEN NQ:=NQLIM DIV 3;
        (*CALCULATE PRIORITY THRESHHOLD*)
         IF PASSCNT=1 THEN
          M:=(QH^.PRTY+QR^.PRTY+QR^.PRTY) DIV 3
         ELSE
          M:=(QH^.PRTY+QH^.PRTY+QR^.PRTY) DIV 3;
        J:=0;
        12: IF QH<>NIL THEN
         IF QH^.PRTY>=M THEN BEGIN
          (*COUNT NUMBER ABOVE THRESHHOLD*)
           J:=SUCC(J);QH:=QH^.NEXTQ;GOTO 12
         END;
        (*NEW NUMBER, MAYBE*)
         IF PASSCNT<NQLIM THEN IF(J>NQ)AND (J<>NQLIM)THEN NQ:=J;
          IF PASSCNT>=NQLIM THEN NQ:=J
       END;
       IF NQ>LASTNQ THEN NQ:=LASTNQ;
       LASTNQ:=NQ;
       QH:=HQH
      END
      ELSE NQ:=1;
      (*CONVERT NQ CANDIDATES TO PAGES*)
      FOR I:=1 TO NQ DO BEGIN
       (*SUBSTITUTE PAGE TOKENS FOR ACCEPTED SUBPAGES*)
        PSNODE:=QH^.SPPTR;
        WITH PSNODE^ DO BEGIN
         NDSOFF:=FRPTR^.NDSOFF;SPN:=CHR(1);
         (*IF ADJSTS'D SINCE CANDIDATE CAPTURE*)
          QH^.LSPH:=BCK^.LS;QH^.STPH:=BCK^.ST;
          QH^.STSH:=ST;
          (*CLEAR A SUBPAGE TOKEN*)
           LPN:=FRPTR^.LPN;LV:=FRPTR^.LV;ST:=0;LR:=CHR(0);
           LS:=0;LD:=CHR(0);LP:=CHR(0);LI:=CHR(0);
           SUBPAGE:=QH;NXT:=NIL;NLVL:=NIL
        END;
       LPCNT:=SUCC(LPCNT);NCT:=SUCC(NCT);HQH:=QH^.NEXTQ;
       (*PUT PAGES IN DEWEY DECIMAL ORDER==>DEPTH FIRST FINAL OUTPUT*)
       IF FPORD=NIL THEN BEGIN
        FPORD:=QH;QH^.NEXTQ:=NIL
       END
       ELSE IF QH^.DDNSTR<FPORD^.DDNSTR THEN BEGIN
        QH^.NEXTQ:=FPORD;FPORD:=QH
       END
       ELSE BEGIN
        TPTR:=FPORD;
        (*FIND INS'N POINT*)
         11:LPTR:=TPTR;TPTR:=LPTR^.NEXTQ;
         IF TPTR<>NIL THEN IF QH^.DDNSTR>=TPTR^.DDNSTR THEN GOTO 11;
        LPTR^.NEXTQ:=QH;QH^.NEXTQ:=TPTR
       END;
       QH:=HQH
      END;
      (*FREE ANY EXCESS CANDIDATES*)
      WHILE QH<>NIL DO BEGIN
       HQH:=QH;QH:=QH^.NEXTQ;HQH^.NEXTQ:=QLTOP;QLTOP:=HQH
      END
     END(*DOPAGES PROCEDURE*);
   (*PHYSICAL OUTPUT PHASE ROUTINES*)
    PROCEDURE LINLINK(T:WPTRT;N:INTEGER);
     VAR M:INTEGER;
     P:LPTRT;
     (*FORM LINKS ACROSS COUSIN CHASMS*)
     BEGIN
      M:=ORD(T^.LVL)-N;
      IF LOTOP<>NIL THEN BEGIN
       P:=LOTOP;LOTOP:=P^.NXTSC;
      END ELSE NEW(P);
      WITH P^ DO BEGIN
       WPTR:=T;NXTSC:=NIL;STARTP:=T^.ST-1;LASTP:=0
      END;
      IF START[M]=NIL THEN
       START[M]:=P
      ELSE
       REAR[M]^.NXTSC:=P;
      REAR[M]:=P;
      WHILE T<>NIL DO
       WITH T^ DO BEGIN
        (*RECURSIVE CALL*)
        IF(M<COLPP)AND (NLVL<>NIL) THEN LINLINK(NLVL,N);
        REAR[M]^.LASTP:=ST+ORD(LPN);T:=NXT
       END
     END (*LINLINK PROCEDURE*);
    PROCEDURE OUTPAGE(LPTR:WPTRT);
     VAR
      PIECE:STRING[MAXNW];

        ACTCOLS:STRING[MAXCPP];

      HLP,TLP:LPTRT;T:WPTRT;
       COL,LINENO,I,II,J,MAXAC,NMAC:INTEGER;CPN:THREEDIG;
        PREF,PREBL:STRING[MAXPW];

      LABEL 10;
     PROCEDURE NPHAND;
      VAR I,J:INTEGER;
      LPG:SPPTRT;TCH:CHAR;
      PROCEDURE ENDNODE;
       VAR DISFLAG:BOOLEAN;
       (*MOVE TO NEXT NODE WHEN OLD OUTPUT*)
       BEGIN
        WITH T^ DO BEGIN
         IF NXT<>NIL THEN BEGIN
          (*STEP COLUMN CONTROLS*)
          START[COL]^.WPTR:=NXT;
          NXT^.LO:=NXT^.LP;NNE[COL]:=NXT^.ST
         END;
         DISFLAG:=NLVL=NIL;
         IF NOT DISFLAG THEN DISFLAG:=NLVL^.SUBPAGE=NIL;
         IF DISFLAG AND(SUBPAGE=NIL) THEN BEGIN
          (*KEEP PARENTS OF SUBPAGES AND SUBPAGES, ELSE DISPOSE*)
          IF BCK<>NIL THEN IF BCK^.LVL=LVL THEN BCK^.NXT:=NIL
          ELSE BCK^.NLVL:=NIL;
          IF NLVL<>NIL THEN NLVL^.BCK:=NIL;
          IF NXT<>NIL THEN NXT^.BCK:=NIL;
          NXT:=WNTOP;WNTOP:=T
         END
        END
       END(*ENDNODE PROCEDURE*);
      (*NODE PIECE HANDLER*)
      BEGIN
       T:=START[COL]^.WPTR;
        PIECE:=BLNW;LPG:=SPADDR[ORD(T^.SPN)];
       IF NNE[COL]>LINENO THEN BEGIN
        IF COL<MAXAC THEN WRITE(OUTFLE,' ':NODEWPPW)
       END
       ELSE WITH T^ DO CASE NP[COL] OF
        (*CONSUME PIECE OF A NODE*)
        0:BEGIN
         IF SUBPAGE<>NIL THEN BEGIN
          (*PLANT BACK REFERENCE*)
           SUBPAGE^.PRTY:=PCNT;
          (*PUT PAGE NO IN FORWARDREF.*)
           CONVERT(ORD(SUBPAGE^.DDL),CPN);
            LPG^.STRNG[NDSOFF+10+FROFF]:=CPN[1];
             LPG^.STRNG[NDSOFF+11+FROFF]:=CPN[2];
             LPG^.STRNG[NDSOFF+12+FROFF]:=CPN[3]
         END;
         (*SCHEDULE BACK REF.*)
          IF COL=1 THEN IF PCNT>1 THEN IF LO>=LV THEN
           IF NBE[1]=START[1]^.LASTP THEN BEGIN
 LV:=BRPTR^.LV;LO:=CHR(0);NDSOFF:=1;LPG:=SPADDR[1];LPN:=BRPTR^.LPN;
             SPN:=CHR(1);BP[1]:=2;NBE[1]:=ORD(LPN)+LINENO;LR:=LO;LI:=LO
           END;
         PREF:=PREBL;
         IF LO<LV THEN BEGIN
          I:=0;TCH:=LPG^.STRNG[NDSOFF+I+ORD(LO)];
           WHILE NOT ((TCH=PCT) OR (TCH=QOT)) DO BEGIN
            I:=SUCC(I);PIECE[I]:=TCH;
            TCH:=LPG^.STRNG[NDSOFF+I+ORD(LO)]
           END;
          IF TCH=QOT THEN LO:=LV
          ELSE LO:=CHR(ORD(LO)+SUCC(I));
          J:=I;
           FOR I:=1 TO ORD(LP) DO PREF[I]:=LPG^.STRNG[NDSOFF+I-1];
         END
         ELSE BEGIN
          J:=1;
          IF ORD(LR)>0 THEN BEGIN
           LPG:=SPADDR[ORD(RSPN)];
           J:=ORD(LR);
           FOR I:=1 TO ORD(LR) DO PIECE[I]:=LPG^.STRNG[RPSOFF-1+I];
           LR:=CHR(0)
          END;
          IF ORD(LI)=0 THEN BEGIN
           IF LINENO>=ORD(ST)+ORD(LPN) THEN ENDNODE
          END
          ELSE BEGIN
           NP[COL]:=1;
           (*SCHEDULE INFIX PLACEMENT*)
            IF NXT<>NIL THEN NNE[COL]:=(ST+ORD(LPN)+NXT^.ST-1) DIV 2
          END;
         END;
         IF COL<MAXAC THEN WRITE(OUTFLE,PREF:PREWIDTH,PIECE:NODEWIDTH)
 ELSE WRITE(OUTFLE,PREF:PREWIDTH,COPY(PIECE,1,J))
        END;
        (*NODE EXHAUSTED -- AWAIT INFIX -- CLOSE NODE OUT*)
        1:BEGIN
         NP[COL]:=0;
         FOR I:=1 TO ORD(LI) DO
          PIECE[I]:=LPG^.STRNG[NDSOFF-1+I+ORD(LV)];
         IF COL<MAXAC THEN WRITE(OUTFLE,' ':PREWIDTH,PIECE:NODEWIDTH)
         ELSE WRITE(OUTFLE,' ':PREWIDTH,
          COPY(PIECE,1,ORD(LI)));
         ENDNODE
        END
       END(* CASE NP*)
      END;(*NPHAND INTERNAL PROCEDURE*)
     (*OUTPUT A PAGE OF WARNIER DIAGRAM*)
     BEGIN
      PCNT:=SUCC(PCNT);
      LINENO:=LPTR^.LS;
       IF LPTR^.LS=LPTR^.ST THEN LINENO:=PRED(LINENO);
      PREF:='';FOR I:=1 TO PREWIDTH DO PREF:=PREF+' ';
       PREBL:=PREF;
      (*CONVERT SUPER NUMERALS TO REGULAR NUMERALS*)
       FOR I:= 1 TO 105-TITLEN DO
        IF (PDN[I]<=SUPERNINE) AND (PDN[I]>=SUPERZERO) THEN
         PDN[I]:=CHR(NMDEL+ORD(PDN[I]));
      WRITE(OUTFLE,PEJ,COPY(TITLE,1,TITLEN),
       COPY(PDN,1,105-TITLEN),HDRPC,PCNT:3);
      IF GMXD>COLPP THEN BEGIN
       GMXD:=COLPP;WRITELN(OUTFLE);
        WRITE(OUTFLE,' ***** COLUMNS PAST COLUMN',COLPP:3,
         ' DELETED DUE TO PAGE FAILURE.')
      END;
      (*INITIALIZE COLUMN STATES*)
      FOR COL:=1 TO GMXD DO
       WITH START[COL]^ DO BEGIN
        NBE[COL]:=STARTP;NNE[COL]:=WPTR^.ST;
        IF LINENO=STARTP THEN BEGIN
         ACTCOLS[COL]:='1';
         MAXAC:=COL;
        END
        ELSE ACTCOLS[COL]:='0';
        WPTR^.LO:=WPTR^.LP
       END;
      NMAC:=0;
      REPEAT
       COL:=1;WRITELN(OUTFLE);I:=NODEWPPW;
       IF NMAC>MAXAC THEN MAXAC:=NMAC;
       NMAC:=0;
       REPEAT
        IF START[COL]<>NIL THEN BEGIN
         WITH START[COL]^ DO IF STARTP<=LINENO THEN BEGIN
          (*NODE IN PROGRESS*)
          J:=BP[COL];
          IF J<3 THEN BEGIN
           IF NBE[COL]=LINENO THEN BEGIN
            IF COL>1 THEN CASE J OF
             0:WRITE(OUTFLE,TBR);
             1:WRITE(OUTFLE,'<  ');
             2:WRITE(OUTFLE,BBR)
            END;
            CASE J OF
             0:BEGIN
              NBE[COL]:=(STARTP+LASTP)DIV 2;
              NMAC:=COL;
             END;
             1:BEGIN
              NBE[COL]:=LASTP;
              NMAC:=COL;
             END;
             2:BEGIN
              ACTCOLS[COL]:='0';MAXAC:=0;II:=GMXD;
              WHILE (MAXAC=0) AND (II>0) DO BEGIN
               IF ACTCOLS[II]='1' THEN MAXAC:=II;
               II:=PRED(II)
              END
             END
            END;
            BP[COL]:=SUCC(J);
           END
           ELSE IF COL>1 THEN WRITE(OUTFLE,VBAR:3);
           NPHAND
          END
          (*NODEFINISHED*)
          ELSE BEGIN
           (*STEP TO NEXT COUSINS*)
            IF COL<MAXAC THEN WRITE(OUTFLE,' ':I);
            (*MOVE,DISPOSE*)
             TLP:=NXTSC;HLP:=START[COL];START[COL]:=TLP;
             HLP^.NXTSC:=LOTOP;LOTOP:=HLP;
            BP[COL]:=0;NP[COL]:=0;
           IF TLP<>NIL THEN BEGIN
            NBE[COL]:=TLP^.STARTP;
            WITH TLP^.WPTR^ DO BEGIN
             LO:=LP;NNE[COL]:=ST
            END
           END;
           10:IF GMXD>0 THEN IF START[GMXD]=NIL THEN
            (*DECREMENT ACTIVE COLUMN NUMBERS*)
            BEGIN
             GMXD:=PRED(GMXD);GOTO 10
            END
          END
         END
         ELSE IF COL<MAXAC THEN WRITE(OUTFLE,' ':I);
         IF START[COL]<>NIL THEN
         IF START[COL]^.STARTP=LINENO+1 THEN BEGIN
          ACTCOLS[COL]:='1';
          NMAC:=COL
         END
        END
        ELSE
         IF COL<MAXAC THEN WRITE(OUTFLE,' ':I);
        COL:=SUCC(COL);I:=NODEWPP3
       UNTIL COL>GMXD;
       LINENO:=SUCC(LINENO)
      UNTIL GMXD=0;
      WRITELN(OUTFLE);
      J:=(TOPM+LINENO-LPTR^.LS-1) MOD LPP;
      IF J<LPP-TOPM-4 THEN BEGIN
       (*OUTPUT COPYRIGHT NOTICE IF ROOM ON PAGE*)
        WRITELN(OUTFLE,CN1);WRITELN(OUTFLE,CN2);WRITELN(OUTFLE,CN3)
      END;
     END(*OUTPAGE PROCEDURE*);
  (*MAIN ROUTINE*)
   BEGIN
    INITIALIZE;
     (*UC LC DELTAS*)
      SUPERZERO:=CHR(ORD(REGZERO)-NMDEL);
       SUPERNINE:=CHR(ORD(SUPERZERO)+9);
      CHDEL:=ORD(CAPA)-ORD(SMALLA);
    WNTOP:=NIL;LOTOP:=NIL;QLTOP:=NIL;
    TAB:=CHR(9);
    (*SET,STRING INITS*)
     (*CONSTRUCT LONG CONSTANTS*)
      FOR I:=1 TO 24 DO BEGIN
       EWDL[I]:=EWD[I];
       LCEWDL[I]:=LCEWD[I];
       TITLE[I]:=NOTITLE[I];
       BLANKV[I]:=' '
      END;
      TITLEN:=25;
      FOR I:=25 TO MAXLLO DO BEGIN
       EWDL[I]:=' ';TITLE[I]:=' ';LCEWDL[I]:=' ';
       BLANKV[I]:=' '
      END;
    COLPP:=6;DGMPL:=128;NODEWIDTH:=16;PREWIDTH:=3;LNOEC:=3;
    ECPL:=60;LPP:=66;TOPM:=3;LLO:=80;LLI:=80;LLIM4:=76;
    (*ESTABLISH FILES*)
     ASSIGN(INFLE,'INPUT.WAR');
     ASSIGN(OUTFLE,'OUTPUT.DIA');
      ASSIGN(PLIPUNCH,'OUTPUT.PUN');
      ASSIGN(OUTDIAG,'OUTPUT.ECH');
      ASSIGN(SRCPUNCH,'OUTPUT.SRC');
       RESET(INFLE);REWRITE(OUTFLE);
       REWRITE(OUTDIAG);REWRITE(SRCPUNCH);REWRITE(PLIPUNCH);
    FOR I:=1 TO MAXCPP DO BEGIN
     START[I]:=NIL;
     BP[I]:=0;NP[I]:=0;NBE[I]:=0;NNE[I]:=0
    END;
    PLIFLAG:=FALSE;INDFLAG:=FALSE;SRCFLAG:=FALSE;
    (*DO DATESTUFF*)
     D:=DATE;
     FOR I:=1 TO 8 DO HDRPC[I+11]:=D[I];
    FOR I:=1 TO NBRSTRPGS DO SPADDR[I]:=NIL;
    INFILE(INCARD);
    WHILE NOT EOF(INFLE) DO BEGIN
     (*INIT FOR DIAGRAM*)
      OUTP;WRITELN(OUTDIAG,' RUN STARTED AT   ',CLOCK);
      HEADERS;
      PRES:=['(','<','{','['];
       POSTS:=[' ',';',':',')','>',PCT,'}',']'];
        INDIFFS:=['_','.',COM,',','&','=','+','-','*','/','^','\'];
      BREAKERS:=PRES+POSTS+INDIFFS;
      GMXD:=2;H:=NIL;NCT:=1;PCNT:=0;LPCNT:=1;FPORD:=NIL;DISAMNO:=0;
      LASTNQ:=100;
      (*INIT MORE*)
       NODEWPPW:=NODEWIDTH+PREWIDTH;NODEWPP3:=NODEWPPW+3;
        BLNW:='';FOR I:=1 TO NODEWIDTH DO BLNW:=BLNW+' ';

       (*CPAGE INITIALIZATION*)
        IF SPADDR[1]<>NIL THEN CPAGE:=SPADDR[1]
        ELSE BEGIN
         NEW(CPAGE);SPADDR[1]:=CPAGE
        END;
       NSP:=1;LSP:=1;
       (*PAGE REFERENCES CREATIONS*)
        (*BACKREFS FIRST*)
         NEWNODE;
         FOR I:=1 TO 28 DO TVAL[I]:=BACKREF[I];TWPTR^.LV:=CHR(28);
          BRPTR:=TWPTR;TWPTR^.LPN:=CHR(NLINES(TWPTR));TWPTR^.NDSOFF:=1;
 BROFF:=0;WHILE CPAGE^.STRNG[26+BROFF]<>'*' DO BROFF:=SUCC(BROFF);
        NEWNODE;TWPTR^.NDSOFF:=LSP;
        FOR I:=1 TO 15 DO TVAL[I]:=SEEPG[I];TWPTR^.LV:=CHR(15);
        FRPTR:=TWPTR;TWPTR^.LPN:=CHR(NLINES(TWPTR));
         IF NODEWIDTH>=15 THEN TWPTR^.LPN:=CHR(1);
         FROFF:=0;WHILE CPAGE^.STRNG[13+TWPTR^.NDSOFF+FROFF]<>'*' DO
          FROFF:=SUCC(FROFF);
      LLOM4:=LLO-4;LLIM4:=LLI-4;LLIP1:=LLI+1;
      MAXLEN[1]:=PREWIDTH;MAXLEN[2]:=LLIM4;MAXLEN[3]:=12;
     (*SPACE & DO DIAGRAM*)
      FOR I:=1 TO 3 DO BEGIN
       OUTP;WRITELN(OUTDIAG,' ')
      END;
      REPEAT
       REPEAT
        NEWNODE;
 OUTP;WRITELN(OUTDIAG,' ',COPY(INCARD,1,LLO));
        TVAL:=BLANKV;RETC:=PARSE('H',TWPTR);
        IF RETC=0 THEN BEGIN
         IF H=NIL THEN BEGIN
          WITH TWPTR^ DO BEGIN
           LP:=CHR(0);LPN:=CHR(NLINES(TWPTR));
           IF ORD(LR)<>0 THEN BEGIN
            LPN:=CHR(ORD(LPN)+1);
            RSPN:=CHR(NSP);RPSOFF:=LSP;
            FOR I:=1 TO ORD(LR) DO BEGIN
             CPAGE^.STRNG[LSP]:=TREP[I];LSP:=SUCC(LSP)
            END
           END;
           LVL:=CHR(1);LS:=1
          END;
          WLAST:=TWPTR;H:=TWPTR;WHEAD:=TWPTR;
         END
         ELSE BEGIN
          IF NOT WHFIND(H) THEN BEGIN
           PRINTABLE:=FALSE;
            OUTP;WRITELN(OUTDIAG,' ***** ATTACHMENT FAILURE.')
          END
          ELSE BEGIN
           IF ORD(TWPTR^.LR)<>0 THEN WITH WLAST^ DO BEGIN
            LPN:=CHR(ORD(LPN)+1);LR:=TWPTR^.LR;
            RSPN:=CHR(NSP);RPSOFF:=LSP;
            FOR I:=1 TO ORD(LR) DO BEGIN
             CPAGE^.STRNG[LSP]:=TREP[I];LSP:=SUCC(LSP)
            END
           END;
           WHEAD:=WLAST
          END;
          TWPTR^.NXT:=WNTOP;WNTOP:=TWPTR
         END
        END
        ELSE BEGIN
         TWPTR^.NXT:=WNTOP;WNTOP:=TWPTR
        END;(*ERROR*)
        IF (RETC<>1) AND EOF(INFLE) THEN BEGIN
         RETC:=1;OUTP;
         WRITELN(OUTDIAG,' ***** ENDWARNIERDIAGRAM KEYWORD MISSING.')
        END;
        IF NOT EOF(INFLE) THEN INFILE(INCARD)
       UNTIL RETC<=1;
       IF RETC<>1 THEN REPEAT
        NEWNODE;
 OUTP;WRITELN(OUTDIAG,'      ',COPY(INCARD,1,LLO));
          TWPTR^.LVL:=CHR(ORD(WHEAD^.LVL)+1);
           TVAL:=BLANKV;RETC:=PARSE('C',TWPTR);
        (*NEW STRING POOL, AS NEEDED*)
         IF LSP+ORD(TWPTR^.LV)+ORD(TWPTR^.LI)+20>LENSTRPGS THEN BEGIN
          NSP:=SUCC(NSP);LSP:=1;TWPTR^.SPN:=CHR(NSP);TWPTR^.NDSOFF:=1;
          (*NEW STRING PAGE*)
           IF SPADDR[NSP]<>NIL THEN CPAGE:=SPADDR[NSP]
           ELSE BEGIN
            NEW(CPAGE);SPADDR[NSP]:=CPAGE
           END
         END;
        CASE RETC OF
         3,4:WITH TWPTR^ DO BEGIN
          NCT:=SUCC(NCT);
          LATTACH(H,TWPTR);
          (*ATTACH IN WARNIER TREE*)
           IF WHEAD=WLAST THEN WHEAD^.NLVL:=TWPTR
           ELSE WLAST^.NXT:=TWPTR;
          TWPTR^.BCK:=WLAST;WLAST:=TWPTR;
          TWPTR^.LPN:=CHR(NLINES(TWPTR));
          (*DO INFIX*)
           IF RETC=4 THEN IF ORD(TWPTR^.LI)<>0 THEN BEGIN
            OUTP;TWPTR^.LI:=CHR(0);
            WRITELN(OUTDIAG,' ***** INFIX MEANINGLESS HERE. SUPPRESSED.')
           END;
           FOR I:=1 TO ORD(LI) DO BEGIN
            CPAGE^.STRNG[LSP]:=TINFX[I];LSP:=SUCC(LSP)
           END
         END;
         2:BEGIN
          TWPTR^.NXT:=WNTOP;WNTOP:=TWPTR
         END;(*ERROR*)
         1:BEGIN
          OUTP;WRITELN(OUTDIAG,' ***** NO TERMINAL SEMICOLON.')
         END
        END;
        IF EOF(INFLE) THEN RETC:=1 ELSE INFILE(INCARD);
        IF (RETC=1)AND(NOT (TVAL=EWDL)OR(TVAL=LCEWDL))THEN BEGIN
         RETC:=1;OUTP;
         WRITELN(OUTDIAG,' ***** ENDWARNIERDIAGRAM KEYWORD MISSING.');
        END
       UNTIL(RETC=1)OR (RETC=4)
      UNTIL RETC=1;
     OUTP;WRITELN(OUTDIAG,' INPUT DONE AT    ',CLOCK);
     IF H=NIL THEN BEGIN
      OUTP;WRITELN(OUTDIAG,' ***** NO DIAGRAM PRESENT.')
     END
     ELSE IF NOT PRINTABLE THEN BEGIN
      OUTP;WRITELN(OUTDIAG,' ***** MAJOR ERROR SUPPRESSED OUTPUT.',
       ' CORRECT BEFORE RE-RUNNING.')
     END
     ELSE IF H^.NLVL=NIL THEN
      BEGIN
       OUTP;WRITELN(OUTDIAG,' ***** DIAGRAM HAS NO BODY.')
      END
     ELSE BEGIN
      IF SRCFLAG THEN BEGIN
       (*BODY AND ENDWARNIER*)
        SRCOUT(H);
        WRITELN(SRCPUNCH,EWDL);
       OUTP;WRITELN(OUTDIAG,' SRCPUNCH DONE AT ',CLOCK);
      END;
      IF PLIFLAG THEN BEGIN
       PLIOUT(H);
       OUTP;WRITELN(OUTDIAG,' PLIPUNCH DONE AT ',CLOCK)
      END;
      PDN:=DDN;
      (*GO PAGINATE*)
       PASSCNT:=0;
       REPEAT
        NQ:=0;GMXH:=0;PASSCNT:=SUCC(PASSCNT);
        (*DET'N OF NQLIM*)
         NQLIM:=(NCT DIV 35)-LPCNT+1;
         IF PASSCNT>NQLIM THEN NQLIM:=LPCNT DIV 2;
         IF NQLIM=0 THEN NQLIM:=1;
        FOR I:=1 TO MAXDEPTH DO TOTWIDTH[I]:=-1;
        CONVERT(PASSCNT,CPN);
        H^.ST:=LAYOUT(H^.NLVL)-ORD(H^.LPN) DIV 2;
        IF (NQ>0) AND ((GMXH>DGMPL)OR (GMXD>COLPP)) THEN DOPAGES
       UNTIL((GMXH<=DGMPL)AND(GMXD<=COLPP))OR(NQ=0);
      PDN[6]:='-';
      PDN[7]:=CPN[2];PDN[8]:=CPN[3];
      (*CLOSE LAYOUT STAGE*)
       OUTP;WRITELN(OUTDIAG,' LAYOUT DONE AT   ',CLOCK);
       IF (NQ=0) AND ((GMXH>DGMPL) OR (GMXD>COLPP)) THEN
        (*ANY ERROR MESSAGE*)
        BEGIN
         OUTP;WRITELN(OUTDIAG,' ***** NO PAGE ',
          'CANDIDATE.  PAGINATION HALTED AT ',LPCNT:3,
          ' PAGES WITH ',GMXH:4,' LINES AND ',GMXD:2,' COLUMNS.')
        END;
      (*FILL IN PAGE NUMBERS AS FINALLY PAGINATED*)
       TPTR:=FPORD;NQ:=2;
       WHILE TPTR<>NIL DO BEGIN
        TPTR^.DDL:=CHR(NQ);
        NQ:=SUCC(NQ);TPTR:=TPTR^.NEXTQ
       END;
      (*OUTPUT ROOT PAGE*)
       LINLINK(H,0);OUTPAGE(H);
      (*SUBPAGE OUTPUT*)
       TPTR:=FPORD;
       WHILE TPTR<>NIL DO BEGIN
        T:=TPTR^.SPPTR;
        PDN:=TPTR^.DDNSTR;
        WITH T^ DO BEGIN
         (*FILL IN BACKREF PAGENO*)
         CONVERT(TPTR^.PRTY,CPN);
         FOR I:=1 TO 3 DO SPADDR[1]^.STRNG[21+I+BROFF]:=CPN[I];
         WITH TPTR^ DO BEGIN
          BCK^.LS:=LSPH;BCK^.ST:=STPH;BCK^.NXT:=NIL;(*BCK^.LD:=LDPH*)
          (*RESTORE ELDEST SON VALUE*)
          NLVL:=NLVLH;NXT:=NXTH;SPN:=SPNH;
          NDSOFF:=NDSOFFH;SUBPAGE:=NIL;
          LV:=LVH;LP:=LPH;LR:=LRH;LI:=LIH;
          LPN:=LPNH;ST:=STSH
         END;
         GMXD:=ORD(TPTR^.LDPH)-ORD(LVL)+2;
         LINLINK(BCK,ORD(LVL)-2);OUTPAGE(BCK)
        END;
        FPORD:=TPTR;
        TPTR:=TPTR^.NEXTQ;
        FPORD^.NEXTQ:=QLTOP;QLTOP:=FPORD
       END;
      OUTP;WRITELN(OUTDIAG,' PRINT DONE AT    ',CLOCK);
      OUTP;WRITELN(OUTDIAG,' NODES:',NCT:5,';   PAGES:',
       LPCNT:3,';   N/P:',(NCT DIV LPCNT):4,';   PASSES:',PASSCNT:3,
       ';   CODE PAGES:',NSP:2)
     END
    END;
    CLOSE(INFLE);
     CLOSE(OUTFLE);
      CLOSE(OUTDIAG);
      CLOSE(SRCPUNCH);
      CLOSE(PLIPUNCH);
   END (*MAIN PROGRAM*).