{ NOTICE OF COPYRIGHT AND OWNERSHIP OF SOFTWARE:

  Copyright 1980, 1981, 1982, 1983 by Oregon Software, Inc.
  All Rights Reserved.

  Whether this program is copied in whole or in part and whether this
  program is copied in original or in modified form, ALL COPIES OF THIS
  PROGRAM MUST DISPLAY THIS NOTICE OF COPYRIGHT AND OWNERSHIP IN FULL.

  Text formatting documentation utility
  Release version: 2.1A  Level: 5  Date: 13-Jun-1983 14:02:40
  Processor: ALL
  System: ALL

  Based on software created by John P. Strait.

  Permission is granted by Oregon Software to all parties to copy without
  charge Oregon Software's enhancements of this "Prose" software.
}




{[b+]----------------------------------------------------------------

          Prose is a formatting program, designed for document
preparation. Complete external documentation is available, and it is
maintained in prose form.  Refer to that for an overview of prose.

--------------------------------------------------------------------}

program prose(input, output, infile, outfile);

  const

    infinity = 1000; { largest number + 1 }
    maintitle = true; { title indicator }
    maxinxlength = 60; { max length of index entries }
    maxiwidth = 132; { maximun input width }
    maxkeep = 9; { maximum keep value }
    maxmargin = 132; { largest right margin }
    maxnumberwidth = 20; { max number of digits in a number }
    maxowidth = 200; { maximum output width }
    maxpage = 999; { maximum page number }
    maxshift = 50; { max output shift }
    maxskip = 100; { maximum skip count }
    maxsplit = 20; { maximum number of split points }
    maxstringlength = 154; { max length of text lines }
    min = 10; { general reasonable mimimum }
    subtitle = false; { subtitle indicator }
    tabinterval = 8; {tab interval in input text}

    { certain constraints are applied to the min/max values,    }
    { to eliminate array overflow checks and other error checks:}
    {                                                           }
    {      maxstringlength >= maxiwidth + maxnumberwidth + 2    }
    {      maxmargin       <= maxstringlength - 2               }
    {      (everything)    <  infinity                          }
    {      (everything)    >  (reasonable)                      }

    {[s=4] the ascii character set:  }

    nul = 0;          blank = 32;       at = 64;          grav = 96;
    soh = 1;          exclaim = 33;     a = 65;           smalla = 97;
    stx = 2;          dquote = 34;      b = 66;           smallb = 98;
    etx = 3;          hash = 35;        c = 67;           smallc = 99;
    eot = 4;          dollar = 36;      d = 68;           smalld = 100;
    enq = 5;          percent = 37;     e = 69;           smalle = 101;
    ack = 6;          ampersand = 38;   f = 70;           smallf = 102;
    bel = 7;          squote = 39;      g = 71;           smallg = 103;
    bs = 8;           lparen = 40;      h = 72;           smallh = 104;
    ht = 9;           rparen = 41;      i = 73;           smalli = 105;
    lf = 10;          star = 42;        j = 74;           smallj = 106;
    vt = 11;          plus = 43;        k = 75;           smallk = 107;
    ff = 12;          comma = 44;       l = 76;           smalll = 108;
    cr = 13;          minus = 45;       m = 77;           smallm = 109;
    so = 14;          period = 46;      n = 78;           smalln = 110;
    si = 15;          slash = 47;       o = 79;           smallo = 111;
    dle = 16;         zero = 48;        p = 80;           smallp = 112;
    dc1 = 17;         one = 49;         q = 81;           smallq = 113;
    dc2 = 18;         two = 50;         r = 82;           smallr = 114;
    dc3 = 19;         three = 51;       s = 83;           smalls = 115;
    dc4 = 20;         four = 52;        t = 84;           smallt = 116;
    nak = 21;         five = 53;        u = 85;           smallu = 117;
    syn = 22;         six = 54;         v = 86;           smallv = 118;
    etb = 23;         seven = 55;       w = 87;           smallw = 119;
    can = 24;         eight = 56;       x = 88;           smallx = 120;
    em = 25;          nine = 57;        y = 89;           smally = 121;
    sub = 26;         colon = 58;       z = 90;           smallz = 122;
    esc = 27;         semicolon = 59;   lbracket = 91;    lbrace = 123;
    fs = 28;          less = 60;        backslash = 92;   verticalbar = 124;
    gs = 29;          equal = 61;       rbracket = 93;    rbrace = 125;
    rs = 30;          greater = 62;     caret = 94;       tilde = 126;
    us = 31;          question = 63;    underscore = 95;  del = 127;
    {[s=1]}


  type

    alfa = packed array [1..8] of char;

    ascii = 0..127;

    asciix = 0..255; { the type ascii is extended for internal use }
    { in the following manner:                     }
    {                                              }
    { c + 200b     indicates that c is underlined. }

    charclass =
      packed record
        digit: boolean; { zero..nine }
        formchar: boolean; { c,d,e,l,p,s,t,w,hash,lbracket,rbracket,
                            slash,dquote,squote,rparen,blank }
        inputchar: boolean; { b,c,d,h,k,u,w,blank }
        letter: boolean; { a..z,smalla..smallz }
        marginchar: boolean; { k,l,r,blank }
        numform: boolean; { n,smalln,l,small,r,smallr,blank }
        optionchar: boolean; { e,f,j,k,l,m,p,r,s,u,blank }
        outputchar: boolean; { e,p,s,u,w,blank }
        paragraphchar: boolean; { c,i,k,n,p,u,blank }
        plusorminus: boolean; { plus,minus }
        quote: boolean; { dquote,squote }
        sortinxchar: boolean; { l,m,p,r,s,blank }
      end;

    ch3 = packed array [1..3] of asciix;

    ch10 = packed array [1..10] of asciix;

    direct = (bre, { break }
              com, { comment }
              cou, { count }
              frm, { form }
              ind, { indent }
              inp, { input }
              inx, { inx }
              lit, { literal }
              mar, { margin }
              opt, { option }
              out, { output }
              pag, { page }
              par, { paragraph }
              res, { reset }
              sel, { select }
              ski, { skip }
              sor, { sortindex }
              sbt, { subtitle }
              ttl, { title }
              und, { undent }
              weo, { weos }
              exc, { except (used by reset) }
              ill, { illegal }

    { the following are not directives, but it is convenient }
    { to include them in this table.                         }
              ast, { ascii terminal }
              lpt, { line printer }
              vtr, { video terminal }
              xer, { Xerox 1650 printer }
              xep, { Xerox 1650 with proportional spacing }
              ilt); { illegal }

    dirset = set of direct;

    inputsettings =
      packed record
        defined: boolean;
        b, c, d, h, u: ascii;
        w: 0..infinity
      end;

    pinxentry = ^inxentry;
    inxentry =
      record
        x: packed array [1..maxinxlength] of asciix;
        xl: integer; { length of entry }
        xp: integer; { page number }
        next: pinxentry
      end;

    marginsettings =
      packed record
        defined: boolean;
        l, r: 0..infinity
      end;

    numberform = (numeric, upperalpha, loweralpha, upperroman, lowerroman,
                  nonumbering);

    optionsettings =
      packed record
        defined: boolean;
        e, f, l, m, p, r, u: boolean;
        j, s: 0..infinity
      end;

    paragraphsettings =
      packed record
        defined: boolean;
        c: 0..infinity;
        f: ascii;
        i: - infinity..infinity;
        n: numberform;
        p: 0..infinity;
        s: 0..infinity;
        w: 0..infinity
      end;

    remember = 0..maxkeep;

    splitpoint =
      packed record
        point: 0..infinity; { position of split point within word }
        inpnt: 0..infinity; { position of split point within inline }
        hypnt: boolean { split point represents possible hyphen }
      end;

    pstring = packed array [1..maxstringlength] of asciix;

    string = array [1..maxstringlength] of { str[1].c always = '' }
        packed record
          c: asciix; { character }
          nbl: 0..infinity { if c='', number of blanks, else charwidth }
        end;


  var

    badjustify: integer; { j option }
    blankcount: integer; { accumulated blank output line counter }
    blankline: boolean; { blank output line indicator }
    casech: ascii; { c input }
    class: array [ascii] of charclass; { character classifications }
    ch: char; {next character on command line}
    charwidth: integer; { char width in printer units }
    dirch: ascii; { d input }
    directline: boolean; { input line is a directive }
    directs: array [direct] of ch3; { directive names }
    eject: boolean; { e output }
    endofinput: boolean; { internal eof indicator }
    ensure2: boolean; { p option }
    errorn1: integer; { error in number }
    errorn2: integer; { error in number }
    errors: boolean; { errors in this prose run }
    errorsmall: boolean; { number is too small }
    error1: asciix; { error text }
    error10: ch10; { error text }
    eol: boolean; { internal eoln indicator }
    explicitblank: ascii; { b input }
    filecount: 0..63; {input file index on command line (1110)}
    fill: boolean; { f option }
    firsterror: boolean; { first error on this line }
    form: pstring; { form buffer }
    formindex: integer; { current form position }
    formlength: integer; { form length }
    formnext: pstring; { form for next page }
    formnlength: integer; { length of formnext }
    gaps: array [0..maxstringlength] of 1..maxstringlength;
    { pointers to word gaps }
    hyphen: ascii; { h option }
    inchar: asciix; { current input character }
    incolumn: integer; { current input column }
    infile: text; {input file, attached as needed}
    inlength: integer; { length of current input line }
    inline: string; { current input line }
    inwidth: integer; { w input }
    inxbase: pinxentry; { base of index entry list }
    inxlast: pinxentry; { last index entry }
    keepinp: integer; { current input keep buffer }
    keepmar: integer; { current margin keep buffer }
    keepopt: integer; { current option keep buffer }
    keeppar: integer; { current paragraph keep buffer }
    leftjustify: boolean; { l option }
    leftmargin: integer; { l margin }
    linecount: integer; { output line count (within page) }
    linenumber: integer; { input line count (for error messes) }
    linenums: boolean; { line numbers exist on input file }
    lockeddent: integer; { i/u paragraph }
    lowercase: boolean; { for upper to lower case conversion }
    lowerdir: boolean; { lowercase flag in directives }
    months: array [1..12] of ch3; { month names }
    moreonleft: boolean; { indicator for justifying }
    multipleblanks: boolean; { m option }
    nblanks: integer; { blank count on input }
    nchars: integer; { width of output line }
    newinline: boolean; { begin input line indicator }
    newoutline: boolean; { begin output line indicator }
    newparagraph: boolean; { begin paragraph indicator }
    ngaps: integer; { number of word gaps }
    nicedate: ch10; { date as yy mmm dd }
    nsplits: integer; { number of split points in word }
    nwords: integer; { number of words in output line }
    numbering: numberform; { n paragraph }
    numberwidth: integer; { n paragraph }
    outfile: text; {output file}
    outlength: integer; { length of output line }
    outline: string; { output line }
    outwidth: integer; { w output }
    pagenumber: integer; { current page number }
    parachar: ascii; { p paragraph }
    paracount: integer; { paragraph counter }
    parapage: integer; { p paragraph }
    paraskip: integer; { s paragraph }
    pause: boolean; { p output }
    printerrors: boolean; { e option }
    rawclock: ch10; { clock time as hh:mm:ss }
    rawdate: ch10; { date as yy/mm/dd }
    rightjustify: boolean; { r option }
    rightmargin: integer; { r margin }
    saveinp: array [remember] of inputsettings; { input stack }
    savemar: array [remember] of marginsettings; { margin stack }
    saveopt: array [remember] of optionsettings; { option stack }
    savepar: array [remember] of paragraphsettings; { paragraph stack }
    selection: packed array [0..maxpage] of boolean; {select directive
                                                      setting}
    shift: integer; { s output }
    shiftup: boolean; { u option }
    space: integer; { s option }
    splits: array [1..maxsplit] of splitpoint; { split points within word }
    terminaltype: direct; { output terminal type }
    texts: string; { for building form specifications }
    textindex: integer; { current text position }
    textlength: integer; { length of text }
    title: array [boolean] of pstring; { title and subtitle buffers }
    titlelength: array [boolean] of integer; { title and subtitle lengths }
    underavail: boolean; { u output }
    underchar: ascii; { u input }
    underlining: boolean; { underlining flag }
    underdir: boolean; { underlining flag in directives }
    wallclock: ch10; { clock time as hh:mm am }
    word: string; { current word }
    wordlength: integer; { length of word }

    day, month, year, hrs, mins, secs: integer; {Dec time interface vars}


  procedure timestamp(var day, month, year: integer; {date}
                      var hour, minute, second: integer {time} );
    external;


  procedure error(n: integer);
    forward;


  procedure validate(var num: integer;
                     min, max, err: integer);
    forward;


  procedure reinitialize(which: dirset);
    forward;

