{ 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.

  Pascal source formatting utility
  Release version: 2.1A  Level: 6  Date: 24-Mar-1983 16:22:07
  Processor: ALL
  System: ALL
}

program pb(input, output);

label 1;

const

  HTCh = 11b;
  NLCh = 12b;
  FFCh = 14b;

  MaxLineIndex = 200;
  MaxTokenIndex = 100;
  MaxMarkIndex = 50;

  PasExt = 'pas';
  CSIprompt = 'PB> ';
  %include csicon;            {constants for csi procedures}

type

  ArgType = (UnknownArg, OutputFileArg, NoOutputFileArg,
   InputFileArg, IndentStepArg, CommentIndentArg, TestArg, NoTestArg,
   MalformedArg, MissingArg);
  SubArgType = 0..1;

  %include csityp;

  LineIndex = 0..MaxLineIndex;
  LineString = packed array[1..MaxLineIndex] of char;
  LineBuffer = record
    beg: LineIndex;             { beginning column of source line }
    cnt: LineIndex;             { character count of source line }
    pageflg: boolean;           { line is preceded by a form-feed }
    line: LineString            { source line characters }
  end;

  TokenIndex = 0..MaxTokenIndex;
  TokenType = (
   ProgramTok, ProcTok,    FuncTok,    LabelTok,   ConstTok,   TypeTok,
   VarTok,     ArrayTok,   FileTok,    SetTok,     StructBodyTok,
   RecordTok,  BeginTok,   EndTok,     IfTok,      ThenTok,    ElseTok,
   CaseTok,    OfTok,      CaseBodyTok,            CaseElmtTok,
   VariantBodyTok,         VariantElmtTok,         WhileTok,   ForTok,
   WithTok,    DoTok,      RepeatTok,  UntilTok,   ColonTok,   SemiTok,
   LParenTok,  RParenTok,  SubRecordTok,           DirectTok,
   IncludeLexDirTok,       OtherTok);

  TokenBuffer = record
    cnt: TokenIndex;
    tokens: array[1..MaxTokenIndex] of TokenType
  end;

  MarkType = record
    tok: TokenType;
    pos: LineIndex
  end;
  MarkIndex = 0..MaxMarkIndex;
  MarkStack = record
    cnt: MarkIndex;
    marks: array[1..MaxMarkIndex] of MarkType
  end;

  Message = (
    BadCommentMsg,              { Invalid comment indent }
    BadIndentMsg,               { Invalid indent step }
    ExtraOutputMsg,             { Extra output file }
    FixupMsg,                   { Can't move temporary file to output file }
    MalformedArgMsg,            { Badly formed argument }
    MissingArgMsg,              { Required argument missing }
    NoIncludeMsg,               { Can't open include file }
    NoInputMsg,                 { Can't open input file }
    NoOutputMsg,                { Can't open output file }
    UnknownArgMsg,              { Unexpected argument }
    UntermComMsg,               { Unterminated comment }
    UntermStmtMsg);             { Unterminated statement }

var
  IndentStep: LineIndex;        { indent increment }
  ConsistentIndent: LineIndex;  { indent for trailing comments }

  TestFlg, error: boolean;

  Stack: MarkStack;

  %include csipro;
  %include getcs;               { GetCS procedure }
  %include fixarg;              { FixFileArg procedure }
  %include cnvnum;              { CnvNumericArg procedure }
  %include fixout;              { FixOutputArg, FixTempOutput procedures }
  %include fixinc;              { FixFileInclude procedure }

  procedure exitst(status: integer); external;

  procedure Mesg(msg: Message; var arg: ArgValue);
  begin
    case msg of
      BadCommentMsg:   write('Invalid comment indent');
      BadIndentMsg:    write('Invalid indent step');
      ExtraOutputMsg:  write('Extra output file');
      FixupMsg:        write('Can''t move temporary file to output file');
      MalformedArgMsg: write('Badly formed argument');
      MissingArgMsg:   write('Required argument missing');
      NoIncludeMsg:    write('Can''t open include file');
      NoInputMsg:      write('Can''t open input file');
      NoOutputMsg:     write('Can''t open output file');
      UnknownArgMsg:   write('Unexpected argument');
      UntermComMsg:    write('Unterminated comment');
      UntermStmtMsg:   write('Unterminated statement');
    end;
    if arg.len > 0 then
      write(' (', arg.txt:arg.len, ')');
    writeln;
  end;

  procedure Warn(msg: Message; var arg: ArgValue);
  begin
    Mesg(msg, arg);
    error := true;
  end;

  procedure Abort(msg: Message; var arg: ArgValue);
  begin
    Warn(msg, arg);
    goto 1;
  end;

{ Symbol Table definitions }

const
  MaxNodeCache = 6;             { Maximum number of node buffers }
  MaxStringCache = 20;          { Maximum number of string buffers }

type
  KeyType = (OtherKey, TokenKey);

  %include symdcl;              {symbol declarations}

var
  InputNode: MagicCookie;
  OutputPtr, TempPtr: MagicCookie;
  NilPtr: MagicCookie;

  %include symcod;              {symbol code}

  procedure NewArg(var arg: ArgValue; var ptr: MagicCookie);
  var
    t: StringBlock;
    j: BlockIndex;
  begin
    t[0] := chr(arg.len);
    for j := 1 to arg.len do t[j] := arg.txt[j];
    NewString(t, ptr);
  end;

  procedure AccArg(ptr: MagicCookie; var arg: ArgValue);
  var i: LineIndex;
  begin
    AccString(ptr, ReadAccess);
    with ptr, StringTable[num]^ do begin
      arg.len := ord(blk[idx]);
      for i := 1 to arg.len do arg.txt[i] := blk[idx + i];
      end;
    for i := arg.len + 1 to mArgValue do arg.txt[i] := ' ';
  end;

{ Init - initialize symbol table
}

  procedure Init;
  type
    LitString = packed array[1..10] of char;

  var i: HashIndex;

    procedure InstallToken(str: LitString; tok: TokenType);
    var
      i: BlockIndex;
      t: StringBlock;
      ptr: MagicCookie;
    begin
      i := 0;
      repeat i := i + 1; t[i] := str[i] until str[i + 1] = ' ';
      t[0] := chr(i);
      LocSymbol(t, TokenKey, ptr);
      NodeTable[ptr.num]^.blk[ptr.idx].key := TokenKey;
      NodeTable[ptr.num]^.blk[ptr.idx].tok := tok;
      SetNilCookie(NodeTable[ptr.num]^.blk[ptr.idx].alt);
    end;

  begin                         { Init }
    IniSymbol;

    InstallToken('program   ', ProgramTok);
    InstallToken('label     ', LabelTok);
    InstallToken('const     ', ConstTok);
    InstallToken('type      ', TypeTok);
    InstallToken('var       ', VarTok);
    InstallToken('procedure ', ProcTok);
    InstallToken('function  ', FuncTok);
    InstallToken('array     ', ArrayTok);
    InstallToken('file      ', FileTok);
    InstallToken('set       ', SetTok);
    InstallToken('record    ', RecordTok);
    InstallToken('begin     ', BeginTok);
    InstallToken('end       ', EndTok);
    InstallToken('if        ', IfTok);
    InstallToken('then      ', ThenTok);
    InstallToken('else      ', ElseTok);
    InstallToken('case      ', CaseTok);
    InstallToken('of        ', OfTok);
    InstallToken('while     ', WhileTok);
    InstallToken('for       ', ForTok);
    InstallToken('with      ', WithTok);
    InstallToken('do        ', DoTok);
    InstallToken('repeat    ', RepeatTok);
    InstallToken('until     ', UntilTok);
    InstallToken('external  ', DirectTok);
    InstallToken('forward   ', DirectTok);
    InstallToken('%include  ', IncludeLexDirTok);
  end;                          { Init }

  procedure csi;
  { Process command string. }

  var
    ArgDefs: ArgDefTable;
    InputArg, OutputArg, TempArg: ArgValue;
    OutputFlg: (No, Yes, Unknown);
    NextInputNode: MagicCookie;
    fixup, Err: boolean;
    num: integer;

    procedure ProcessArg(arg: ArgValue; typ: ArgType);
    var
      node: MagicCookie;
    begin
      case typ of
        UnknownArg:
          Warn(UnknownArgMsg, arg);
        OutputFileArg: begin
          if OutputFlg <> Unknown then Warn(ExtraOutputMsg, arg);
          OutputArg := arg;
          OutputFlg := Yes;
          end;
        NoOutputFileArg: begin
          if OutputFlg <> Unknown then Warn(ExtraOutputMsg, arg);
          OutputFlg := No;
          end;
        InputFileArg: begin
          InputArg := arg;
          FixFileArg(arg, ActualFile, PasExt, arg);
          NewNode(node);
          if IsNilCookie(NextInputNode) then
            InputNode := node
          else begin
            AccNode(NextInputNode, WriteAccess);
            NodeTable[NextInputNode.num]^.blk[NextInputNode.idx].next := node;
            end;
          NextInputNode := node;
          NewArg(arg, NodeTable[node.num]^.blk[node.idx].lab);
          SetNilCookie(NodeTable[node.num]^.blk[node.idx].next);
          end;
        IndentStepArg: begin
          CnvNumericArg(arg, num, Err);
          if Err or (num < 0) or (num > 100) then
            Warn(BadIndentMsg, arg)
          else
            IndentStep := num;
          end;
        CommentIndentArg: begin
          CnvNumericArg(arg, num, Err);
          if Err or (num < 0) or (num > 100) then
            Warn(BadCommentMsg, arg)
          else
            ConsistentIndent := num;
          end;
        TestArg:
          TestFlg := true;
        NoTestArg:
          TestFlg := false;
        MalformedArg:
          Warn(MalformedArgMsg, arg);
        MissingArg:
          Warn(MissingArgMsg, arg);
      end;
    end;

  begin                         { csi }

    { Build argument tables. }

    InitDef(ArgDefs[UnknownArg],
      '                ',  1, 0, OptionalArg, NullArg);
    InitDef(ArgDefs[MalformedArg],
      '                ',  1, 0, OptionalArg, NullArg);
    InitDef(ArgDefs[MissingArg],
      '                ',  1, 0, OptionalArg, NullArg);
    InitDef(ArgDefs[OutputFileArg],
      'Output_File     ',  2, 2, OptionalArg, FileArg);
    InitDef(ArgDefs[NoOutputFileArg],
      'NoOutput_File   ',  5, 2, OptionalArg, NullArg);
    InitDef(ArgDefs[InputFileArg],
      'Input_File      ', 11, 1, RequiredArg, FileArg);
    InitDef(ArgDefs[IndentStepArg],
      'Indent_Step     ',  2, 0, OptionalArg, NumericArg);
    InitDef(ArgDefs[CommentIndentArg],
      'Comment_Indent  ',  2, 0, OptionalArg, NumericArg);
    InitDef(ArgDefs[TestArg],
      'Test            ',  2, 0, OptionalArg, NullArg);
    InitDef(ArgDefs[NoTestArg],
      'NoTest          ',  4, 0, OptionalArg, NullArg);

    { Get command arguments. }

    error := false;
    SetNilCookie(InputNode);
    SetNilCookie(NextInputNode);
    OutputFlg := Unknown;
    TestFlg := false;
    GetCS(ArgDefs, ProcessArg);
    if error then goto 1;

    { Set up output, temporary file names. }

    SetNilCookie(TempPtr);
    SetNilCookie(OutputPtr);
    if OutputFlg <> No then begin
      if OutputFlg = Yes then
        FixFileArg(OutputArg, ActualFile, PasExt, OutputArg)
      else if OutputFlg = Unknown then
        FixFileArg(InputArg, DefaultFile, PasExt, OutputArg);
      FixOutputArg(OutputArg, TempArg);
      NewArg(TempArg, TempPtr);
      NewArg(OutputArg, OutputPtr);
      end;
  end;                          { csi }

{ ProcessFile - reformat a single input file

  Parameters:
    InputPtr        pointer to input file name
    OutputPtr       pointer to output file name
    incl            true if input is an included file
}

  procedure ProcessFile(InputPtr, OutputPtr: MagicCookie; incl: boolean);
  label 10;
  var
    InComment: boolean;         { end of previous line is in comment }
    NewInComment: boolean;      { start of following line is in comment }
    InStatement: boolean;       { start of line is in simple statement }
    Indent: LineIndex;          { line indent after previous line }
    CurIndent: LineIndex;       { indent of current line }
    NewIndent: LineIndex;       { line indent after current line }
    ComIndent: LineIndex;
    Delta: integer;             { adjustment for continuation lines }
    Continuation: boolean;      { current line is continuation }

    arg: ArgValue;
    flg: integer;
    inp, out: text;
    l: LineBuffer;
    k: TokenBuffer;

    procedure WriteLine(var f: text; l: LineBuffer);
    begin
      write(f, '(', l.beg:1, ',', l.cnt:1, ',', l.pageflg:1,
       '''', l.line:l.cnt, ''')');
    end;

  { GetSource - get next line from source file

    GetSource reads a line, discarding leading and trailing blanks.
    Form-feeds are noted and deleted so they do not complicate further
    processing; they will be reconstructed in the output using page().

    GetSource always appends a blank character to the source line; subsequent
    routines depend on it to simplify termination conditions.  The blank is
    not included in the character count of the line.

    Parameters:
      f               source file
      l               buffer in which line is stored
  }

    function GetSource(var f: text; var l: LineBuffer): boolean;
    label 10;
    var
      ch: char;
    begin                       { GetSource }
      if TestFlg then write('GetSource(,');
      if eof(f) then begin
        GetSource := false;
        if TestFlg then writeln('): false');
        end
      else begin
        with l do begin
          beg := 1; cnt := 0; pageflg := false;
          { accumulate line, turning tabs into spaces }
          { count leading spaces instead of saving them }
          while not eoln(f) do begin
            read(f, ch);
            if (ch = ' ') and (cnt = 0) then
              beg := beg + 1
            else if (ch = chr(FFCh)) and (cnt = 0) then
              pageflg := true
            else if ch = chr(HTCh) then begin
              if cnt = 0 then
                beg := (beg + 7) div 8 * 8 + 1
              else begin
                repeat
                  cnt := cnt + 1; line[cnt] := ' ';
                until ((beg + cnt) mod 8) = 1;
                end
              end
            else begin
              cnt := cnt + 1; line[cnt] := ch;
              end;
            end;
          readln(f);
          while cnt > 0 do begin
            if line[cnt] <> ' ' then goto 10;
            cnt := cnt - 1;
            end;
        10:
          line[cnt + 1] := ' ';
          GetSource := true;
          end;
        if TestFlg then begin
          WriteLine(output, l); writeln('): true');
          end
        end;
    end;                        { GetSource }

  { ScanSource - scan source line for key identifiers and punctuation

    ScanSource scans a source line for reserved words and special symbols which
    affect the formatting of the source text, generating a list of those
    found.  It also notes whether a comment remains unfinished at the end of
    the line.

    Source text which would not ordinarily affect the formatting of the source
    becomes significant when it indicates continuation of a simple statement
    across multiple lines, or when a comment extends across multiple lines.
    These occurrences are recorded by placing an 'other' token in the token
    list.  Continuations are identified in subsequent processing and special
    steps are taken to preserve alignment among the lines of a continued
    statement or comment.

    ScanSource also notices Pascal-2 directives, specifically '%include.'  When
    a file include is found, an attempt is made to open and scan the included
    file.  Since the included file is not being output it need not be
    formatted, but identifiers are recorded so that later instances may be
    adjusted to have the same capitalization.

    Parameters:
      l               source line buffer
      k               buffer for list of tokens
      CurInCom        current multi-line comment flag (True if start of
                      current line is in comment)
      NewInCom        new multi-line comment flag (set True if start of
                      following line is in comment)
      ComInd          set to starting column of trailing (possibly unfinished)
                      comment
  }

    procedure ScanSource(var l: LineBuffer; var k: TokenBuffer;
     CurInCom: boolean; var NewInCom: boolean; var ComInd: LineIndex);
    var
      ch: char;
      i: LineIndex;
      other: boolean;

      procedure SaveToken(tok: TokenType);
      begin
        if TestFlg then writeln('SaveToken(', ord(tok):1, ')');
        if other then begin
          k.cnt := k.cnt + 1;
          k.tokens[k.cnt] := OtherTok;
          other := false;
          end;
        k.cnt := k.cnt + 1;
        k.tokens[k.cnt] := tok;
      end;

      procedure Comment(offset: LineIndex);
      var done: boolean;
      begin
        if TestFlg then writeln('Comment(', offset:1, ')');
        with l do begin
          { scan to end of comment or line, whichever comes first }
          done := false; NewInCom := false;
          repeat
            if i = cnt then begin
              done := true; NewInCom := true;
              end
            else begin
              i := i + 1;
              if line[i] = '}' then
                done := true
              else if (line[i] = '*')
               and ((line[i + 1] = '/') or (line[i + 1] = ')')) then begin
                done := true; i := i + 1;
                end;
              end;
          until done;
          if i = cnt then ComInd := offset;
          end;
      end;

      procedure ScanInclude(var ptr: MagicCookie);
      label 10;
      var
        prefix, s: ArgValue;
        t: StringBlock;
        j: LineIndex;
      begin
        if TestFlg then write('ScanInclude(');
        SetNilCookie(ptr);
        with l do begin
          { skip separators }
          while line[i + 1] = ' ' do begin
            i := i + 1;
            if i = cnt then goto 10;
            end;
          { collect include file name }
          s.len := 0;
          while not (line[i + 1] in [' ', ';']) do begin
            i := i + 1;
            s.len := s.len + 1;
            s.txt[s.len] := line[i];
            end;
          if s.len = 0 then goto 10;
          end;
        { save include file name }
        prefix.len := 0;
        FixFileInclude(s, prefix, PasExt, s);
        NewArg(s, ptr);
      10:;
        if TestFlg then begin
          WrtString(output, ptr); writeln(')');
          end;
      end;

      procedure Identifier;
      label 10;
      var
        n: integer;
        j: LineIndex;
        t: StringBlock;
        InclPtr, ptr: MagicCookie;
      begin                     { Identifier }
        if TestFlg then writeln('Identifier');
        with l do begin
          { collect identifier }
          n := 1; j := i;
          while true do begin
            if line[i] in ['A'..'Z'] then
              t[n] := chr(ord(line[i]) - ord('A') + ord('a'))
            else
              t[n] := line[i];
            if not (line[i + 1] in ['A'..'Z', 'a'..'z', '$', '0'..'9', '_']) then
              goto 10;
            n := n + 1; i := i + 1;
            end;
        10:
          t[0] := chr(n);

          LocSymbol(t, TokenKey, ptr);
          with NodeTable[ptr.num]^.blk[ptr.idx] do begin
            { initialize new entry }
            if key <> TokenKey then begin
              key := TokenKey;
              tok := OtherTok;
              SetNilCookie(alt);
              end;
            { capitalize identifier consistently }
            if not IsNilCookie(alt) then begin
              { copy saved identifier over current instance }
              AccString(alt, ReadAccess);
              n := 1;
              while j <= i do begin
                line[j] := StringTable[alt.num]^.blk[alt.idx + n];
                n := n + 1; j := j + 1;
                end;
              end
            else begin
              { save current instance of identifier }
              AccNode(ptr, ReadWriteAccess);
              n := 1;
              while j <= i do begin
                t[n] := line[j];
                n := n + 1; j := j + 1;
                end;
              NewString(t, alt);
              end;
            { check whether identifier is reserved word or directive }
            if tok = OtherTok then
              other := true
            else if tok = IncludeLexDirTok then begin
              ScanInclude(InclPtr);
              ProcessFile(InclPtr, NilPtr, true);
              end
            else
              SaveToken(tok);
            end;
          end;
      end;                      { Identifier f}

      procedure StringLiteral;
      label 1;
      begin
        if TestFlg then writeln('StringLiteral');
        with l do begin
          { scan to end of quoted string }
          repeat
            i := i + 1;
            if i = cnt then goto 1;
            while (line[i] = '''') and (line[i + 1] = '''') do begin
              i := i + 2;
              if i = cnt then goto 1;
              end;
          until line[i] = '''';
        1:;
          end;
      end;

    begin                       { ScanSource }
      if TestFlg then begin
        write('ScanSource(');
        WriteLine(output, l); writeln(',,', CurInCom:1, ',...');
        end;
      k.cnt := 0;
      ComInd := 0;
      other := false;
      NewInCom := CurInCom;
      with l do begin
        i := 0;
        { deal with continued comment }
        if NewInCom then Comment(1);
        { scan line to pick out tokens }
        while i < cnt do begin
          i := i + 1;
          case line[i] of
            '{':
              Comment(i);
            '/':
              if line[i + 1] = '*' then begin
                i := i + 1; Comment(i - 1);
                end
              else
                other := true;
            '(':
              if line[i + 1] = '*' then begin
                i := i + 1; Comment(i - 1);
                end
              else
                SaveToken(LParenTok);
            ')':
              SaveToken(RParenTok);
            ':':
              if line[i + 1] <> '=' then
                SaveToken(ColonTok)
              else
                other := true;
            ';', '.':
              SaveToken(SemiTok);
            'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
            'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
            'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
            'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
            '$', '%':
              Identifier;
            '''': begin
              StringLiteral; other := true;
              end;
            ' ':
              ;
            else
              other := true;
          end;
          end;
        end;
      if other then begin
        other := false; SaveToken(OtherTok);
        end;
      if TestFlg then
        writeln('...', NewInCom:1, ',', ComInd:1, ')');
    end;                        { ScanSource }

  { ScanTokens - alter nesting level and indent according to a token list

    ScanTokens takes a token list and an indent mark stack, modifies the
    mark stack according to the tokens, and produces a new indent value.

    Parameters:
      k               buffer containing token list
      m               mark stack
      OldInd          indent prevailing as result of previous lines
      InStat          in middle of simple statement at start of line (refers
                      to current line on entry, set for following line on exit)
      Contin          continuation flag (True if current line is continuation)
      CurInd          set to indent for current line (if the current line is a
                      continuation, this is the indent used for the first line
                      of the statement; the indent for the current line will be
                      adjusted so that it retains its original alignment)
      NewInd          set to indent prevailing as result of current line
                      (it becomes the OldInd for the next line)
  }

    procedure ScanTokens(var k: TokenBuffer; var m: MarkStack;
     OldInd: LineIndex; var InStat: boolean; var Contin: boolean;
     var CurInd, NewInd: LineIndex);

    type
      IndentType = (PreIndent, PostIndent, NoIndent);
      TokenSet = set of TokenType;
      decision = (Yes, No, maybe);

    var
      i: TokenIndex;
      tmpind: LineIndex;
      indone: integer;
      out, ign: boolean;
      cont: decision;

      procedure PushMark(k: TokenType; inreq: IndentType);
      begin
        { writeln('PushMark(k:', ord(k):1, ',inreq:', ord(inreq):1, }
        {  ',[indone:', indone:1, ',i:', i:1, '])'); }
        with m do begin
          cnt := cnt + 1;
          marks[cnt].tok := k;
          marks[cnt].pos := NewInd;
          end;
        if (inreq <> NoIndent) and (indone = 0) then begin
          NewInd := NewInd + IndentStep;
          if (inreq = PreIndent) and (i = 1) then CurInd := NewInd;
          end;
        indone := indone + 1;
      end;

      procedure PopMark(inreq: IndentType);
      begin
        { writeln('PopMark'); }
        if m.cnt > 0 then begin
          NewInd := m.marks[m.cnt].pos;
          m.cnt := m.cnt - 1;
          if (inreq = PreIndent) and (i = 1) then CurInd := NewInd;
          if indone > 0 then indone := indone - 1;
          end;
      end;

      function TopToken: TokenType;
      begin
        if m.cnt > 0 then TopToken := m.marks[m.cnt].tok
        else TopToken := OtherTok;
      end;

      function Terminate(k: TokenSet; inreq: IndentType): boolean;
      begin
        Terminate := false;
        if TopToken in k then begin
          PopMark(inreq);
          Terminate := true;
          end;
      end;

      procedure SetOther(b: boolean);
      begin
        InStat := b;
        if cont = maybe then begin
          if InStat then cont := Yes
          else cont := No;
          end;
      end;

    begin                       { ScanTokens }
      if TestFlg then writeln('ScanTokens(,,', OldInd:1, ',...');

      indone := 0;
      CurInd := OldInd;
      NewInd := OldInd;
      out := false;

      if InStat then
        cont := maybe
      else
        cont := No;

      { writeln('ScanTokens('); {}
      { with k do begin {}
      {   write('  ((', cnt:1, ')'); {}
      {   for i := 1 to cnt do write(',', ord(tokens[i]):1); {}
      {   writeln('),'); {}
      {   end; {}
      { with m do begin {}
      {   write('  ((', cnt:1, ')'); {}
      {   for i := 1 to cnt do {}
      {     write(',(', ord(marks[i].tok):1, ',', marks[i].pos:1, ')'); {}
      {   writeln('),'); {}
      {   end; {}
      { write('  ', OldInd:1, ','); {}

      with k do begin
        i := 1;
        while i <= cnt do begin { to avoid bugs, this is a simulated for-loop }
          case tokens[i] of
            ProgramTok: begin
              ign := Terminate([VarTok, ConstTok, TypeTok, LabelTok],
               PreIndent);      { in case there is a prologue }
              PushMark(ProgramTok, NoIndent);
              SetOther(false); SetOther(true);
              end;
            ProcTok, FuncTok: begin
              { procs and funcs in param lists don't count }
              if TopToken <> LParenTok then begin
                ign := Terminate([VarTok, ConstTok, TypeTok, LabelTok],
                 PreIndent);
                PushMark(tokens[i], PreIndent);
                SetOther(false);
                end;
              SetOther(true);
              end;
            LabelTok, ConstTok, TypeTok, VarTok: begin
              { vars in param lists don't count }
              if (TopToken <> LParenTok) or (tokens[i] <> VarTok) then begin
                ign := Terminate([VarTok, ConstTok, TypeTok, LabelTok],
                 PreIndent);
                PushMark(tokens[i], PostIndent);
                SetOther(false);
                end
              else
                SetOther(true);
              end;
            ArrayTok, FileTok, SetTok: begin
              PushMark(tokens[i], NoIndent);
              SetOther(false); SetOther(true);
              end;
            RecordTok, RepeatTok: begin
              PushMark(tokens[i], PostIndent);
              SetOther(false);
              end;
            CaseTok,WhileTok, ForTok, WithTok:  begin
              PushMark(tokens[i], NoIndent);
              SetOther(false); SetOther(true);
              end;
            OfTok:
              if Terminate([CaseTok], PostIndent) then begin
                if TopToken in [RecordTok, SubRecordTok] then
                  PushMark(VariantBodyTok, PostIndent)
                else
                  PushMark(CaseBodyTok, PostIndent);
                SetOther(false);
                end
              else if Terminate([ArrayTok, FileTok, SetTok],
               PostIndent) then begin
                PushMark(StructBodyTok, PostIndent);
                SetOther(false);
                end
              else
                SetOther(true);
            DoTok: begin
              ign := Terminate([WhileTok, ForTok, WithTok], PostIndent);
              PushMark(DoTok, PostIndent);
              SetOther(false);
              end;
            IfTok: begin
              if i > 1 then begin
                if tokens[i - 1] = ElseTok then
                  ign := Terminate([ElseTok], PostIndent);{ fold else-if }
                end;
              PushMark(IfTok, NoIndent);
              SetOther(false); SetOther(true);
              end;
            ThenTok: begin
              ign := Terminate([IfTok], PreIndent);
              PushMark(ThenTok, PostIndent);
              SetOther(false);
              end;
            ElseTok: begin
              while Terminate([DoTok, ElseTok], PreIndent) do
                ;
              ign := Terminate([ThenTok], PreIndent);
              PushMark(ElseTok, PostIndent);
              SetOther(false);
              end;
            BeginTok: begin
              ign := Terminate([VarTok, ConstTok, TypeTok, LabelTok], PreIndent);
              PushMark(BeginTok, PostIndent);
              SetOther(false);
              end;
            EndTok: begin
              while Terminate([StructBodyTok, DoTok, ThenTok, ElseTok,
               CaseElmtTok, VariantElmtTok, VariantBodyTok], PreIndent) do
                ;
              ign := Terminate([CaseBodyTok, BeginTok, RecordTok], PreIndent);
              ign := Terminate([ProgramTok, ProcTok, FuncTok], PostIndent);
              SetOther(false);
              end;
            UntilTok: begin
              while Terminate([DoTok, ThenTok, ElseTok],
               PreIndent) do
                ;
              ign := Terminate([RepeatTok], PreIndent);
              SetOther(false); SetOther(true);
              end;
            ColonTok:
              if TopToken in [BeginTok, ThenTok, ElseTok, DoTok,
               RepeatTok] then begin
                { colon is stmnt label }
                if i = 1 then out := true;
                SetOther(false);
                end
              else if TopToken in
               [CaseBodyTok, RecordTok, SubRecordTok] then begin
                { colon is stmnt or record case label }
                PushMark(CaseElmtTok, PostIndent);
                SetOther(false);
                end
              else if TopToken = VariantBodyTok then begin
                { colon is variant case label }
                PushMark(VariantElmtTok, PostIndent);
                SetOther(false);
                end
              else
                SetOther(true);
            SemiTok: begin
              while Terminate([StructBodyTok, ThenTok, ElseTok, DoTok,
               CaseElmtTok, VariantElmtTok], PostIndent) do
                ;
              if TopToken <> LParenTok then
                SetOther(false);
              end;
            LParenTok: begin
              { only really care about parameter lists and variant cases }
              if TopToken = VariantElmtTok then
                PushMark(SubRecordTok, PostIndent)
              else if TopToken in [ProgramTok, ProcTok, FuncTok] then
                PushMark(LParenTok, NoIndent)
              else if TopToken in [LParenTok, SubRecordTok] then begin
                { nested parens must be recorded to keep things balanced }
                PushMark(LParenTok, NoIndent);
                SetOther(true);
                end;
              end;
            RParenTok: begin
              { terminate a variant field list if one is present }
              while Terminate([StructBodyTok, ElseTok,
               CaseElmtTok, VariantElmtTok, VariantBodyTok], PreIndent) do
                ;
              ign := Terminate([LParenTok, SubRecordTok], PreIndent);
              if TopToken in [LParenTok, SubRecordTok] then
                SetOther(true) { only the outermost paren is special };
              end;
            DirectTok: begin
              ign := Terminate([ProgramTok, ProcTok, FuncTok], PostIndent);
              SetOther(false);
              end;
            OtherTok:
              SetOther(true);
          end;
          i := i + 1;
          end;
        end;

      if out then CurInd := CurInd - IndentStep;
      Contin := cont = Yes;

      if TestFlg then
        writeln('...', InStat:1, ',', Contin:1, ',',
         CurInd:1, ',', NewInd:1, ')');

    end;                        { ScanTokens }

  { AdjustSource - adjust indent of any trailing comment on a line

    Parameters:
      l               source line
      CurInd          indent column for line
      ComInd          indent column for comment
  }

    procedure AdjustSource(var l: LineBuffer; CurInd, ComInd: LineIndex);
    var
      i: LineIndex;
      alt, n: integer;
    begin                       { AdjustSource }
      if TestFlg then
        writeln('AdjustSource(,', CurInd:1, ',', ComInd:1, ')');

      if ComInd > 1 then begin  { comment exists, not at start of line }
        { place comment at consistent indent }
        with l do begin
          alt := ConsistentIndent - (CurInd + ComInd - 1);
          if alt > 0 then begin
            for i := cnt downto ComInd do line[i + alt] := line[i];
            for i := ComInd + alt - 1 downto ComInd do line[i] := ' ';
            end
          else begin
            n := 0;
            i := ComInd;
            while (n > alt) and (line[i + n - 1] = ' ') do n := n - 1;
            alt := n;
            if alt < 0 then
              for i := ComInd to cnt do line[i + alt] := line[i];
            end;
          cnt := cnt + alt;
          end;
        end;
    end;                        { AdjustSource }

  { PutSource - output source line

    Parameters:
      f               output file
      l               source line
      ind             line indent
  }

    procedure PutSource(var f: text; var l: LineBuffer; ind: LineIndex);
    begin
      if TestFlg then begin
        write('PutSource(,'); WriteLine(output, l); writeln(',', ind:1, ')');
        end;
      with l do begin
        if pageflg then page(f);
        if cnt = 0 then
          writeln(f)
        else begin
          if ind > 1 then write(f, ' ':ind - 1);
          writeln(f, line:cnt);
          end;
        end;
    end;

  begin                         { ProcessFile }
    if TestFlg then begin
      write('ProcessFile(');
      WrtString(output, InputPtr); write(',');
      WrtString(output, OutputPtr); writeln(')');
      end;

    { open input file }

    AccArg(InputPtr, arg);
    reset(inp, arg.txt, '   ', flg);
    if flg < 0 then begin
      if not incl then Abort(NoInputMsg, arg);
      Warn(NoIncludeMsg, arg);
      goto 10;
      end;

    { open output file }

    if not IsNilCookie(OutputPtr) then begin
      AccArg(OutputPtr, arg);
      flg := 0;      
      rewrite(out, arg.txt, '   ', flg);
      if flg = - 1 then Abort(NoOutputMsg, arg);
      end;

    { reformat file }

    Indent := 1;
    InComment := false; ComIndent := 0;
    InStatement := false;

    while GetSource(inp, l) do begin
      ScanSource(l, k, InComment, NewInComment, ComIndent);
      if not IsNilCookie(OutputPtr) then begin
        ScanTokens(k, Stack, Indent, InStatement, Continuation,
         CurIndent, NewIndent);
        if Continuation or InComment then begin
          { preserve alignment among continuation lines }
          if (l.beg + Delta) > 0 then
            CurIndent := l.beg + Delta
          else
            CurIndent := 0;
          end;
        if not InComment then begin
          if NewInComment and (ComIndent > 1) then
            Delta := ConsistentIndent - (l.beg + ComIndent - 1)
          else if not Continuation then
            Delta := CurIndent - l.beg;
          end;
        AdjustSource(l, CurIndent, ComIndent);
        PutSource(out, l, CurIndent);
        Indent := NewIndent;
        end;
      InComment := NewInComment;
      end;

    if InComment or InStatement then begin
      AccArg(InputPtr, arg);
      if InComment then Warn(UntermComMsg, arg);
      if InStatement then Warn(UntermStmtMsg, arg);
      end;

    close(inp);
    if not IsNilCookie(OutputPtr) then close(out);
  10:
  end;                          { ProcessFile }

  procedure Reformat;
  var
    TempArg, OutputArg: ArgValue;
    done, status: boolean;
  begin                         { Reformat }
    done := false;
    repeat
      AccNode(InputNode, ReadAccess);
      with NodeTable[InputNode.num]^.blk[InputNode.idx] do begin
        if not IsNilCookie(next) then begin
          ProcessFile(lab, NilPtr, false);
          InputNode := next;
          end
        else begin
          ProcessFile(lab, TempPtr, false);
          if not IsNilCookie(OutputPtr) then begin
            AccArg(TempPtr, TempArg);
            AccArg(OutputPtr, OutputArg);
            FixTempOutput(TempArg, OutputArg, true, status);
            if not status then Abort(FixupMsg, OutputArg);
            end;
          done := true;
          end;
        end;
    until done;
  end;                          { Reformat }

begin                           { mainline }
  SetNilCookie(NilPtr);
  IndentStep := 2;
  ConsistentIndent := 33;
  Stack.cnt := 0;

  Init;
  csi;
  Reformat;
1:
  if error then exitst(4);
end.                            { mainline }