ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOPAS/RNF-PAS.LBR/RNF2.PQS/RNF2.PAS

Pascal/Delphi Source File | 2000-06-30 | 33KB | 1,199 lines

(*  ---  rnf2 --- *)

procedure GetNum(var SignValue: sign; var NumberValue: integer);

  const
    SMnestMax = 5;

  var
    EndOfSyl: boolean;
    SylCharIndex: integer;
    CurChar,
    LookAheadChar: char;
    SubMacStackIndx: integer;
    SMstack: array [1 .. SMnestMax] of
               record
                 TextPtr: integer;
                 SMmac: pmac;
               end;


  PROCEDURE NextChar;

    BEGIN
      CurChar := ' ';
      if SubMacStackIndx = 0 then
        with syl do
          begin
            ExprErr := ExprErr or EndOfSyl;
            IF SylCharIndex <= LEN THEN
              begin
                CurChar := LIN[SylCharIndex];
                SylCharIndex := SylCharIndex + 1;
              end
            ELSE
              EndOfSyl := true;
          end
      else
        begin
          with SMstack[SubMacStackIndx] do
            with SMmac^ do
              begin
                if TextPtr <= MacroEnd then
                  begin
                    CurChar := StgTable[TextPtr];
                    TextPtr := TextPtr + 1
                  end;
              end;
        end;
    END (*NextChar*);


  FUNCTION Expression: INTEGER;

    VAR
                EXPR1,
                EXPR2: integer;
                EXPR3: boolean;
               EXPROP: RELOPR;

  function number: integer;

    var
      ival: integer;

    begin
      ival := 0;
      while (CurChar in ['0' .. '9']) and (ival < DangerPoint) do
        begin
          ival := ival * 10 + (ord(CurChar) - ord('0'));
          NextChar
        end;
      if CurChar in ['0' .. '9'] then
        if (ord(CurChar) - ord('0')) > maxint mod 10 then
          error(58) (* number too big *)
        else
          begin
            ival := ival * 10 + (ord(CurChar) - ord('0'));
            NextChar;
            if CurChar in ['0' .. '9'] then
              error(58) (* number too big *);
          end;
      while CurChar in ['0' .. '9'] do NextChar;
      number := ival;
    end;

  function character: integer;

    var
      cval: char;

    begin
      NextChar  (* skip quote *);
      cval := CurChar;
      ExprErr := false;
      if CurChar = '''' then
        begin (* handle quotes as characters *)
          NextChar;
          ExprErr := CurChar <> '''';
        end;
      NextChar;
      ExprErr := ExprErr or (CurChar <> '''');
      NextChar;
      if ExprErr then
        begin
          error(59)  (* bad character constant *);
          cval := '?';
          ExprErr := false;
        end;
      character := ord(cval);
    end;

  FUNCTION TERM: INTEGER;

    var
      term1, term2: integer;
      tch: char;

    function item: integer;

      var
        ItemSign: (none, negative, positive, LogicalNot);
        item1: integer;

      FUNCTION VARIABLE: INTEGER;

        VAR
                        V: ALFA;
                        I: INTEGER;
                    VNDX1,
                    VNDX2: 0 .. VARMAX;
                     VAR1: INTEGER;

        BEGIN
          NextChar;   V := AlfaBlanks;   I := 0;
          WHILE ForceUpperCase(CurChar) IN ['A' .. 'Z', '$', '0' .. '9'] DO
            BEGIN I := I + 1;
              IF I <= AlfaLen THEN V[I] := ForceUpperCase(CurChar);
              NextChar;
            END;
          VAR1 := 0;
          IF I = 0   THEN ExprErr := TRUE
          ELSE
            BEGIN
              VID[TV] := V;   VNDX1 := 1;   VNDX2 := 0;
              WHILE VID[VNDX1] <> V DO VNDX1 := VNDX1 + 1;
              IF VNDX1 <> TV
              THEN
                BEGIN
                  IF (VTY[VNDX1] = VARRAY) AND (CurChar = '[')
                  THEN
                    BEGIN
                      NextChar;   VNDX2 := TERM;
                      IF CurChar <> ']'   THEN ExprErr := TRUE   ELSE NextChar;
                      IF (VNDX2 < 0) OR (VNDX2 > VUP[VNDX1]) THEN
                        BEGIN
                          Error(4)    (* Error - ARRAY INDEX OUT OF BOUNDS *);
                          VNDX2 := 0
                        END;
                    END;
                  IF CurChar = '='
                  THEN BEGIN NextChar;   VAL[VNDX1 + VNDX2] := TERM; END;
                  VAR1 := VAL[VNDX1 + VNDX2];
                END
              ELSE
                begin
                  VarName := V;  Error(55)   (* UNDEFINED VARIABLE: $V*);
                end;
            END;
          VARIABLE := VAR1;
        END (*VARIABLE*);


      FUNCTION SUBMACRO: INTEGER;

        VAR
              SaveCurChar: char;
                   SUBMAC: PMAC;
                  MACNAME: alfa;
                  NAMINDX: integer;
                 EXITFLAG: BOOLEAN;

        BEGIN
          MACNAME := AlfaBlanks;   NextChar;

          NAMINDX := 0;
          while CurChar = macchr do
            begin  (* pick up leading macchrs *)
              namindx := namindx + 1;
              if namindx <= alfalen then macname[namindx] := CurChar;
              NextChar;
            end;
          while CurChar in ['A' .. 'Z', 'a' .. 'z', '0' .. '9'] do
            begin
              namindx := namindx + 1;
              if namindx <= alfalen then
                macname[namindx] := ForceUpperCase(CurChar);
              NextChar;
            end;

          SUBMAC := MACLSTP;   EXITFLAG := FALSE;
          REPEAT
            IF SUBMAC = NIL   THEN EXITFLAG := TRUE
            ELSE
              IF SUBMAC ^.NM = MACNAME   THEN EXITFLAG := TRUE
              ELSE SUBMAC := SUBMAC ^.MA;
          UNTIL EXITFLAG;

          IF TestOk((SUBMAC <> NIL), 1)
                                     (* Error - UNRECOGNIZED SUB-MACRO NAME *)
          THEN
            if TestOk(not submac^.on, 2) (* Error - recursive sub-macro *)
            then
              if SubMacStackIndx < SMnestMax then
                begin
                  SaveCurChar := CurChar;
                  SubMacStackIndx := SubMacStackIndx + 1;
                  with SMstack[SubMacStackIndx], submac^ do
                    begin (* stack SUB-MACRO VALUE *)
                      on := true;
                      SMmac := submac;
                      TextPtr := MacroBegin;
                      NextChar;
                      LookAheadChar := StgTable[TextPtr];
                      submacro := Expression;
                      on := false;
                    end;
                  SubMacStackIndx := SubMacStackIndx - 1;
                  CurChar := SaveCurChar;
                END;
        END (* SUBMACRO *);


        BEGIN (* item *)
          ItemSign := none;
          IF CurChar = '-'   THEN ItemSign := negative
          ELSE
            IF CurChar = '#'   THEN ItemSign := LogicalNot
            ELSE
              IF CurChar = '+'   THEN ItemSign := positive;

          if ItemSign <> none then
            NextChar;

          ITEM1 := 0;
          IF CurChar = varchr  THEN ITEM1 := VARIABLE
          ELSE
            IF CurChar = macchr  THEN ITEM1 := SUBMACRO
            ELSE
              IF CurChar IN ['0' .. '9'] THEN  item1 := number
              else
                if CurChar = '''' then item1 := character
                ELSE ExprErr := TRUE;

          CASE ItemSign OF
            none,
            positive:;
            negative: ITEM1 := - ITEM1;
            LogicalNot: item1 := BoolOrd(item1 = 0)
          END;
          ITEM := ITEM1;
        END (*ITEM*);


      BEGIN (* term *)
        TERM1 := 0;
        IF CurChar = '('
        THEN
          BEGIN
            NextChar;   TERM1 := TERM;
            IF CurChar <> ')'   THEN ExprErr := TRUE   ELSE NextChar;
          END
        ELSE
          IF CurChar IN ITEMSET
          THEN
            BEGIN
              TERM1 := ITEM;
              WHILE CurChar IN ['+', '-'] DO
                BEGIN
                  TCH := CurChar;   NextChar;   TERM2 := 0;
                  IF CurChar IN ITEMSET   THEN TERM2 := ITEM
                  ELSE IF CurChar = '('   THEN TERM2 := TERM;
                  IF TCH = '+'
                  THEN TERM1 := TERM1 + TERM2
                  ELSE TERM1 := TERM1 - TERM2;
                END;
            END;
        TERM := TERM1;
      END (*TERM*);


    FUNCTION RELOP: RELOPR;

      VAR
                     OP: ALFA;
                    ROP: RELOPR;

      BEGIN
        OP := AlfaBlanks;

        NextChar;   OP[1] := ForceUpperCase(CurChar);
        NextChar;   OP[2] := ForceUpperCase(CurChar);
        NextChar;   IF CurChar = '.'   THEN NextChar;

        ARELOPR[BADRELOP] := OP;   ROP := EQ;
        WHILE (ARELOPR[ROP] <> OP) DO ROP := SUCC(ROP);
        IF (ROP = BADRELOP) THEN
          Error(5)  (* UNRECOGNIZED RELATIONAL OPERATOR *);
        RELOP := ROP;
      END (*RELOP*);


    BEGIN  (* expression *)
      EXPR1 := 0;
      IF (CurChar = varchr) AND (LookAheadChar = '(')   THEN
        NextChar;
      IF CurChar IN TERMSET
      THEN
        BEGIN
          EXPR1 := TERM;
          IF CurChar = '.'
          THEN
            BEGIN
              EXPROP := RELOP;   EXPR2 := 0;
              IF CurChar IN TERMSET   THEN EXPR2 := TERM;
              CASE EXPROP OF
                EQ: expr3 := EXPR1 = EXPR2;
                GT: expr3 := EXPR1 > EXPR2;
                LT: expr3 := EXPR1 < EXPR2;
                NE: expr3 := EXPR1 <> EXPR2;
                GE: expr3 := EXPR1 >= EXPR2;
                LE: expr3 := EXPR1 <= EXPR2;
                BADRELOP: EXPR3 := false;
              END;
              EXPR1 := BoolOrd(EXPR3);
            END
        end;
      Expression := EXPR1;
    END (*Expression*);


  BEGIN (* GetNum *)
    SubMacStackIndx := 0;

    EndOfSyl := false;
    SylCharIndex := 1;
    NextChar;

    IF CurChar = '+'   THEN SignValue := plus
    ELSE
      IF CurChar = '-'   THEN SignValue := minus
      ELSE SignValue := UnSigned;

    if SignValue <> UnSigned then
      NextChar;

    LookAheadChar := Syl.LIN[SylCharIndex];

    ExprErr := false;

    NumberValue := Expression;

    if CurChar = ';' then
      begin
        ShowExpr := false;
        NextChar;
      end
    else
      ShowExpr := true;

    while (CurChar = ' ') and not EndOfSyl do
      NextChar;

    IF ExprErr or not EndOfSyl then
      begin
        SignValue := invalid;
        Error(6)  (* ERROR IN EXPRESSION *);
      end;
  END (*GetNum*);




PROCEDURE PSHENV;

  BEGIN
    SAVENV(ENSTK[ENP]);
    ENP := ENP + BoolOrd(TestOk((ENP <> MAXENP), 7));
                    (* Error - TOO MANY P OR LIST LEVELS *)
  END (*PSHENV*);


PROCEDURE POPENV;

  BEGIN
    ENP := ENP - BoolOrd(TestOk((ENP <> 0), 8));
                    (* Error - TOO MANY POPS *)
    RESENV(ENSTK[ENP]);
  END (*POPENV*);

PROCEDURE DOJUST(VAR L: LINE; VAR F: JUSLIN; RIGHT: BOOLEAN);

  VAR
          LineIndex: integer;
                  I,
                  J,
                  K,
                  N,
                  M: LLEN;

  BEGIN
    WITH L, F DO
      BEGIN
        IF LEN > 2   THEN IF XTRABL   THEN BEGIN LEN := LEN - 1 END;
        IF (NOT CENTER) AND (NDX > 1) AND (LEN <= VAL[VRM] + 1)
        THEN
          BEGIN
            I := NDX;   J := VAL[VRM];
            N := (VAL[VRM] - LEN + 1) DIV (NDX - 1);
            M := (VAL[VRM] - LEN + 1) MOD (NDX - 1);   LEN := J + 1;
            FOR K := NDX DOWNTO 2 DO
              BEGIN
                FOR LineIndex := POS[K] DOWNTO POS[K - 1] + 1 DO
                  BEGIN
                    LIN[J] := LIN[LineIndex];
                    OverLin[J] := OverLin[LineIndex];
                    BoldFlag[j] := BoldFlag[LineIndex];
                    USflag[j] := USflag[LineIndex];
                    J := J - 1
                  END;
                FOR LineIndex := 1 TO N DO
                  BEGIN
                    LIN[J] := ' ';   OverLin[J] := ' ';
                    BoldFlag[j] := false;   USflag[j] := false;
                    J := J - 1
                  END;
                IF RIGHT
                THEN
                  BEGIN
                    IF (NDX - K) <= M THEN
                      BEGIN
                        LIN[J] := ' ';   OverLin[J] := ' ';
                        BoldFlag[j] := false;   USflag[j] := false;
                        J := J - 1
                      END
                  END
                ELSE
                  IF (K - 2) <= M THEN
                    BEGIN
                      LIN[J] := ' ';   OverLin[J] := ' ';
                      BoldFlag[j] := false;   USflag[j] := false;
                      J := J - 1
                    END
              END
          END
      END
  END (*DOJUST*);


PROCEDURE STARTLINE;
   BEGIN
    if RightSpace > 0 then
      write(outfile,' ':RightSpace);
    if bar then
      if otl.bbar then
        write(outfile, '|  ')
      else
        write(outfile,' ':3);

  END (*STARTLINE*);


PROCEDURE DOTOP;

  var
    i: integer;

  BEGIN
    if HandFeed then
      begin
        write(' Type return when paper is ready >');
        readln;
      end
    else
     if InitialPageEject then
      IF NOPAGE   THEN
        FOR i := VAL[VOLNO] TO OEPAG DO
          writeln(outfile)
      ELSE
        PAGE(OUTFILE);
    InitialPageEject := true; { subsequent pages always eject }
    VAL[VOLNO] := 1;   STARTLINE;   OVETXT := OETXT - 1;   OVBTXT := 0;
    IF NOT HOLDBB   THEN BEGIN HOLDBB := BB;   BB := FALSE; END;
  END (*DOTOP*);


PROCEDURE DOBOT;

  var
    i: integer;

  BEGIN
    FOR i := VAL[VOLNO] TO OETXT DO
      writeln(outfile);
    VAL[VOLNO] := OETXT + 1;   OVETXT := 32000;   HOLDBB := BB;
  END (*DOBOT*);


PROCEDURE PUTBLANK(count: integer);

  var
    i: integer;

  BEGIN
    IF VAL[VOLNO] > OVBTXT THEN
      for i := 1 to count do
        IF VAL[VOLNO] <= OVETXT + 1 THEN
          BEGIN
            VAL[VOLNO] := VAL[VOLNO] + 1;
            if Bar then
              if Otl.BBar then
                begin
                  if RightSpace > 0 then
                    write(outfile,' ':Rightspace);
                  write(outfile, '|  ');
                end;
            writeln(outfile);
          END;
  END (*PUTBLANK*);


PROCEDURE WRITEOTL;

  VAR
      i,  LineIndex: integer;
            LastPos,
              CENTS: INTEGER;
      BoldStarted, UscoreStarted : Boolean;

  BEGIN (*WRITEOTL*)
    WITH OTL DO
      BEGIN
        LEN := LEN - BoolOrd(Len > 0);
        if center then
          CENTS := ((VAL[VRM] - VAL[VLM]) DIV 2) - ((LEN - VAL[VLM]) DIV 2)
        else
          cents := 0;


        IF NOT UL THEN
          FOR LineIndex := 1 TO LEN DO
            BEGIN
              LIN[LineIndex] := ForceUpperCase(LIN[LineIndex]);
              OverLin[LineIndex] := MakeUpper[OverLin[LineIndex]];
            END;

        STARTLINE;
        if cents > 0 then
          write(outfile,' ':cents);
        LastPos := len;
        while (LastPos > 1) and (Lin[LastPos] = ' ') do
          LastPos := LastPos - 1;
        if val[VANSI] = 1 then
          begin
            { This code is for any ANSI output device }
            { it can be used for screen previews of underlining and bold }
            {     on VT100 or on the IBM-PC if the ANSI driver is loaded. }
            { To enable it, put  $$ANSI=1 in your input text file. }
            BoldStarted := false;
            UScoreStarted := false;
            for i := 1 to Lastpos do
              begin
                if UScoreStarted and (not USFlag[i])  or
                   BoldStarted and (not BoldFlag[i]) then
                  begin
                    { ANSI turns off both at once }
                    write (outfile, chr(27),'[0m');
                    UScoreStarted := false;
                    BoldStarted := false;
                  end;
                if (not BoldStarted) and BoldFlag[i] then
                  begin
                    write (outfile, chr(27),'[1m');{ turn on bold mode }
                    BoldStarted := true;
                  end;
                if (not UScoreStarted) and USFlag[i] then
                  begin
                    write (outfile, chr(27),'[4m');
                    UScorestarted := true;
                  end;
                write (outfile, lin[i]); { now write the character }
              end;
            { finished with character writing, turn off attributes }
            if UScoreStarted or BoldStarted then
              begin
                write (outfile, chr(27),'[0m');
                UScoreStarted := false;
                BoldStarted := false;
              end;
          end

        else
        begin
          { non-ANSI device, overprint for bold and underline }
          WritePAOC(Lin, Lastpos);
        if HasBoldPrinting then
          begin
            for LineIndex := 1 to len do
              if BoldFlag[LineIndex] then
                LastPos := LineIndex
              else
                Lin[LineIndex] := ' ';
            for i := 1 to 2 {number of overwrites} do
            begin
              write(outfile, chr(val[vcr]));
              STARTLINE;
              if cents > 0 then
                write(outfile,' ':cents);
              WritePAOC( Lin, LastPos);
            end;
          end;

        if HasOverPrinting then
          begin
            write(outfile, chr(val[vcr]));
            STARTLINE;
            if cents > 0 then
              write(outfile,' ':cents);
            LastPos := len;
            while (LastPos > 1) and (OverLin[LastPos] = ' ') do
              LastPos := LastPos - 1;
            WritePAOC( OverLin, Lastpos);
          end;

        if HasUnderScore then
          begin
            write(outfile, chr(val[vcr]));
            STARTLINE;
            if cents > 0 then
              write(outfile,' ':cents);
            for LineIndex := 1 to len do
              if USflag[LineIndex] then
                begin
                  Lin[LineIndex] := '_';
                  LastPos := LineIndex;
                end
              else
                Lin[LineIndex] := ' ';
            WritePAOC( Lin, LastPos);
          end;
        end;
        writeln(outfile); { finished with complete line }
      END
  END (*WRITEOTL*);


PROCEDURE DOMID;

  VAR
                  i: integer;
              DOFIG: BOOLEAN;

  PROCEDURE MIDRESTORE;

    BEGIN
      CLRLINE;
      IF PAGOTL THEN
        BEGIN
          OTL := PAGSAV;   WRITEOTL;   VAL[VOLNO] := VAL[VOLNO] + 1;
          PAGOTL := FALSE;   CLRLINE;
        END;
      BB := HOLDBB;   HOLDBB := FALSE;
    END (*MIDRESTORE*);

  BEGIN
    OVBTXT := VAL[VOLNO];   DOFIG := TRUE;
    IF FIGP > 0
    THEN
      WHILE DOFIG DO
        IF FIGN[FIGP] <= OVETXT - OVBTXT + 1
        THEN
          BEGIN
            FOR i := 1 TO FIGN[FIGP] DO
              BEGIN
                writeln(outfile);
                VAL[VOLNO] := VAL[VOLNO] + 1;
              END;
            FIGP := FIGP - 1;   IF FIGP = 0   THEN DOFIG := FALSE;
          END
        ELSE DOFIG := FALSE;
    MIDRESTORE;
  END (*DOMID*);


PROCEDURE PUTLINE;

  BEGIN
    IF (NOT SUP) AND (NOT EMPTY)
    THEN
      BEGIN
        IF (VAL[VOLNO] + BoolOrd(pushed) > OVETXT + 1) THEN
          BEGIN
            PAGSAV := OTL;   PAGOTL := TRUE;   PushText(DefrFrcPgMacP);
          END
        ELSE
          BEGIN
            PUSHED := FALSE (* NO PAGE THROW *);
            VAL[VOLNO] := VAL[VOLNO] + 1;
            RIGHT := NOT RIGHT;
            WRITEOTL;
          END
      END;
    PUTBLANK(DEFRB);   CLRLINE;
  END (*PUTLINE*);


PROCEDURE PUSHSYL(VAR Asyl: LINE);
  FORWARD;


PROCEDURE TESTPAGE(N: INTEGER; SaveSyl: boolean);

  BEGIN
    IF (N * VAL[VSP]) - 1 > (OVETXT - VAL[VOLNO] + 1) THEN
      BEGIN
        if SaveSyl then
          PushSyl(Syl);
        PushText(DefrFrcPgMacP);
      END;
  END (*TESTPAGE*);


PROCEDURE PARAGRAPH;

  var
    indent: integer;

  BEGIN
    RIGHT := TRUE (* RESET ALTERNATING FILL *);
    PUTBLANK(PARSPACE * VAL[VSP]);
    WITH OTL DO
      BEGIN
        IF PREL
        THEN
          IF VAL[VLM] + PMAR > 0   THEN indent := VAL[VLM] + PMAR
          ELSE indent := 1
        ELSE indent := PMAR;
        LEN := indent;
{}      if len = 0 then len := 1;
        FOR indent := 1 TO LEN DO LIN[indent] := ' ';
      END;
    RIGHT := TRUE;   TESTPAGE(PARTEST, true);
  END (*PARAGRAPH*);

PROCEDURE MARKJUST(N: LLEN);

  BEGIN WITH JUST DO BEGIN NDX := NDX + 1;   POS[NDX] := N END
  END (*MARKJUST*);


PROCEDURE ADDWORD;

  VAR
                 TAB, J, LineIndex: INTEGER;

  procedure CopyDown(OffSet: integer);

    var
      i, indx: integer;

    begin
      with tmpl do
        FOR i := LEN DOWNTO 1 DO
          BEGIN
            indx := i + OffSet;
            LIN[indx] := LIN[i];
            OverLin[indx] := OverLin[i];
            USflag[indx] := USflag[i];
            BoldFlag[indx] := BoldFlag[i];
          END;
    end;

  FUNCTION GETTAB(X: INTEGER): INTEGER;

    var
      TabLoc: integer;

    BEGIN
      TabLoc := 1;   TABS[TABMAX] := X;
      WHILE TABS[TabLoc] < X DO TabLoc := TabLoc + 1;
      JUST.NDX := 0;   RT := FALSE;   T := FALSE;   GETTAB := TABS[TabLoc];
    END (*GETTAB*);


  BEGIN
    WITH OTL DO
      BEGIN
        IF (XTEND) AND (JUST.NDX > 0)
        THEN
          BEGIN
            JUST.NDX := JUST.NDX - 1;
            CopyDown(LASTSLEN);
            FOR LineIndex := 1 TO LASTSLEN DO
              BEGIN
                J := LineIndex + LASTLEN - 1;
                TMPL.LIN[LineIndex] := LIN[J];
                TMPL.OverLin[LineIndex] := OverLin[J];
                TMPL.USflag[LineIndex] := USflag[J];
                tmpl.BoldFlag[LineIndex] := BoldFlag[J];
              END;
            TMPL.LEN := TMPL.LEN + LASTSLEN;   LEN := LASTLEN;
            FOR LineIndex := 1 TO SYL.LEN DO
              ADDSYL.LIN[LineIndex + ADDSYL.LEN] := SYL.LIN[LineIndex];
            ADDSYL.LEN := ADDSYL.LEN + SYL.LEN
          END
        ELSE ADDSYL := SYL;
        XTEND := FALSE;

        TAB := 0;
        IF RT   THEN TAB := GETTAB(LEN + TMPL.LEN - 1) - TMPL.LEN + 1
        ELSE IF T   THEN TAB := GETTAB(LEN);
        WHILE LEN < TAB DO
          BEGIN
            IF DOT AND (NOT (LEN = TAB - 1))   THEN LIN[LEN] := '.'
            ELSE LIN[LEN] := ' ';
            OverLin[LEN] := ' ';   LEN := LEN + 1;
          END;

        IF (LEN + TMPL.LEN - 1 > VAL[VRM]) AND (NOT EMPTY)
        THEN
          BEGIN
            IF JUSTIT   THEN DOJUST(OTL, JUST, RIGHT);

            PUSHED := TRUE;
            PUSHSYL(ADDSYL)               (* SAVE THE CURRENT SYMBOL *);
            PushText(CarRtnMacP)          (* AND FORCE THE END OF LINE*);
            PUTLINE;
            PUSHED := FALSE;
          END
        ELSE
          BEGIN
            EMPTY := FALSE;

            FOR LineIndex := 1 TO TMPL.LEN DO
              LIN[LEN + LineIndex - 1] := TMPL.LIN[LineIndex];

            HasOverPrinting := tmpl.HasOverPrinting or HasOverPrinting;
            if tmpl.HasOverPrinting then
              for LineIndex := 1 to tmpl.len do
                OverLin[LEN + LineIndex - 1] := tmpl.OverLin[LineIndex];

            HasUnderScore := tmpl.HasUnderScore or HasUnderscore;
            if tmpl.HasUnderScore then
              for LineIndex := 1 to tmpl.len do
                USflag[Len + LineIndex - 1] := tmpl.USflag[LineIndex];

            HasBoldPrinting := tmpl.HasBoldPrinting or HasBoldPrinting;
            if tmpl.HasBoldPrinting then
              for LineIndex := 1 to tmpl.len do
                BoldFlag[Len + LineIndex - 1] := tmpl.BoldFlag[LineIndex];

            LASTLEN := LEN;
            LASTSLEN := TMPL.LEN;   LEN := LEN + TMPL.LEN;
            MARKJUST(LEN - 1);
            IF NOT SIGBL
            THEN
              BEGIN
                LIN[LEN] := ' ';
                LEN := LEN + 1;
                IF PQEND THEN
                  BEGIN
                    LIN[LEN] := ' ';
                    LEN := LEN + 1
                  END;
                XTRABL := PQEND
              END;
          END;
      END;
  END (*ADDWORD*);


PROCEDURE ADDCHR(C: CHAR);

  BEGIN
    WITH OTL DO
      BEGIN
        LIN[LEN] := C;  LEN := LEN + 1;
      END;
  END (*ADDCHR*);


PROCEDURE ADDNUM(N: INTEGER; VAR LocOTL: LINE);

  PROCEDURE ADDCHROTL(C: CHAR);

    BEGIN
      WITH LocOTL DO
        BEGIN
          LIN[LEN] := C;   LEN := LEN + 1;
        END;
    END (*ADDCHR*);


  PROCEDURE ADDN(N: INTEGER);

    BEGIN
      IF N >= 10   THEN ADDN(N DIV 10);
      ADDCHROTL(CHR((N MOD 10) + ORD('0')));
    END (*ADDN*);

  BEGIN
    IF N < 0
    THEN
      BEGIN
        ADDCHROTL('-');
        ADDN(- N)
      END
    ELSE ADDN(N);
  END (*ADDNUM*);


PROCEDURE UNFLAG(VAR L: LINE; LOWER: BOOLEAN);

  VAR
          LineIndex: integer;
                FUP: 0 .. 3;
               RCHN: LLEN;
               OVER: BOOLEAN;

  PROCEDURE OUT(C: CHAR);

    BEGIN
      RCHN := RCHN + 1;
      with tmpl do
        begin
          LIN[RCHN] := C;
          OverLin[RCHN] := ' ';
          if UNDL then
            begin
              HasUnderScore := true;
              USflag[RCHN] := true;
            end;
          if bold then
            if c <> ' ' then
              begin
                HasBoldPrinting := true;
                BoldFlag[RCHN] := true;
              end;
        end;
      LineIndex := LineIndex + 1;
    END (*OUT*);


  BEGIN (*UNFLAG*)
    RCHN := 0;
    with tmpl do
      begin
        HasBoldPrinting := false;
        HasOverPrinting := false;
        HasUnderScore := false;
        BoldFlag := EmptyFlags;
        USflag := EmptyFlags;
      end;
    WITH L DO
      BEGIN
        FUP := 0 (* NO CASE FORCING *);
        LineIndex := 1;   PQEND := FALSE;
        if len < linlen then
          lin[len+1] := ' ';
        WHILE LineIndex <= LEN DO
          BEGIN
            IF NOT (LIN[LineIndex] IN ['''', '"', ')'])   THEN PQEND := FALSE;
            CASE CharCategory[LIN[LineIndex]] OF
              UpArrow:
                BEGIN
                  IF FLAG AND (LineIndex < LEN) THEN
                    IF CharCategory[LIN[LineIndex + 1]] IN [ucLetter, lcLetter]
                    THEN
                      BEGIN
                        LineIndex := LineIndex + 1;
                        CASE FUP OF
                          0,
                          1: LIN[LineIndex] := MAKEUPPER[LIN[LineIndex]];
                          2: LIN[LineIndex] := MAKELOWER[LIN[LineIndex]]
                        END
                      END;
                  OUT(LIN[LineIndex]);
                END;
              ucLetter:
                begin
                  if (FUP = 2) or ((FUP = 0) and LOWER) then
                    repeat
                      lin[LineIndex] := MakeLower[LIN[LineIndex]];
                      out(lin[LineIndex])
                    until not (CharCategory[LIN[LineIndex]]
                                                       in [ucLetter, lcLetter])
                  else
                    repeat
                      out(lin[LineIndex])
                    until (CharCategory[LIN[LineIndex]] <> ucLetter);
                end;
              lcLetter:
                begin
                  if (FUP = 1) or ((FUP = 0) and NOT LOWER) then
                    repeat
                      lin[LineIndex] := MakeUpper[LIN[LineIndex]];
                      out(lin[LineIndex])
                    until not (CharCategory[LIN[LineIndex]]
                                                      in [ucLetter, lcLetter])
                  else
                    repeat
                      out(lin[LineIndex])
                    until (CharCategory[LIN[LineIndex]] <> lcLetter);
                end;
              LeftAngle:
                begin
                  IF FLAGCAPS THEN
                    BEGIN
                      FUP := FUP + 1;
                      IF FUP = 3 THEN FUP := 1;
                      LineIndex := LineIndex + 1;
                    END
                  else
                    out(lin[LineIndex]);
                end;
              EndSentence:
                begin
                  IF PERIOD   THEN PQEND := TRUE;
                  OUT(LIN[LineIndex]);
                end;
              UnderScore:
                begin
                  LineIndex := LineIndex + BoolOrd(ESCCHR);
                  OUT(LIN[LineIndex]);
                end;
              NumberSign:
                begin
                  IF FLAGSIG THEN
                    BEGIN
                      OVER := UNDL;
                      UNDL := UNDL AND USB;
                      OUT(' ');
                      UNDL := OVER;
                    END
                  else
                    out(lin[LineIndex]);
                end;
              BackSlash:
                begin
                  IF FLAGOVER THEN
                    BEGIN
                      LineIndex := LineIndex + 1;
                      tmpl.HasOverPrinting := true;
                      tmpl.OverLin[rchn] := Lin[LineIndex];
                      LineIndex := LineIndex + 1;
                    END
                  else
                    OUT(LIN[LineIndex]);
                end;
              MiscChar:
                begin
                  IF NOT (UL OR LOWER)
                  THEN LIN[LineIndex] := MAKEUPPER[LIN[LineIndex]];
                  OUT(LIN[LineIndex]);
                end;
              ArithChar:
                OUT(LIN[LineIndex]);
              OtherChar:
                LineIndex := LineIndex + 1
            END;
          END;
        TMPL.LEN := RCHN;
      END;
  END (*UNFLAG*);


PROCEDURE ROMAN(N: INTEGER);

  var
    i, j: integer;

  BEGIN
    j := 1;
    if n <= 10000 then
      for i := 1 to 13 do
        begin
          while n >= RomanValue[i] do
            with syl do
              begin
                len := len + 1;
                lin[len] := RomanChars[j];
                lin[len+1] := RomanChars[j+1];
                len := len + BoolOrd(RomanChars[j+1] <> ' ');
                n := n - RomanValue[i];
              end;
          j := j + 2;
        end;
  END (*ROMAN*);


PROCEDURE DOFMT(F, N: INTEGER);

  var
    savesc: boolean;

  BEGIN
    SYL.LEN := 0;
    savesc := escchr;
    escchr := true;
    IF (F >= 0) AND (F <= 4)
    THEN
      CASE F OF
        0:
          BEGIN
            SYL.LEN := 1;   ADDNUM(N, SYL);   SYL.LEN := SYL.LEN - 1;
            UNFLAG(SYL, FALSE);
          END;
        1:
          BEGIN
             SYL.LEN := 2;
             SYL.LIN[1] := '_';
             SYL.LIN[2] := chr(N) ;  { Cyber was  CHR(N MOD CHRMOD)  }
           END;
        2:
           BEGIN
             SYL.LEN := 2;
             SYL.LIN[1] := '_';
             SYL.LIN[2] := chr(N) ;  { Cyber did lower case shift }
           END;

        3, 4: ROMAN(N);
      END;
    IF SYL.LEN > 0   THEN begin UNFLAG(SYL, (F = 4));  ADDWORD;  end;
    escchr := savesc;
  END (*DOFMT*);


PROCEDURE BREAK;

  BEGIN PUTLINE; END (*BREAK*);


PROCEDURE CR;

  BEGIN PUTBLANK(VAL[VSP] - 1) END (*CR*);


PROCEDURE ENDPARA;

  BEGIN BREAK;   CR; END (*ENDPARA*);


PROCEDURE BLANKLINE;

  BEGIN
    IF (NOT AP)   THEN BEGIN ENDPARA;   PUTBLANK(1)  END
    ELSE PushText(ParagMacP);
  END (*BLANKLINE*);


PROCEDURE ENDLINE;

  BEGIN
    IF SUP   THEN CLRLINE;
    IF FORCE OR (NOT FILL) OR OTL.CENTER   THEN ENDPARA;
  END (*ENDLINE*);


PROCEDURE FIN;

  BEGIN PUTLINE;   DOTOP; END (*FIN*);


PROCEDURE PUTWORD;

  BEGIN UNFLAG(SYL, LOWER);   ADDWORD; END (*PUTWORD*);


PROCEDURE PUTVAR;

  VAR
                  N: INTEGER;
                  S: SIGN;

  BEGIN
    GETNUM(S, N);
    IF S <> INVALID
    THEN
      BEGIN
        IF SHOWEXPR THEN
          BEGIN
            SYL.LEN := 1;   ADDNUM(N, SYL);
            SYL.LEN := SYL.LEN - 1;
            PUTWORD;
          END
      END
    ELSE PUTWORD;
  END (*PUTVAR*);