{*---------------------------------*
 | Read and Process Command String |
 *---------------------------------*}

  const
    %include csicon;
    InputExt = 'prs';
    OutputExt = 'doc';
    CSIprompt = 'PRS>'; {prompt to use if on RSX system}

  type
    ArgType = (UnknownArg, 
               InputFileArg, OutputFileArg,
               MalformedArg, MissingArg);
    SubArgType = 0..0;

    %include csityp;

    InputListPtr = ^InputList;
    InputList = record
      Next: Inputlistptr;
      Arg: ArgValue;
      end;

  var
    InputListHead, NextInput: InputListPtr;  {input filename list}

    %include csipro;  {CSI standard procedures}
    %include getcs;   
    %include fixarg;  

  procedure exitst(i: Integer);
    external;


  procedure csi;

  {Read and process command line.
  }

    const
      {[f-]}
      ArgDefs = ArgDefTable (
        (('                ',  1,  0), 0, OptionalArg, NullArg),
        (('Input_File      ', 11, 10), 1, RequiredArg, FileArg),
        (('Output_File     ',  2, 11), 2, OptionalArg, FileArg),
        (('                ',  1,  0), 0, OptionalArg, NullArg),
        (('                ',  1,  0), 0, OptionalArg, NullArg));
      {[f+]}

    type
      ErrorMsg = (UnknownArgMsg, MalformedArgMsg, MissingArgMsg,
                  ExtraOutputMsg);

    var
      OutputFlg: (No, Yes, Unknown);
      OutputArg: ArgValue;
      error: Boolean;


    procedure SetupError(msg: ErrorMsg;
                         arg: ArgValue);


      begin
        case msg of
          UnknownArgMsg: write('Unknown argument');
          MalformedArgMsg: write('Bad argument syntax');
          MissingArgMsg: write('Required argument missing');
          ExtraOutputMsg: write('Extra output file');
          end;
        if arg.Len > 0 then write(' (', arg.txt: arg.Len, ')');
        writeln;
        error := true;
      end;


    procedure ProcessArg(arg: ArgValue; typ: ArgType);

      var
        i: iArgValue;
        NewInput: InputListPtr;


      begin
        case typ of
          UnknownArg: SetupError(UnknownArgMsg, arg);
          OutputFileArg:
            begin
            if OutputFlg <> Unknown then SetupError(ExtraOutputMsg, arg);
            OutputArg := arg;
            OutputFlg := Yes;
            end;
          InputFileArg:
            begin
            new(NewInput);
            NewInput^.next := nil;
            NewInput^.arg := arg;
            if InputListHead = nil then InputListHead := NewInput else
              NextInput^.next := NewInput;
            NextInput := NewInput;
            FixFileArg(NextInput^.arg, ActualFile, InputExt, NextInput^.arg);
            end;
          MalformedArg: SetupError(MalformedArgMsg, arg);
          MissingArg: SetupError(MissingArgMsg, arg);
          end;
      end;


    begin
      InputListHead := nil;
      OutputFlg := Unknown;

      error := false;
      GetCS(ArgDefs, ProcessArg);
      if error then exitst(4);

      if OutputFlg = Yes then
        FixFileArg(OutputArg, ActualFile, OutputExt, OutputArg)
      else FixFileArg(NextInput^.arg, DefaultFile, OutputExt, OutputArg);

      rewrite(Outfile, OutputArg.txt);
      NextInput := InputListHead;
    end; {csi}


  procedure GetNextInput(var done: boolean {set if file not found} );

  { Retrieve next input file from saved argument list 
  }

    var
      OldInput: InputListPtr; {to save for dispose}      

    begin
      if NextInput <> nil then
        begin
        done := false;
        reset(infile, NextInput^.arg.txt);
        OldInput := NextInput;
        NextInput := NextInput^.next;
        dispose(OldInput);    
        end
      else done := true;
    end; {GetNextInput}


{$p----------------*
 | General Utility |
 *-----------------*}

{      asciichar - convert literal host character to ascii.
   }


  function asciichar(ch: char): ascii;


    begin { asciichar }
      asciichar := ord(ch);
    end { asciichar } ;

{       upper - convert alphabetic characters to upper case.
  }


  function upper(ch: asciix): asciix;


    begin { upper }
      if class[ch mod 128].letter then
        if ch mod 128 >= smalla then upper := ch - 32
        else upper := ch
      else upper := ch
    end { upper } ;

{     lower - convert to lower case if alphabetic.
  }


  function lower(ch: asciix): asciix;


    begin { lower }
      if class[ch mod 128].letter then
        if ch mod 128 <= z then lower := ch + 32
        else lower := ch
      else lower := ch
    end { lower } ;

{     numform - determine the numeric form.
*
*     param ch = n, smalln, l, smalll, r, smallr.
*           err = error if bad numeric form.
}


  function numform(ch: ascii;
                   err: integer): numberform;


    begin { numform }
      if class[ch].numform then
        case ch of
          n, smalln: numform := numeric;
          l: numform := upperalpha;
          smalll: numform := loweralpha;
          r: numform := upperroman;
          smallr: numform := lowerroman;
          blank: numform := nonumbering
          end
      else
        begin
        error1 := ch;
        error(err);
        numform := numeric
        end
    end { numform } ;

{       convertnumber - convert number from binary to text.
*
*       param str - output string.
*             len - length of output string.
*             num - number to convert.
*             fw  - field width of number.
*             form- form of conversion.
}


  procedure convertnumber(var str: string;
                          var len: integer;
                          num, fw: integer;
                          form: numberform);

    var
      digit: array [1..maxnumberwidth] of ascii; { digit array }
      nextnum: integer; { for decomposition }
      x1, x2: integer; { loop indeces }

{       send1 - send one digit.
*
*       param dig - digit to send.
}


    procedure send1(dig: ascii);


      begin { send1 }
        if x1 < maxnumberwidth then
          begin
          x1 := x1 + 1;
          digit[x1] := dig
          end
      end { send1 } ;


    begin { convertnumber }
      x1 := 0;
      case form of
        numeric:
          repeat
            nextnum := num div 10;
            send1(num - 10 * nextnum + zero);
            num := nextnum
          until num = 0;
        loweralpha, upperalpha:
          repeat
            num := num - 1;
            nextnum := num div 26;
            send1(num - 26 * nextnum + a);
            num := nextnum
          until num = 0;
        lowerroman, upperroman:
          begin
          while num >= 1000 do
            begin
            send1(m);
            num := num - 1000
            end;
          if num >= 900 then
            begin
            send1(d);
            send1(m);
            num := num - 900
            end
          else if num >= 500 then
            begin
            send1(d);
            num := num - 500
            end
          else if num >= 400 then
            begin
            send1(c);
            send1(d);
            num := num - 400
            end;
          while num >= 100 do
            begin
            send1(c);
            num := num - 100
            end;
          if num >= 90 then
            begin
            send1(x);
            send1(c);
            num := num - 90
            end
          else if num >= 50 then
            begin
            send1(l);
            num := num - 50
            end
          else if num >= 40 then
            begin
            send1(x);
            send1(l);
            num := num - 40
            end;
          while num >= 10 do
            begin
            send1(x);
            num := num - 10
            end;
          if num >= 9 then
            begin
            send1(i);
            send1(x);
            num := num - 9
            end
          else if num >= 5 then
            begin
            send1(v);
            num := num - 5
            end
          else if num >= 4 then
            begin
            send1(i);
            send1(v);
            num := num - 4
            end;
          while num >= 1 do
            begin
            send1(i);
            num := num - 1
            end
          end;
        nonumbering:
        end;
      if len + fw > maxstringlength then fw := maxstringlength - len;
      for x2 := x1 + 1 to fw do
        begin
        len := len + 1;
        with str[len] do
          begin
          c := blank;
          nbl := charwidth
          end
        end;
      if len + x1 > maxstringlength then x1 := maxstringlength - len;
      if form in [numeric, loweralpha, upperalpha] then
        for x2 := x1 downto 1 do
          begin
          len := len + 1;
          with str[len] do
            begin
            if form = loweralpha then c := digit[x2] + 32
            else c := digit[x2];

            nbl := charwidth
            end
          end
      else
        for x2 := 1 to x1 do
          begin
          len := len + 1;
          with str[len] do
            begin
            if form = lowerroman then c := digit[x2] + 32
            else c := digit[x2];
            nbl := charwidth
            end
          end
    end { convertnumber } ;

