procedure SkipBlanks;
  begin
    while CurrChar = Blank do
      GetChar;
  end;

procedure GetCommentValue;
  begin
    SkipBlanks;
    CommentValue := '';
    while KCount > 0 do
     begin
      if CurrChar = '}' then
        KCount := 0
      else
      if ((CurrChar = '*') and (NextChar = ')')) then
       begin
        KCount := 0;
        GetChar;
       end
      else
       begin
        if length (CommentValue) < 128 then
          CommentValue := CommentValue + CurrChar;
        GetChar;
       end;
     end;
  end;

procedure ProcDirective;
  begin
    GetChar;
    if ((CurrChar = 'I')
      and (not (NextChar in ['+', '-']))
      and (IncStart >= CodeInt [ICi])) then
     begin
      GetChar;
      GetCommentValue;
      IncName := Squeeze (CommentValue, Blank);
      if (pos (':', IncName) = 0) then
        IncName := 'A:' + IncName;
      if (pos ('.', IncName) = 0) then
        IncName := IncName + '.PAS';
      WriteFileLine (IncName);
      if DiskFile (IncName) then
       begin
        PrintLine;
        IncOn := true;
        assign (IncFile, IncName);
        reset (IncFile);
       end
      else
       begin
        write ('   *** FILE NOT FOUND ***');
        WriteFileLine (InName);
       end;
     end
    else
     GetCommentValue;
  end;

procedure GetCodeNumber;
  var
    X, Y, Z: integer;
  begin
    X := 1;
    while ((X <= length (CommentValue))
      and (not (CommentValue [X] in ['0'..'9']))) do
      X := succ (X);
    Y := X;
    while ((Y <= length (CommentValue))
      and (CommentValue [Y] in ['0'..'9'])) do
      X := succ (X);
    if Y = X then
      CodeNumber := 0
    else
      val (copy (CommentValue, X, Y - X), CodeNumber, Z);
  end;

procedure ProcFormat;
  begin
    FormatOnLine := true;
    GetChar;
    CodeWork := '';
    if CurrChar in ['A'..'Z'] then
     begin
      CodeWork := CurrChar;
      GetChar;
      if CurrChar in ['A'..'Z', '+', '-'] then
       begin
        CodeWork := CodeWork + CurrChar;
        GetChar;
       end;
     end;
    GetCommentValue;
    if CodeWork = 'PA' then
      LineCt := LastLine + 1
    else
    if CodeWork = 'CP' then
     begin
      GetCodeNumber;
      if (LineCt + CodeNumber) >= LastLine then
        LineCt := LastLine + 1;
     end
    else
    if CodeWork = 'L-' then
      PrintingLines := false
    else
    if CodeWork = 'L+' then
      PrintingLines := true
    else
     begin
      CodeIndex := 1;
      while ((CodeIndex <= CodeNum)
        and (Code [CodeIndex] <> CodeWork)) do
        CodeIndex := succ (CodeIndex);
      if CodeIndex <= CodeNum then
       begin
        case CodeType [CodeIndex] of
          'B':
           begin
            if length (CommentValue) = 0 then
              CodeBool [CodeIndex]
                := not CodeBool [CodeIndex]
            else
            if CommentValue [1] in ['T', 'Y', '+'] then
              CodeBool [CodeIndex] := true
            else
            if CommentValue [1] in ['F', 'N', '-'] then
              CodeBool [CodeIndex] := false
            else
              CodeBool [CodeIndex]
                := not CodeBool [CodeIndex];
           end;
          'I':
           begin
            GetCodeNumber;
            CodeInt [CodeIndex] := CodeNumber;
           end;
          'S':
            CodeStr [CodeIndex] := CommentValue;
        end; (* of case CodeType *)
       end; (* of CodeIndex <= CodeNum *)
     end; (* of if CodeWork else *)
    Compute;
  end;

procedure ProcComment;
  begin
    KCount := 1;
    if CurrChar = '*' then
      IncStart := LastCI
    else
      IncStart := CurrCI;
    GetChar;
    case CurrChar of
      '$': ProcDirective;
      '.': ProcFormat;
      else
        GetCommentValue;
    end;
    GetChar;
  end;

procedure ProcStrLit;
  begin
    repeat
      GetChar;
      if ((CurrChar = Quote) and (NextChar = Quote)) then
       begin
        GetChar;
        GetChar;
       end
    until CurrChar = Quote;
    GetChar;
  end;

procedure GetWord;
  begin
    Word := CurrChar;
    GetChar;
    if Word [1] in IdStartChars then
     begin
      while CurrChar in IdChars do
       begin
        Word := Word + CurrChar;
        GetChar;
       end;
     end;
  end;

procedure ProcWord;
  begin
    SkipBlanks;
    if CurrChar = '(' then
      GetChar;
    if (((LastChar = '(') and (CurrChar = '*'))
      or (CurrChar = '{')) then
      ProcComment
    else
    if CurrChar = Quote then
     begin
      ProcStrLit;
     end
    else
    if CurrChar <> EndFile then
     begin
      GetWord;
      if ((SXOpen)
        and (Word [1] in IDStartChars)) then
       begin
        if ((SXOption = 'A')
          or (Word [1] = '_')
          or (length (Word) > 10)) then
          writeln (SXFile, SeqCt:5, ',', Word)
        else
         begin
          RsvIndex := RsvPtr [ord (Word [1]) - 64];
          while ((RsvIndex <= 144)
            and (Word > ReservedWord [RsvIndex])) do
            RsvIndex := succ (RsvIndex);
          if Word <> ReservedWord [RsvIndex] then
            writeln (SXFile, SeqCt:5, ',', Word);
         end;
       end;
      if ((Word = 'BEGIN') or (Word = 'CASE')) then
        BCount := succ (BCount)
      else
      if Word = 'END' then
        if BCount > 0 then
          BCount := pred (BCount);
     end;
  end;