{       shiftstring - convert string to upper/lower case,
*                     considering stuttering and case shift.
}


  procedure shiftstring(var str: string;
                        var len: integer;
                        var lcs: boolean);

    var
      intch: ascii; { internal character }
      oldch: ascii; { previous internal character }
      oldoldch: ascii; { previous previous character }
      x1, x2: integer; { loop indices }


    begin { shiftstring }
      oldch := blank;
      oldoldch := blank;
      x1 := 0;
      x2 := 1;
      if len >= 1 then
        if str[1].c = parachar then
          begin
          x1 := 1;
          x2 := 2
          end;
      for x2 := x2 to len do
        begin
        intch := lower(str[x2].c);
        if intch = casech then lcs := not lcs
        else if intch = oldch then
          if (oldoldch = blank) and class[intch].letter then
            begin
            str[x1].c := upper(intch);
            lcs := true
            end
          else
            begin
            x1 := x1 + 1;
            if lcs then str[x1].c := intch
            else str[x1].c := upper(intch)
            end
        else
          begin
          x1 := x1 + 1;
          if lcs then str[x1].c := intch
          else str[x1].c := upper(intch)
          end;
        oldoldch := oldch;
        oldch := intch
        end;
      len := x1
    end { shiftstring } ;

{        understring - set underlined characters in string,
*                      considering underline character.
*                      this is also done in readpstring.
}


  procedure understring(var str: string;
                        var len: integer;
                        var uln: boolean);

    var
      intch: ascii; { internal character }
      x1, x2: integer; { loop indices }


    begin { understring }
      x1 := 0;
      for x2 := 1 to len do
        begin
        intch := str[x2].c;
        if intch = underchar then uln := not uln
        else
          begin
          x1 := x1 + 1;
          if (intch <> blank) and uln then str[x1].c := intch + 128
          else str[x1].c := intch
          end
        end;
      if x1 > 0 then while (str[x1].c = blank) and (x1 > 1) do x1 := x1 - 1;
      if x1 = 1 then if str[x1].c = blank then x1 := 0;
      len := x1
    end { understring } ;

{      justify - left justify, right justify, and/or center
*                an output line.
}


  procedure justify;

    const
      floor = 0.0; { makes trunc do floor }
      cieling = 0.9999; { makes trunc do cieling }

    var
      fc: real; { to select floor or cieling }
      ib: integer; { insert blanks }
      nb: integer; { number blanks (total) }
      ng: integer; { number gaps (actual) }


    begin { justify }
      ng := ngaps - 1;
      nb := (rightmargin - nchars) * charwidth;
      if leftjustify then
        begin
        if rightjustify then
          begin
          if moreonleft then fc := floor
          else fc := cieling;
          for ng := ng downto 1 do
            begin
            ib := trunc(fc + nb / ng);
            with outline[gaps[ng]] do nbl := nbl + ib;
            nb := nb - ib
            end
          end
        end
      else
        with outline[gaps[0]] do
          if rightjustify then nbl := nbl + nb
          else nbl := nbl + trunc(nb / 2);
      moreonleft := not moreonleft
    end { justify } ;


{$p-------*
 | Output |
 *--------*}

{    write1 - write one character, do conversion from ascii
*             to the host character set.
*
*    param  ch - character to write.
}


  procedure write1(ch: asciix);

    var
      c: char; {actual char to write}


    begin { write1 }
      {$norange The following kluge is necessary because RSTS screws things up}
      c := chr(ch mod 128);
      if rsts then if ch = esc then c := chr(ch + 128);
      write(outfile, c);
      {$range}
    end { write1 } ;

{     endline - terminate and count an output line.
}


  procedure endline;


    begin { endline }
      if selection[pagenumber] then
        if blankline then blankcount := blankcount + 1
        else writeln(outfile);
      if linecount <> infinity then linecount := linecount - 1
    end { endline } ;

{     writeblanklines - write accumulated blank lines.
}


  procedure writeblanklines;


    begin { writeblanklines }
      blankline := false;
      while blankcount > 0 do
        begin
        blankcount := blankcount - 1;
        if linecount <> infinity then linecount := linecount + 1;
        endline
        end
    end { writeblanklines } ;

{     writestring - write a string to the output file.
*
*     param  str = string to write.
*            len = length of str.
}


  procedure writestring(var str: string;
                        len: integer);

    var
      x1, x2, x3: integer; { general index variables }
      lastunderline: integer; {index of last underline found}
      underlining: boolean; {underline attribute set}


    procedure startunderlining;


      begin {start underlining on a video terminal or Xerox printer}
        if terminaltype = vtr then
          begin
          write1(esc);
          write1(lbracket);
          write1(four);
          write1(smallm);
          end
        else if terminaltype in [xer, xep] then
          begin
          write1(esc);
          write1(e);
          end;
        underlining := true;
      end; {startunderlining}


    procedure stopunderlining;


      begin {stop underlining on a video terminal or Xerox printer}
        if terminaltype = vtr then
          begin {turn off underlining}
          write1(esc);
          write1(lbracket);
          write1(smallm);
          end
        else if terminaltype in [xer, xep] then
          begin
          write1(esc);
          write1(r);
          end;
        underlining := false;
      end; {stopUnderlining}


    begin { writestring }
      underlining := false;
      if selection[pagenumber] then
        begin
        while (str[len].c = blank) and (len > 1) do len := len - 1;
        if str[len].c = blank then len := 0;
        blankline := len = 0;
        if not blankline then
          begin
          writeblanklines;
          lastunderline := 0;
          str[1].nbl := str[1].nbl + shift;
          if explicitblank <> nul then
            for x1 := 1 to len do
              with str[x1] do
                if c mod 128 = explicitblank then
                  begin
                  c := blank + (c div 128) * 128;
                  nbl := charwidth
                  end;
          if shiftup then
            for x1 := 1 to len do str[x1].c := upper(str[x1].c);
          for x1 := 1 to len do
            with str[x1] do
              if c = blank then
                begin
                if underlining then stopunderlining;
                for x2 := 1 to nbl do write1(blank);
                end
              else
                begin
                if c div 128 <> 0 then
                  if terminaltype = ast then
                    begin
                    if underavail then
                      begin
                      write1(underscore);
                      write1(bs);
                      end
                    end
                  else if terminaltype in [vtr, xer, xep] then
                    begin
                    if underavail and not underlining then startunderlining;
                    end
                  else lastunderline := x1
                else if underlining then stopunderlining;
                write1(c);
                end;
          if underlining then stopunderlining;
          if (terminaltype = lpt) and (lastunderline <> 0) and underavail then
            begin
            write1(cr);
            for x1 := 1 to lastunderline do
              with str[x1] do
                if c = blank then for x2 := 1 to nbl do write1(blank)
                else if c div 128 <> 0 then write1(underscore)
                else write1(blank);
            end;
          str[1].nbl := str[1].nbl - shift;
          end
        end
      else blankline := false
    end { writestring } ;

{       advanceform - advance form to next l specification.
 }


  procedure advanceform;

    var
      ch: ascii; { key character }
      formch: asciix; { current form character }
      fw: integer; { field width of current item }
      tl: integer; { local title length }
      which: boolean; { which title (main,sub) }
      x1: integer; { general index }

{         nextch - advance to next form character.
 }


    procedure nextch;


      begin { nextch }
        formindex := (formindex mod formlength) + 1;
        formch := form[formindex]
      end { nextch } ;

{     number - read a number from the form.
 *
 *    param def = default number.
  }


    function number(def: integer): integer;

      var
        num: integer; { number begin built }


      begin { number }
        if class[formch].digit then
          begin
          num := 0;
          repeat
            num := num * 10 + formch - zero;
            if num >= infinity then num := infinity - 1;
            nextch
          until not class[formch].digit;
          number := num
          end
        else number := def
      end { number } ;

{       fieldwidth - read optional field width specification.
 *
 *      param def = default field width.
 *            min = minimum field width.
  }


    procedure fieldwidth(def, min: integer);


      begin { fieldwidth }
        fw := def;
        if formch = colon then
          begin
          nextch;
          fw := number(def)
          end;
        if fw < min then fw := min
      end { fieldwidth } ;

{        send1 - send one character to the text line.
 *
 *       param ch = character to be sent.
  }


    procedure send1(ch: asciix);


      begin { send1 }
        textindex := textindex + 1;
        if textindex + shift > maxowidth then
          begin
          textindex := 1;
          error( - 1)
          end;
        texts[textindex].c := ch;
        texts[textindex].nbl := charwidth;
        if textindex > textlength then textlength := textindex
      end { send1 } ;

{       send10 - send up to 10 characters to the text line,
 *               determining field width.
 *
 *      param ch = 10 characters.
 *            def = default field width.
 *            min = minimum field width.
  }


    procedure send10(ch: ch10;
                     def, min: integer);

      var
        x1: integer; { index into ch }


      begin { send10 }
        fieldwidth(def, min);
        if fw < def then { send rightmost fw characters }
          for x1 := def - fw + 1 to def do send1(ch[x1])
        else { send leading blanks and all def characters }
          begin
          for x1 := 1 to fw - def do send1(blank);
          for x1 := 1 to def do send1(ch[x1])
          end
      end { send10 } ;

 {      writetext - write text buffer.
  }


    procedure writetext;


      begin { writetext }
        writestring(texts, textlength);
        endline;
        textlength := 1;
        textindex := 1
      end { writetext } ;

{      wait - wait for operator acknowledgement.
 *            heavily system dependant.
  }


    procedure wait;


      begin { wait }
        if terminaltype = ast then
          begin
          write(outfile, chr(bel));
          readln(input)
          end
      end { wait } ;


    begin { advanceform }
      ch := upper(form[formindex]);
      if not class[ch].quote then nextch;
      if class[ch].formchar then
        case ch of
          c: send10(rawclock, 8, 0);
          d: send10(rawdate, 8, 0);
          e: send10(nicedate, 9, 0);
          l:
            begin
            if textlength > 1 then writetext;
            linecount := number(1)
            end;
          p:
            begin
            if (formch = colon) or (formch = blank) then ch := n
            else
              begin
              ch := formch;
              nextch
              end;
            fieldwidth(3, 0);
            convertnumber(texts, textindex, pagenumber, fw, numform(ch, - 4));
            if textindex > textlength then textlength := textindex
            end;
          s, t:
            begin
            which := (ch = t) or (ch = smallt);
            tl := titlelength[which];
            fieldwidth(tl, 0);
            if fw < tl then { send last fw characters }
              for x1 := tl - fw + 1 to tl do send1(title[which][x1])
            else { send leading blanks and all tl characters }
              begin
              for x1 := 1 to fw - tl do send1(blank);
              for x1 := 1 to tl do send1(title[which][x1])
              end
            end;
          w: send10(wallclock, 8, 0);
          hash:
            begin
            x1 := number(1);
            while textindex < x1 do send1(blank);
            textindex := x1
            end;
          lbracket:
            begin
            if textlength > 1 then writetext;
            if selection[pagenumber] then
              begin
              if eject then
                begin
                blankcount := 0;
                if terminaltype = lpt then page(outfile)
                else write1(ff)
                end
              else if terminaltype <> lpt then writeblanklines;
              if pause then wait
              end;
            if formnlength > 0 then
              begin
              form := formnext;
              formlength := formnlength;
              formindex := 0;
              repeat
                nextch
              until formch = lbracket;
              nextch;
              formnlength := 0
              end
            end;
          rbracket:
            begin
            if textlength > 1 then writetext;
            pagenumber := pagenumber + 1;
            validate(pagenumber, 0, infinity - 1, - 3)
            end;
          slash:
            for x1 := 1 to number(1) do writetext;
          dquote, squote:
            repeat
              nextch;
              while formch <> ch do
                begin
                send1(formch);
                nextch
                end;
              nextch;
              if formch = ch then send1(ch)
            until formch <> ch;
          blank:
          end
      else
        begin
        error1 := ch;
        error( - 2)
        end
    end { advanceform } ;

{      beginline - begin output line, advance form as necessary.
 }


  procedure beginline;

    var
      fix: integer; { local copy of formindex }
      fnl: integer; { local copy of formnlength }


    begin { beginline }
      if linecount <= 0 then { make linecount >0 }
        begin
        fix := formindex;
        fnl := formnlength;
        repeat
          if fnl <> formlength then
            begin
            fix := formindex;
            fnl := formnlength
            end;
          advanceform
        until (linecount > 0) or ((fix = formindex) and (fnl = 0));
        if linecount <= 0 then { bad form }
          begin
          error( - 5);
          linecount := infinity
          end
        end;
      blankline := true
    end { beginline } ;

{     writenull - write a null line.
 }


  procedure writenull;


    begin { writenull }
      beginline;
      writestring(outline, 1);
      endline
    end { writenull } ;

{      skip - skip output lines.
 }


  procedure skip(n: integer);

    var
      x1: integer;


    begin { skip }
      if n > linecount then n := linecount;
      for x1 := 1 to n do writenull
    end { skip } ;

{       writeline - write the output line.
 }


  procedure writeline;


    begin { writeline }
      beginline;
      writestring(outline, outlength);
      endline;
      if space <> 0 then skip(space);
      outlength := 1;
      outline[1].nbl := leftmargin * charwidth;
      nchars := leftmargin;
      nwords := 0;
      ngaps := 0;
      gaps[0] := 1;
      newoutline := true
    end { writeline } ;

{      page - conditionally produce a page eject.
 }


  procedure newpage(n: integer);


    begin { new_page }
      if linecount < n then
        repeat
          while linecount > 0 do writenull;
          while (form[formindex] <> lbracket) and (linecount <= 0) do
            advanceform
        until form[formindex] = lbracket
      else if linecount = infinity then if 5 < n then skip(5)
    end { new_page } ;

  { ------------------------------------------------------------------ }
  {                                                                    }
  {                              input                                 }
  {                                                                    }
  {                                                                    }
  { ------------------------------------------------------------------ }

{      nextchar - advance to the next input character, and
 *                convert from host character set to ascii.
  }


  procedure nextchar;

{      readline - read an input line, convert into ascii,
 *                considering case shift and underlining.
  }


    procedure readline;

      var
        extch: char; { external character }
        x1, x2: integer; { general index variables }


      begin { readline }
        newinline := true;
        x1 := 0;
        while not eoln(infile) and (x1 < inwidth) do
          begin
          read(infile, extch);
          if ord(extch) = ht then
            repeat
              x1 := x1 + 1;
              inline[x1].c := blank;
            until x1 mod tabinterval = 0
          else if ord(extch) >= blank then
            begin
            x1 := x1 + 1;
            inline[x1].c := ord(extch)
            end;
          end;
        inline[x1 + 1].c := blank;
        for x2 := 1 to x1 + 1 do inline[x2].nbl := charwidth;
        if inline[1].c = dirch then
          begin
          directline := true;
          lowerdir := true
          end
        else directline := directline and (inline[1].c = plus);
        if casech <> nul then
          if directline then shiftstring(inline, x1, lowerdir)
          else shiftstring(inline, x1, lowercase);
        if x1 > 1 then
          while (inline[x1].c = blank) and (x1 > 1) do x1 := x1 - 1;
        if x1 = 1 then if inline[x1].c = blank then x1 := 0;
        inlength := x1;
        readln(infile);
        firsterror := true;
      end { readline } ;


    begin { nextchar }
      incolumn := incolumn + 1;
      if incolumn > inlength then
        begin
        if eol then
          begin
          if not endofinput then
            if eof(infile) then getnextinput(endofinput);
          if not endofinput then
            begin
            readline;
            incolumn := 1;
            if linenums then
              begin
              if class[inline[1].c].digit then
                begin
                linenumber := 0;
                repeat
                  linenumber := linenumber * 10 + inline[incolumn].c - zero;
                  incolumn := incolumn + 1
                until not class[inline[incolumn].c].digit
                end;
              incolumn := incolumn + 1
              end
            else linenumber := linenumber + 1;
            eol := incolumn > inlength;
            if eol then inchar := blank
            else inchar := inline[incolumn].c
            end
          end
        else
          begin
          eol := true;
          inchar := blank
          end
        end
      else inchar := inline[incolumn].c
    end { nextchar } ;

{      nextline - advance to beginning of next input line.
 }


  procedure nextline;


    begin { nextline }
      incolumn := inlength + 1;
      eol := true;
      nextchar
    end { nextline } ;

  { ------------------------------------------------------------------ }
  {                                                                    }
  {                    directive processing                            }
  {                                                                    }
  {                                                                    }
  { ------------------------------------------------------------------ }

{        break - cause a break in justification.
 }


  procedure break;


    begin { break }
      if not newoutline then
        begin
        if not (leftjustify and rightjustify) then justify;
        writeline
        end;
      underlining := false;
      newparagraph := true
    end { break } ;

{        inundent - schedule an indent or undent.
 *


 *       param inun > 0 for indent,
 *                  < 0 for undent.
}


  procedure inundent(inun: integer);


    begin { inundent }
      break;
      nchars := leftmargin + inun;
      if nchars < 0 then nchars := 0;
      outline[1].nbl := nchars * charwidth
    end { inundent } ;

{    inpsave - save input settings
 }


  procedure inpsave;


    begin { inpsave }
      validate(keepinp, 0, maxkeep, 1151);
      with saveinp[keepinp] do
        begin
        defined := true;
        b := explicitblank;
        c := casech;
        d := dirch;
        h := hyphen;
        u := underchar;
        w := inwidth
        end
    end { inpsave } ;

{      inprestore - restore previous input settings.
 }


  procedure inprestore;


    begin { inprestore }
      validate(keepinp, 0, maxkeep, 1151);
      with saveinp[keepinp] do
        if defined then
          begin
          explicitblank := b;
          if casech <> c then
            begin
            casech := c;
            lowercase := casech <> nul
            end;
          dirch := d;
          hyphen := h;
          underchar := u;
          inwidth := w
          end
        else error(1105)
    end { inprestore } ;

{     marsave - save margin settings.
 }


  procedure marsave;


    begin { marsave }
      validate(keepmar, 0, maxkeep, 151);
      with savemar[keepmar] do
        begin
        defined := true;
        l := leftmargin;
        r := rightmargin
        end
    end { marsave } ;

{     marrestore - restore previous margin settings.
 }


  procedure marrestore;


    begin { marrestore }
      validate(keepmar, 0, maxkeep, 151);
      with savemar[keepmar] do
        if defined then
          begin
          leftmargin := l;
          rightmargin := r
          end
        else error(105)
    end { marrestore } ;

{     optsave - save option settings.
 }


  procedure optsave;


    begin { optsave }
      validate(keepopt, 0, maxkeep, 251);
      with saveopt[keepopt] do
        begin
        defined := true;
        e := printerrors;
        f := fill;
        j := badjustify;
        l := leftjustify;
        m := multipleblanks;
        p := ensure2;
        r := rightjustify;
        s := space;
        u := shiftup
        end
    end { optsave } ;

{     optrestore - restore previous option settings.
 }


  procedure optrestore;


    begin { optrestore }
      validate(keepopt, 0, maxkeep, 251);
      with saveopt[keepopt] do
        if defined then
          begin
          printerrors := e;
          fill := f;
          badjustify := j;
          leftjustify := l;
          multipleblanks := m;
          ensure2 := p;
          rightjustify := r;
          space := s;
          shiftup := u
          end
        else error(205)
    end { optrestore } ;

{     parsave - save paragraph settings.
 }


  procedure parsave;


    begin { parsave }
      validate(keeppar, 0, maxkeep, 351);
      with savepar[keeppar] do
        begin
        defined := true;
        c := 0; { it would seem that this is superfluous }
        f := parachar;
        i := lockeddent;
        n := numbering;
        p := parapage;
        s := paraskip;
        w := numberwidth
        end
    end { parsave } ;

{     parrestore - restore previous paragraph settings.
 }


  procedure parrestore;


    begin { parrestore }
      validate(keeppar, 0, maxkeep, 351);
      with savepar[keeppar] do
        if defined then
          begin
          paracount := c;
          parachar := f;
          lockeddent := i;
          numbering := n;
          parapage := p;
          paraskip := s;
          numberwidth := w
          end
        else error(305)
    end { parrestore } ;

{        directive - process one directive
 }


  procedure directive;

    var
      dir: direct; { current directive }
      fullword: ch10; { current directive word }
      word: ch3; { 3 letters of current directive word }
      wordlength: integer; { length of current directive word }
      x1, x: integer; { general index variables }

{     nextch - advance to nextchar, considering continuations.
 }


    procedure nextch;


      begin { nextch }
        nextchar;
        if eol and (infile^ = '+') then
          begin
          nextchar;
          inchar := blank
          end
      end { nextch } ;

{     switch - determine a switch option, considering
 *             the default.
 *
 *    param def = default.
  }


    function switch(def: boolean): boolean;


      begin { switch }
        if class[inchar].plusorminus then
          begin
          switch := inchar = plus;
          nextch
          end
        else switch := def
      end { switch } ;

{      character - determine a character option, considering
 *                 the default.
 *
 *     param def = default.
  }


    function character(def: ascii): ascii;


      begin { character }
        if inchar <> blank then
          begin
          character := inchar;
          nextch
          end
        else character := def
      end { character } ;

{     number - determine a numeric option, considering
 *             the default and the previous value.
 *
 *    param def = default.
 *                last = previous value, if < 0 then
 *                       relative form is not recognized.
 *                min  = minimum allowed value.
 *                max  = maximum allowed value.
 *                err  = error number (if out of range).
  }


    function number(def, last, min, max, err: integer): integer;

      var
        num: integer; { number being built }
        sign: ascii; { plus or minus sign }


      begin { number }
        if class[inchar].plusorminus and (last >= 0) then
          begin
          sign := inchar;
          nextch
          end
        else
          begin
          sign := plus;
          last := 0
          end;
        if class[inchar].digit then
          begin
          num := 0;
          repeat
            num := num * 10 + inchar - zero;
            if num >= infinity then num := infinity - 1;
            nextch
          until not class[inchar].digit
          end
        else num := def;
        if sign = plus then num := last + num
        else num := last - num;
        if num < 0 then num := 0;
        validate(num, min, max, err);
        number := num
      end { number } ;

{     readword - read the next directive word.
 }


    procedure readword;

      var
        x1: integer; { loop index }


      begin { readword }
        wordlength := 0;
        while class[inchar].letter do
          begin
          wordlength := wordlength + 1;
          if wordlength <= 10 then
            begin
            fullword[wordlength] := inchar;
            if wordlength <= 3 then word[wordlength] := upper(inchar)
            end;
          nextch
          end;
        for x1 := wordlength + 1 to 10 do fullword[x1] := blank;
        for x1 := wordlength + 1 to 3 do word[x1] := blank
      end { readword } ;

{      readpstring - read a pstring until a terminator character.
 *
 *     param str = pstring to be read.
 *           len = length of predefined portion of str, updated
 *                 to new length.
 *           endc = terminator character.
  }


    procedure readpstring(var str: pstring;
                          var len: integer;
                          endc: ascii);


      begin { readpstring }
        underdir := false;
        while (inchar <> endc) and not eol do
          begin
          if inchar = underchar then underdir := not underdir
          else if len < maxstringlength then
            begin
            len := len + 1;
            if underdir then str[len] := inchar + 128
            else str[len] := inchar
            end;
          nextch
          end
      end { readpstring } ;

{         lookup - look up the directive word.
 *
 *        param first = first acceptable directive word.
 *                      illegal = last+1 acceptable directive word.
 }


    function lookup(first, illegal: direct): direct;

      var
        d: direct; { lookup loop index }


      begin { lookup }
        directs[illegal] := word;
        d := first;
        while (directs[d][1] <> word[1]) or (directs[d][2] <> word[2]) or
              (directs[d][3] <> word[3]) do
          d := succ(d);
        lookup := d
      end { lookup } ;

{         input - process input directive.
 }


    procedure inputd;

      var
        ch: ascii; { key character }


      begin { inputd }
        if inchar = lparen then
          begin
          nextch;
          keepinp := keepinp + 1;
          while (inchar <> rparen) and not eol do
            begin
            ch := upper(inchar);
            nextch;
            if class[ch].inputchar then
              case ch of
                b: explicitblank := character(nul);
                c:
                  begin
                  ch := character(nul);
                  if ch <> casech then
                    begin
                    casech := ch;
                    lowercase := casech <> nul
                    end
                  end;
                d: dirch := character(period);
                h: hyphen := character(nul);
                k: keepinp := number(0, - 1, 0, maxkeep, 1151);
                u: underchar := character(nul);
                w: inwidth := number(150, - 1, min, maxiwidth, 1154);
                blank:
                end
            else
              begin
              error1 := ch;
              error(1101)
              end
            end;
          if inchar = rparen then nextch
          else error(1102);
          inpsave
          end
        else
          begin
          if class[inchar].digit then
            keepinp := number(0, - 1, 0, maxkeep, 1151)
          else keepinp := keepinp - 1;
          inprestore
          end
      end { inputd } ;

{      literal - process literal directive.
 }


    procedure literal;

      var
        ch: asciix; { literal character }
        i: integer; { loop index }
        litlength: integer; { length of litstring }
        litstring: pstring; { argument of literal directive }


      begin { literal }
        litlength := 0;
        readpstring(litstring, litlength, nul);
        for i := 1 to litlength do
          begin
          ch := litstring[i];
          if ch = explicitblank then write1(blank)
          else write1(ch)
          end;
        writeln
      end { literal } ;

{     margin - process margin directive.
 }


    procedure margin;

      var
        ch: ascii; { key character }


      begin { margin }
        if inchar = lparen then
          begin
          nextch;
          keepmar := keepmar + 1;
          while (inchar <> rparen) and not eol do
            begin
            ch := upper(inchar);
            nextch;
            if class[ch].marginchar then
              case ch of
                k: keepmar := number(0, - 1, 0, maxkeep, 151);
                l: leftmargin := number(0, leftmargin, 0, infinity, 0);
                r: rightmargin := number(70, rightmargin, 0, infinity, 0);
                blank:
                end
            else
              begin
              error1 := ch;
              error(101)
              end
            end;
          if inchar = rparen then nextch
          else error(102);
          validate(rightmargin, min, maxmargin, 152);
          validate(leftmargin, 0, rightmargin, 153);
          marsave
          end
        else
          begin
          if class[inchar].digit then
            keepmar := number(0, - 1, 0, maxkeep, 151)
          else keepmar := keepmar - 1;
          marrestore
          end;
        nchars := leftmargin;
        outline[1].nbl := nchars * charwidth
      end { margin } ;

{       option - process option directive.
 }


    procedure option;

      var
        ch: ascii; { key character }


      begin { option }
        if inchar = lparen then
          begin
          nextch;
          keepopt := keepopt + 1;
          while (inchar <> rparen) and not eol do
            begin
            ch := upper(inchar);
            nextch;
            if class[ch].optionchar then
              case ch of
                e: printerrors := switch(true);
                f: fill := switch(true);
                j: badjustify := number(0, - 1, 3, infinity, 265) - 2;
                k: keepopt := number(0, - 1, 0, maxkeep, 251);
                l: leftjustify := switch(true);
                m: multipleblanks := switch(true);
                p: ensure2 := switch(true);
                r: rightjustify := switch(true);
                s: space := number(1, - 1, 1, 3, 266) - 1;
                u: shiftup := switch(false);
                blank:
                end
            else
              begin
              error1 := ch;
              error(201)
              end
            end;
          if inchar = rparen then nextch
          else error(202);
          optsave
          end
        else
          begin
          if class[inchar].digit then
            keepopt := number(0, - 1, 0, maxkeep, 251)
          else keepopt := keepopt - 1;
          optrestore
          end;
      end { option } ;

{      output - process output directive.
 }


    procedure outputd;

      var
        ch: ascii; { key character }


      begin { outputd }
        if linecount < 0 then
          begin
          if inchar = lparen then
            begin
            repeat
              nextch
            until (inchar <> blank) or eol;
            readword;
            if wordlength <= 3 then terminaltype := lookup(ast, ilt)
            else terminaltype := ilt;
            if terminaltype = ilt then
              begin
              error(1009);
              terminaltype := lpt
              end;
            while (inchar <> rparen) and not eol do
              begin
              ch := upper(inchar);
              nextch;
              if class[ch].outputchar then
                case ch of
                  e: eject := switch(false);
                  p: pause := switch(false);
                  s: shift := number(0, - 1, 0, maxshift, 1064);
                  u: underavail := switch(true);
                  w: outwidth := number(maxowidth, - 1, 0, maxowidth, 1054);
                  blank:
                  end
              else
                begin
                error1 := ch;
                error(1001)
                end
              end;
            if inchar = rparen then nextch
            else error(1002);
            shift := shift * charwidth;
            linecount := 0
            end
          end
        else error(1010)
      end { outputd } ;

{      paragraph - process paragraph directive.
 }


    procedure paragraph;

      var
        ch: ascii; { key character }


      begin { paragraph }
        savepar[keeppar].c := paracount;
        if inchar = lparen then
          begin
          nextch;
          keeppar := keeppar + 1;
          paracount := 0;
          while (inchar <> rparen) and not eol do
            begin
            ch := upper(inchar);
            nextch;
            if class[ch].paragraphchar then
              case ch of
                c: paracount := number(0, - 1, 0, infinity, 0);
                f: parachar := character(nul);
                i: lockeddent := number(5, - 1, 0, rightmargin - min, 355);
                k: keeppar := number(0, - 1, 0, maxkeep, 351);
                n:
                  begin
                  if not class[inchar].digit then
                    numbering := numform(character(blank), 307)
                  else numbering := numeric;
                  numberwidth := number(3, - 1, 0, maxnumberwidth, 356)
                  end;
                p: parapage := number(0, - 1, 0, infinity, 0);
                s: paraskip := number(0, paraskip, 0, maxskip, 357);
                u: lockeddent := - number(0, - 1, 0, infinity, 0);
                blank:
                end
            else
              begin
              error1 := ch;
              error(301)
              end
            end;
          if inchar = rparen then nextch
          else error(302);
          parsave;
          end
        else if class[inchar].digit then
          begin
          keeppar := number(0, - 1, 0, maxkeep, 351);
          parrestore;
          paracount := 0
          end
        else
          begin
          keeppar := keeppar - 1;
          parrestore
          end
      end { paragraph } ;

{       readform - read the form specificatio to the form buffer.
 }


    procedure readform;

      var
        nobracket: boolean; { if no lbracket in the form }
        quote: ascii; { outer quote character for a string }

{    addch - add a character to the form.
 *
 *   param ch - character to add.
 }


      procedure addch(ch: ascii);


        begin { addch }
          formnlength := formnlength + 1;
          formnext[formnlength] := ch
        end { addch } ;


      begin { readform }
        formnlength := 0;
        nobracket := true;
        if inchar = lparen then
          begin
          nextch;
          while (inchar <> rparen) and not eol do
            begin
            addch(inchar);
            nobracket := nobracket and (inchar <> lbracket);
            if class[inchar].quote then
              begin
              quote := inchar;
              nextch;
              readpstring(formnext, formnlength, quote);
              if inchar = quote then nextch
              else error(403);
              addch(quote)
              end
            else nextch
            end;
          if inchar = rparen then nextch
          else error(402);
          if formnlength = 0 then linecount := infinity
          else if nobracket then addch(lbracket);
          end
        else linecount := infinity
      end { readform } ;

{    readinx - read an index entry.
 }


    procedure readinx;

      var
        index: pstring; { index buffer }
        indexlength: integer; {length of index }
        p: pinxentry; { pointer to new index entry }
        x1: integer; { general index variable }


      begin { readindex }
        indexlength := 0;
        readpstring(index, indexlength, nul);
        new(p);
        if indexlength > maxinxlength then indexlength := maxinxlength;
        with p^ do
          begin
          xl := indexlength;
          xp := pagenumber;
          for x1 := 1 to indexlength do x[x1] := index[x1];
          for x1 := indexlength + 1 to maxinxlength do x[x1] := nul
          end;
        if inxbase = nil then inxbase := p
        else inxlast^.next := p;
        inxlast := p
      end {readinx } ;

{    reset - process reset directive.
 }


    procedure reset;

      var
        d: direct; { reset directive name }
        except: boolean; { except keyword is present }
        first: boolean; { first directive name }
        which: dirset; { which directives to reset }


      begin { reset }
        if inchar = lparen then
          begin
          first := true;
          except := false;
          which := [];
          nextch;
          while inchar <> rparen do
            if inchar = blank then nextch
            else if class[inchar].letter then
              begin
              readword;
              d := lookup(bre, ill);
              if d in
                 [cou, frm, inp, inx, mar, opt, out, pag, par, sel, sbt,
                 ttl] then
                which := which + [d]
              else if d = exc then
                if first then except := true
                else error(1211)
              else
                begin
                error10 := fullword;
                if d = ill then error(1206)
                else error(1212)
                end;
              first := false
              end
            else
              begin
              error1 := inchar;
              error(1201);
              nextch
              end;
          if except then which := [bre..ill] - which
          end
        else which := [bre..ill];
        while not eol do nextch;
        if [out, pag, frm] * which <> [] then
          begin
          newpage(infinity);
          if linecount < infinity then advanceform
          end;
        reinitialize(which)
      end { reset } ;

{     select - process select directive.
 }


    procedure select;

      var
        x1, x2: integer; { general index variables }


      begin { select }
        if inchar = lparen then
          begin
          nextch;
          for x1 := 0 to maxpage do selection[x1] := false;
          while (inchar <> rparen) and not eol do
            if class[inchar].digit then
              begin
              x1 := number(0, - 1, 0, maxpage, 504);
              if inchar = colon then
                begin
                nextch;
                for x1 := x1 to number(x1, x1, x1, maxpage, 504) do
                  selection[x1] := true
                end
              else selection[x1] := true
              end
            else
              begin
              if inchar <> blank then
                begin
                error1 := inchar;
                error(501)
                end;
              nextchar
              end;
          if inchar = rparen then nextch
          else error(502)
          end
        else for x1 := 0 to maxpage do selection[x1] := true
      end { select } ;

{     sortinx - sort and print index entries.
 }


    procedure sortinx;

      var
        firstinx: pinxentry; { first entry for sorting }
        lastinx: pinxentry; { last entry for sorting }
        leftwidth: integer; { l specification }
        margin: integer; { m specification }
        pagecol: integer; { p specification }
        rightwidth: integer; { r specification }
        sortcol: integer; { s specification }

{     parse - parse the sortindex directive.
 }


      procedure parse;

        var
          ch: ascii; { key character }


        begin { parse }
          leftwidth := 2;
          margin := 0;
          pagecol := 0;
          rightwidth := 2;
          sortcol := 1;
          if inchar = lparen then
            begin
            nextch;
            while (inchar <> rparen) and not eol do
              begin
              ch := upper(inchar);
              nextch;
              if class[ch].sortinxchar then
                case ch of
                  l: leftwidth := number(2, - 1, 0, 30, 658);
                  m: margin := number(0, - 1, 0, 30, 659);
                  p: pagecol := number(0, - 1, 0, maxinxlength + min, 660);
                  r: rightwidth := number(2, - 1, 0, 30, 661);
                  s:
                    if (inchar = p) or (inchar = smallp) then
                      begin
                      sortcol := - 1;
                      nextch
                      end
                    else
                      sortcol := number(1, - 1, 1, maxinxlength - min, 662);
                  blank:
                  end
              else
                begin
                error1 := ch;
                error(601)
                end
              end;
            if inchar = rparen then nextch
            else error(602)
            end
        end { parse } ;

{     sort - sort the index entries.
 }


      procedure sort;

        var
          p: pinxentry; { for traversing the index list }
          s1, s2: pinxentry; { temps for sorting }
          x1: integer; { general index variable }


        begin { sort }
          new(firstinx);
          new(lastinx);
          with firstinx^ do
            begin
            xl := 0;
            next := lastinx;
            for x1 := 1 to maxinxlength do x[x1] := nul;
            end;
          with lastinx^ do
            begin
            xl := 0;
            next := nil;
            for x1 := 1 to maxinxlength do x[x1] := del
            end;
          if sortcol < 0 then
            begin
            if inxlast <> nil then inxlast^.next := lastinx;
            firstinx^.next := inxbase;
            inxbase := nil
            end
          else
            begin
            p := inxbase;
            if inxlast <> nil then inxlast^.next := nil;
            while p <> nil do
              begin
              inxbase := p^.next;
              s2 := firstinx;
              repeat
                s1 := s2;
                s2 := s1^.next;
                x1 := sortcol;
                while (x1 < maxinxlength) and
                      (upper(p^.x[x1]) = upper(s2^.x[x1])) do
                  x1 := x1 + 1
              until upper(p^.x[x1]) < upper(s2^.x[x1]);
              s1^.next := p;
              p^.next := s2;
              p := inxbase
              end
            end
        end { sort } ;

{     print - print the index entries.
 }


      procedure print;

        var
          p: pinxentry; { for traversing the index list }
          x1: integer; { general index variable }

{     send1 - send one character to the output line.
 *
 *    param ch - character to send.
 }


        procedure send1(ch: asciix);


          begin { send1 }
            outlength := outlength + 1;
            with outline[outlength] do
              begin
              c := ch;
              nbl := charwidth
              end
          end { send1 } ;


        begin { print }
          p := firstinx^.next;
          while p <> lastinx do
            with p^ do
              begin
              for x1 := 1 to margin do send1(blank);
              for x1 := 1 to pagecol do
                if x1 > xl then send1(blank)
                else send1(x[x1]);
              convertnumber(outline, outlength, xp, leftwidth, numeric);
              for x1 := 1 to rightwidth do send1(blank);
              for x1 := pagecol + 1 to xl do send1(x[x1]);
              writeline;
              dispose(firstinx);
              firstinx := p;
              p := firstinx^.next
              end;
          dispose(lastinx)
        end { print } ;


      begin { sortinx }
        parse;
        sort;
        print
      end { sortinx } ;


    begin { directive }
      repeat
        nextch;
        readword;
        dir := lookup(bre, ill);
        while (inchar = blank) and not eol do nextch;
        if dir in [bre, frm, ind, mar, opt, pag, res, ski, sor, und, weo] then
          break;
        case dir of
          bre: ;
          com: while not eol do nextch;
          cou: pagenumber := number(1, pagenumber, 0, maxpage, 759);
          frm: readform;
          ind: inundent(number(5, - 1, 0, rightmargin, 856));
          inp: inputd;
          inx: readinx;
          lit: literal;
          mar: margin;
          opt: option;
          out: outputd;
          pag: newpage(number(infinity, - 1, 0, infinity, 0));
          par: paragraph;
          res: reset;
          sel: select;
          ski: skip(number(5, - 1, 0, maxskip, 957));
          sor: sortinx;
          sbt:
            begin
            titlelength[subtitle] := 0;
            readpstring(title[subtitle], titlelength[subtitle], nul)
            end;
          ttl:
            begin
            titlelength[maintitle] := 0;
            readpstring(title[maintitle], titlelength[maintitle], nul)
            end;
          und: inundent( - number(infinity, - 1, 0, infinity, 0));
          weo: {putseg(output)} ; {****}
          exc, ill:
            begin
            error10 := fullword;
            error(006)
            end
          end;
        while (inchar <> dirch) and not eol do
          begin
          if inchar <> blank then
            begin
            error1 := inchar;
            error(1)
            end;
          nextch
          end
      until eol
    end { directive } ;

  { --------------------------------------------- }
  {                                               }
  {               text formatting                 }
  {                                               }
  {                                               }
  { --------------------------------------------- }

{       nextword - read the next input word, process directives
 *                 when appropriate.
 }


  procedure nextword;

    var
      x1: integer; { loop index }


    begin { nextword }
      wordlength := 0;
      newinline := false;
      while eol and not endofinput do
        begin
        nextchar;
        if eol and not endofinput then
          begin
          break;
          writenull
          end
        else if inchar = dirch then directive
        else if inchar = parachar then
          begin
          break;
          if paraskip > 0 then skip(paraskip);
          if parapage > 0 then newpage(parapage);
          inundent(lockeddent);
          if numbering <> nonumbering then
            begin
            paracount := paracount + 1;
            convertnumber(word, wordlength, paracount, numberwidth, numbering)
            end;
          nextchar
          end
        end;
      if not endofinput then
        begin
        nblanks := 0;
        if wordlength = 0 then
          while inchar = blank do
            begin
            nblanks := nblanks + 1;
            nextchar
            end;
        if newinline then
          begin
          if (nblanks > 0) or not fill then break;
          if underchar <> nul then
            begin
            understring(inline, inlength, underlining);
            incolumn := incolumn - 1;
            nextchar

            end
          end
        else if not multipleblanks and (nblanks > 1) then nblanks := 1;
        nsplits := 0;
        while inchar <> blank do
          begin
          if inchar mod 128 = hyphen then
            begin
            if nsplits < maxsplit then
              begin
              nsplits := nsplits + 1;
              with splits[nsplits] do
                begin
                point := wordlength;
                if incolumn > 1 then
                  hypnt := class[inline[incolumn - 1].c mod 128].letter and
                           class[inline[incolumn + 1].c mod 128].letter
                else hypnt := false;
                inpnt := incolumn
                end
              end
            end
          else
            begin
            wordlength := wordlength + 1;
            with word[wordlength] do
              begin
              c := inchar;
              nbl := charwidth
              end
            end;
          nextchar
          end
        end
    end { nextword } ;

{     packword - pack a word into the output line.
 }


  procedure packword;

    var
      nb: integer; { number blanks (preceding word) }
      nc: integer; { nchars predicted after adding word }

{     addword - add the word to the output line.
 }


    procedure addword;

      var
        x1: integer; { general index variable }


      begin { addword }
        with outline[outlength] do nbl := nbl + nb * charwidth;
        for x1 := 1 to wordlength do
          begin
          outlength := outlength + 1;
          outline[outlength] := word[x1]
          end;
        outlength := outlength + 1;
        with outline[outlength] do
          begin
          c := blank;
          nbl := 0
          end;
        nchars := nc;
        if nchars >= leftmargin then
          begin
          ngaps := ngaps + 1;
          gaps[ngaps] := outlength
          end
        else gaps[0] := outlength
      end { addword } ;

{     setup - set up for packword.
 }


    procedure setup;

      var
        x1: integer; { loop index }


      begin { setup }
        if newparagraph then nb := nblanks
        else if newoutline then nb := 0
        else
          begin
          if newinline then nb := nblanks + 1
          else nb := nblanks;

          if ensure2 and (outline[outlength - 1].c mod 128 = period) and
             (nblanks < 2) and (nchars >= leftmargin) then
            nb := 2
          end;
        nc := nchars + nb + wordlength;
        if nc > rightmargin then
          if rightmargin - nchars > badjustify * (ngaps - 1) then
            begin { going to insert too many blanks }
            if nsplits > 0 then
              begin
              x1 := nsplits;
              while x1 > 0 do
                with splits[x1] do
                  begin
                  nc := nchars + nb + point + ord(hypnt);
                  if nc <= rightmargin then
                    begin
                    x1 := 0; { exit loop }
                    incolumn := inpnt; { reset input stream }
                    eol := false;
                    nextchar;
                    wordlength := point + ord(hypnt);
                    if hypnt then word[wordlength].c := minus;
                    end
                  else x1 := x1 - 1;
                  end;
              end;
            if nc > rightmargin then
              begin
              error(008);
              end;
            end;
        newoutline := false;
        newparagraph := false
      end { setup } ;


    begin { packword }
      setup;
      if nc <= rightmargin then addword;
      if nc >= rightmargin then { don-t call packword, to prevent unending
                                 recursion in }
      {  the case of a word that doesn-t fit between the margins }
        begin
        justify;
        writeline;
        if nc > rightmargin then
          begin
          setup;
          addword;

          if nc >= rightmargin then
            begin
            justify;
            writeline
            end
          end
        end
    end { packword } ;

  { --------------------------------------------- }
  {                                               }
  {               error processing                }
  {                                               }
  {                                               }
  { --------------------------------------------- }

{      error - issue an error message.
 *
 *     param n = error number.
             n is negative for errors detected during form
 *           processing to prevent unending recursion.
 *           for positive n, the following convention is used:
 *           n div 100 indicates which directive the
 *           refers to.
 *           n mod 100 selects a particular error message.
 *           n mod 100 is >= 50 for numeric errors.
 *           global variables error10, error1, errorn1,errorn2,
 *           and errorsmall are used for printing specific
 *           values which are in error.
 }


  procedure error { n : integer } ;

    type
      host5 = packed array [1..5] of char;
      host10 = packed array [1..10] of char;
      host20 = packed array [1..20] of char;

    var
      len: integer; { length of str }
      str: string; { for printing inline }
      x1, x2: integer; { general loop index }

{      wr5,wr10,wr20- write host characters to str.
 }


    procedure wr5(cs: host5;
                  nc: integer);

      var
        x1: integer;


      begin { wr5 }
        for x1 := 1 to nc do
          begin
          len := len + 1;
          with str[len] do
            begin
            c := asciichar(cs[x1]);
            nbl := charwidth
            end
          end
      end { wr5 } ;


    procedure wr10(cs: host10;
                   nc: integer);

      var
        x1: integer;


      begin { wr10 }
        for x1 := 1 to nc do
          begin
          len := len + 1;
          with str[len] do
            begin
            c := asciichar(cs[x1]);
            nbl := charwidth
            end
          end
      end { wr10 } ;


    procedure wr20(cs: host20;
                   nc: integer);

      var
        x1: integer;


      begin { wr20 }
        for x1 := 1 to nc do
          begin
          len := len + 1;
          with str[len] do
            begin
            c := asciichar(cs[x1]);
            nbl := charwidth
            end
          end
      end { wr20 } ;


    begin { error }
      if printerrors then
        begin
        errors := true;
        str[1].c := blank;
        str[1].nbl := 0;
        len := 1;
        wr5('---- ', 5);
        if n < 0 then
          begin
          wr20('form error:         ', 12);
          case n of
            - 1: wr20('line too long       ', 13);
            - 2:
              begin
              len := len + 1;
              with str[len] do
                begin
                c := error1;
                nbl := charwidth
                end
              end;
            - 3: wr20('pagenumber too large', 20);
            - 4: wr20('bad numeric form    ', 16);
            - 5: wr20('no "L" found        ', 12);
            end;
          writestring(str, len);
          endline
          end
        else
          begin
          if firsterror { first error on this line }
             then
            begin
            convertnumber(str, len, linenumber, 4, numeric);
            wr5('.    ', 2);
            for x1 := 1 to inlength do str[len + x1] := inline[x1];
            len := len + inlength;
            writestring(str, len);
            endline;
            firsterror := false;
            str[1].nbl := 0;
            len := 6
            end;
          case n div 100 of
            0: ;
            1: wr10('margin    ', 6);
            2: wr10('option    ', 6);
            3: wr10('paragraph ', 9);
            4: wr5('form ', 4);
            5: wr10('select    ', 6);
            6: wr10('sortindex ', 9);
            7: wr5('count', 5);
            8: wr10('indent    ', 6);
            9: wr5('skip ', 4);
            10: wr10('output    ', 6);
            11: wr5('input', 5);
            12: wr5('reset', 5);
            end;
          wr10(' error:   ', 8);
          wr10(' error:   ', 8);
          n := n mod 100;
          if n < 50 then
            case n of
              1:
                begin
                len := len + 1;
                with str[len] do
                  begin
                  c := error1;
                  nbl := charwidth
                  end
                end;
              2: wr10('missing ) ', 9);
              3: wr20('unmatched quote     ', 15);
              4: wr20('pagenumber too large', 20);
              5:
                begin
                wr20('undefined keep buffe', 20);
                wr5('r    ', 1)
                end;
              6:
                begin
                wr20('unknown directive:  ', 19);
                for x1 := 1 to 10 do
                  begin
                  len := len + 1;
                  with str[len] do
                    begin
                    c := error10[x1];
                    nbl := charwidth
                    end
                  end
                end;
              7: wr20('bad numeric form    ', 16);
              8:
                begin
                wr20('hyphenation needed: ', 20);
                for x1 := 1 to wordlength do
                  if len < maxstringlength then
                    begin
                    len := len + 1;
                    str[len] := word[x1]
                    end
                end;
              9: wr20('bad terminal type   ', 17);
              10:
                begin
                wr20('must be in initial d', 20);
                wr20('irective group      ', 14)
                end;
              11:
                begin
                wr20('"except" must be fir', 20);
                wr5('st   ', 2)
                end;
              12:
                begin
                wr20('directive not allowe', 20);
                wr5('d:   ', 3);
                for x1 := 1 to 10 do
                  begin
                  len := len + 1;
                  with str[len] do
                    begin
                    c := error10[x1];
                    nbl := charwidth
                    end
                  end
                end;
              13:
                begin
                wr20('aj pitch must be 10 ', 20);
                wr5('or 12', 5)
                end;
              end
          else
            begin
            case n of
              51: wr5('keep ', 4);
              52: wr20('right margin        ', 12);
              53: wr20('left margin         ', 11);
              54: wr5('width', 5);
              55: wr10('indent    ', 6);
              56: wr20('number width        ', 12);
              57: wr5('skip ', 4);
              58: wr10('left width', 10);
              59: wr10('margin    ', 6);
              60: wr20('page column         ', 11);
              61: wr20('right width         ', 11);
              62: wr20('sort column         ', 11);
              64: wr5('shift', 5);
              65: wr20('justification limit ', 19);
              66: wr10('spacing   ', 7);
              end;
            wr5(' of  ', 4);
            if errorn1 < 0 then
              begin
              wr5('-    ', 1);
              errorn1 := - errorn1
              end;
            convertnumber(str, len, errorn1, 0, numeric);
            wr10(' is too   ', 8);

            if errorsmall then wr5('small', 5)
            else wr5('large', 5);
            wr5(',    ', 2);
            convertnumber(str, len, errorn2, 0, numeric);
            wr5(' used', 5)
            end;
          writestring(str, len);
          endline
          end
        end
    end { error } ;

{      validate numeric option.
 *
 *     param num = number to test.
 *           min = minimum allowed value.
 *           max = maximum allowed value.
 *           err = error number if not in range.
 }


  procedure validate { var num : integer; min,max,err : integer } ;


    begin { validate }
      errorn1 := num;
      errorsmall := num < min;
      if errorsmall then
        begin
        num := min;
        errorn2 := num;
        error(err)
        end
      else if num > max then
        begin
        num := max;
        errorn2 := num;
        error(err)
        end
    end { validate } ;

  { --------------------------------------------- }
  {                                               }
  {           secondary initialization            }
  {                                               }
  {                                               }
  { --------------------------------------------- }

{     reinitialize - re-initialize global variables.
 }


  procedure reinitialize;

    var
      d: direct; { directive loop index }
      x1: integer; { loop index }

{     initform - initialize default form.
 }


    procedure initform;

      var
        default: packed array [1..40] of char; { default form }
        x1: integer; { loop index }


      begin { initform }
        default := '[//T#62E///L54///#33"- "PN:1" -"////]   ';
        for x1 := 1 to 40 do form[x1] := asciichar(default[x1]);
        formlength := 40;
        formnlength := 0;
        formindex := 1;
        textlength := 1;
        textindex := 1;
        texts[1].c := blank;
        texts[1].nbl := 0;
      end { initform } ;

{      initinp - initialize input settings.
 }


    procedure initinp;

      var
        x1: integer; { loop index }


      begin { initinp }
        lowercase := true;
        lowerdir := true;
        underdir := false;
        underlining := false;
        keepinp := 0;
        explicitblank := nul;
        casech := nul;
        dirch := period;
        hyphen := nul;
        underchar := nul;
        inwidth := 150;
        for x1 := 0 to maxkeep do saveinp[x1].defined := false;
        inpsave
      end { initinp } ;

{      initinx - initialize inx variables.
 }


    procedure initinx;

      var
        ip: pinxentry; { to dispose index entries }


      begin { initinx }
        while inxbase <> nil do
          begin
          ip := inxbase;
          inxbase := inxbase^.next;
          dispose(ip)
          end;
        inxlast := nil
      end { initinx } ;

{      initmar - initialize margin settings.
 }


    procedure initmar;

      var
        x1: integer; { loop index }


      begin { initmar }
        keepmar := 0;
        leftmargin := 0;
        rightmargin := 70;
        for x1 := 0 to maxkeep do savemar[x1].defined := false;
        nchars := 0;
        outline[1].nbl := 0;
        marsave
      end { initmar } ;

{      initopt -  initialize option settings.
 }


    procedure initopt;

      var
        x1: integer; { loop index }


      begin { initopt }
        keepopt := 0;
        printerrors := true;
        fill := true;
        badjustify := 1;
        leftjustify := true;
        multipleblanks := true;
        ensure2 := true;
        rightjustify := true;
        space := 0;
        shiftup := false;
        for x1 := 0 to maxkeep do saveopt[x1].defined := false;
        optsave
      end { initopt } ;

{      initout- initialize output settings.
 }


    procedure initout;


      begin { initout }
        blankcount := 0;
        blankline := false;
        linecount := - 1;
        terminaltype := lpt;
        charwidth := 1;
        eject := false;
        pause := false;
        shift := 0;
        underavail := true;
        outwidth := maxowidth
      end { initout } ;

{     initpar - initialize paragraph settings.
 }


    procedure initpar;

      var
        x1: integer; { loop index }


      begin { initpar }
        keeppar := 0;
        paracount := 0;
        parachar := nul;
        lockeddent := 0;
        numbering := nonumbering;
        parapage := 0;
        paraskip := 0;
        numberwidth := 3;
        for x1 := 0 to maxkeep do savepar[x1].defined := false;
        parsave
      end { initpar } ;


    begin { reinitialize }
      for d := bre to ill do
        if d in which then
          case d of
            bre: ;
            com: ;
            cou: pagenumber := 1;
            frm: initform;
            ind: ;
            inp: initinp;
            inx: initinx;
            lit: ;
            mar: initmar;
            opt: initopt;
            out: initout;
            pag: ;
            par: initpar;
            res: ;
            sel:
              for x1 := 0 to maxpage do selection[x1] := true;
            ski: ;
            sor: ;
            sbt: titlelength[subtitle] := 0;
            ttl: titlelength[maintitle] := 0;
            und: ;
            weo: ;
            exc: ;
            ill:
            end
    end { reinitialize } ;

  { --------------------------------------------- }
  {                                               }
  {              primary initialization           }
  {                                               }
  {                                               }
  { --------------------------------------------- }

{       initialize - initialize global variables.
 }


  procedure initialize;

    var
      exists: boolean; {dummy argument}

{      initclass - initialize the classification table.
 }


    procedure initclass;

      var
        ch: ascii; { index variable }
        empty: charclass; { all fields are false }


      begin { initclass }
        with empty do
          begin
          letter := false;
          digit := false;
          formchar := false;
          optionchar := false;
          outputchar := false;
          marginchar := false;
          paragraphchar := false;
          sortinxchar := false;
          plusorminus := false;
          quote := false;
          numform := false;
          end;
        for ch := nul to del do class[ch] := empty;
        for ch := a to z do class[ch].letter := true;
        for ch := smalla to smallz do class[ch].letter := true;
        for ch := zero to nine do class[ch].digit := true;
        class[c].formchar := true;
        class[d].formchar := true;
        class[e].formchar := true;
        class[l].formchar := true;
        class[p].formchar := true;
        class[s].formchar := true;
        class[t].formchar := true;
        class[w].formchar := true;
        class[hash].formchar := true;
        class[lbracket].formchar := true;
        class[rbracket].formchar := true;
        class[slash].formchar := true;
        class[dquote].formchar := true;
        class[squote].formchar := true;
        class[blank].formchar := true;
        class[b].inputchar := true;
        class[c].inputchar := true;
        class[d].inputchar := true;
        class[h].inputchar := true;
        class[k].inputchar := true;
        class[u].inputchar := true;
        class[w].inputchar := true;
        class[blank].inputchar := true;
        class[k].marginchar := true;
        class[l].marginchar := true;
        class[r].marginchar := true;
        class[blank].marginchar := true;
        class[e].optionchar := true;
        class[f].optionchar := true;
        class[j].optionchar := true;
        class[k].optionchar := true;
        class[l].optionchar := true;
        class[m].optionchar := true;
        class[p].optionchar := true;
        class[r].optionchar := true;
        class[s].optionchar := true;
        class[u].optionchar := true;
        class[w].optionchar := true;
        class[blank].optionchar := true;
        class[blank].optionchar := true;
        class[e].outputchar := true;
        class[p].outputchar := true;
        class[s].outputchar := true;
        class[u].outputchar := true;
        class[w].outputchar := true;
        class[blank].outputchar := true;
        class[c].paragraphchar := true;
        class[f].paragraphchar := true;
        class[i].paragraphchar := true;
        class[k].paragraphchar := true;
        class[n].paragraphchar := true;
        class[p].paragraphchar := true;
        class[s].paragraphchar := true;
        class[u].paragraphchar := true;
        class[blank].paragraphchar := true;
        class[l].sortinxchar := true;
        class[m].sortinxchar := true;
        class[p].sortinxchar := true;
        class[r].sortinxchar := true;
        class[s].sortinxchar := true;
        class[blank].sortinxchar := true;
        class[plus].plusorminus := true;
        class[minus].plusorminus := true;
        class[dquote].quote := true;
        class[squote].quote := true;
        class[n].numform := true;
        class[smalln].numform := true;
        class[l].numform := true;
        class[smalll].numform := true;
        class[r].numform := true;
        class[smallr].numform := true;
        class[blank].numform := true;
      end { initclass } ;

{      initclocks - initialize rawclock and wallclock.
 }


    procedure initclocks;

      var
        c1: ascii; { tens digit of wallclock }
        c2: ascii; { ones digit of wallclock }
        c3: ascii; { a or p for am or pm }
        systemclock: alfa; { system clock as 'hh:mm:ss' }
        x1: integer; { general loop index }


      procedure gettime(var t: alfa);


        begin
          timestamp(day, month, year, hrs, mins, secs);
          t[1] := chr(hrs div 10 + ord('0'));
          t[2] := chr(hrs mod 10 + ord('0'));
          t[3] := '.';
          t[4] := chr(mins div 10 + ord('0'));
          t[5] := chr(mins mod 10 + ord('0'));
          t[6] := '.';
          t[7] := chr(secs div 10 + ord('0'));
          t[8] := chr(secs mod 10 + ord('0'));
        end; {gettime}


      begin { initclocks }
        gettime(systemclock);
        for x1 := 1 to 8 do rawclock[x1] := ord(systemclock[x1]);
        rawclock[9] := blank;
        rawclock[10] := blank;
        c1 := rawclock[1];
        c2 := rawclock[2];
        c3 := a;
        case c1 of
          zero:
            if c2 = zero then
              begin
              c1 := one;
              c2 := two
              end
            else c1 := blank;
          one:
            if c2 = two then c3 := p
            else if c2 > two then
              begin
              c1 := blank;
              c2 := c2 - 2;
              c3 := p
              end;
          two:
            begin
            if c2 <= one then
              begin
              c1 := blank;
              c2 := c2 - 2
              end
            else
              begin
              c1 := one;
              c2 := c2 + 2
              end;
            c3 := p
            end
          end;
        wallclock[1] := c1;
        wallclock[2] := c2;
        wallclock[3] := colon;
        wallclock[4] := rawclock[4];
        wallclock[5] := rawclock[5];
        wallclock[6] := blank;
        wallclock[7] := c3;
        wallclock[8] := m;
        wallclock[9] := blank;
        wallclock[10] := blank;
      end { initclocks } ;

{      initdates - initialize rawdate and nicedate.
 }


    procedure initdates;

      var
        thismonth: ch3; { current month name }
        systemdate: alfa; { system date as 'yy/mm/dd' }
        x1: integer; { general loop index }


      procedure date(var dt: alfa); {*pdp11*}


        begin {Return date in format 'yy/mm/dd'}
          { assumes timestamp already called }
          dt[1] := chr(zero + (year div 10) mod 10);
          dt[2] := chr(zero + year mod 10);
          dt[3] := '/';
          dt[4] := chr(zero + month div 10);
          dt[5] := chr(zero + month mod 10);
          dt[6] := '/';
          dt[7] := chr(zero + day div 10);
          dt[8] := chr(zero + day mod 10);
        end; {date}


      begin { initdates }
        date(systemdate);
        for x1 := 1 to 8 do rawdate[x1] := ord(systemdate[x1]);
        rawdate[9] := blank;
        rawdate[10] := blank;
        thismonth := months[(rawdate[4] - zero) * 10 + rawdate[5] - zero];
        nicedate[1] := rawdate[7];
        nicedate[2] := rawdate[8];
        nicedate[3] := blank;
        nicedate[4] := thismonth[1];
        nicedate[5] := thismonth[2];
        nicedate[6] := thismonth[3];
        nicedate[7] := blank;
        nicedate[8] := rawdate[1];
        nicedate[9] := rawdate[2];
        nicedate[10] := blank
      end { initdates } ;

{      initdirects - initialize the directs table.
 }


    procedure initdirects;

{      onedirect - initialize one direct entry.
 *
 *     param dir = directive.
             a,b,c = 3 characters of directive name.
 }


      procedure onedirect(dir: direct;
                          a, b, c: ascii);


        begin { onedirect }
          directs[dir][1] := a;
          directs[dir][2] := b;
          directs[dir][3] := c
        end { onedirect } ;


      begin { initdirects }
        onedirect(bre, b, r, e);
        onedirect(com, c, o, m);
        onedirect(cou, c, o, u);
        onedirect(frm, f, o, r);
        onedirect(ind, i, n, d);
        onedirect(inp, i, n, p);
        onedirect(inx, i, n, x);
        onedirect(lit, l, i, t);
        onedirect(mar, m, a, r);
        onedirect(opt, o, p, t);
        onedirect(out, o, u, t);
        onedirect(pag, p, a, g);
        onedirect(par, p, a, r);
        onedirect(res, r, e, s);
        onedirect(sel, s, e, l);
        onedirect(ski, s, k, i);
        onedirect(sor, s, o, r);
        onedirect(sbt, s, u, b);
        onedirect(ttl, t, i, t);
        onedirect(und, u, n, d);
        onedirect(weo, w, e, o);
        onedirect(exc, e, x, c);
        onedirect(ast, a, s, c);
        onedirect(lpt, l, p, t);
        onedirect(vtr, v, t, r);
        onedirect(xer, x, e, r);
      end { initdirects } ;

{     initmonths - initialize the months table.
 }


    procedure initmonths;

{     onemonth - initialize one month name.
 *
 *    param mon : month number.
 *           a,b,c : three letters of month name.
 }


      procedure onemonth(mon: integer;
                         a, b, c: ascii);


        begin { onemonth }
          months[mon][1] := a;
          months[mon][2] := b;
          months[mon][3] := c
        end { onemonth } ;


      begin { initmonths }
        onemonth(1, j, smalla, smalln);
        onemonth(2, f, smalle, smallb);
        onemonth(3, m, smalla, smallr);
        onemonth(4, a, smallp, smallr);
        onemonth(5, m, smalla, smally);
        onemonth(6, j, smallu, smalln);
        onemonth(7, j, smallu, smalll);
        onemonth(8, a, smallu, smallg);
        onemonth(9, s, smalle, smallp);
        onemonth(10, o, smallc, smallt);
        onemonth(11, n, smallo, smallv);
        onemonth(12, d, smalle, smallc)
      end { initmonths } ;


    begin { initialize }
      initmonths; { before initdates }
      initclass;
      initclocks; { before initdates }
      initdates;
      initdirects;

      csi;
      getnextinput(exists);

      directline := false;
      endofinput := false;
      filecount := 0;
      eol := true;
      errors := false;
      gaps[0] := 1;
      inchar := blank;
      incolumn := 150;
      inlength := 0;
      inxbase := nil;
      inxlast := nil;
      linenumber := 0;
      linenums := infile^ in ['0'..'9'];
      moreonleft := false;
      nblanks := 0;
      nchars := 0;
      newinline := true;
      newoutline := true;
      newparagraph := true;
      ngaps := 0;
      nwords := 0;
      outlength := 1;
      outline[1].c := blank;
      outline[1].nbl := 0;
      reinitialize([bre..ill]);
    end { initialize } ;

  { --------------------------------------------- }
  {                                               }
  {                    prose                      }
  {                                               }
  {                                               }
  { --------------------------------------------- }


  begin { prose }
    initialize;
    nextword;
    while not endofinput do
      begin
      packword;
      nextword
      end;
    break;
    if linecount < infinity then
      begin
      newpage(infinity);
      selection[pagenumber] := true;
      advanceform
      end;
    if errors then writeln(outfile, ' Prose errors detected.');
  end { prose } .
