{$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-}
{$IFDEF VER70}
{$P-,Q-,T-}
{$ENDIF}
unit
  A2Srv;

interface

uses
  tpString,
  DOS,
  AVars,
  ACmdLine,
  Table,
  InitAsm,
  InitSym;

procedure Initialize;
  {--  Initialize program and tables }

procedure GetLine;
  {--  Get one line from source file }

procedure GetField;
  {--  Starting at LinePtr, tryes to return next field in _Fld.
       Sets Found if sucessful. Moves LinePtr past field. }

procedure WriteError(MSG:String);
  {--  Writes error message to LST and CON }

procedure WriteWarning(MSG:String);
  {--  Writes warning message to LST and CON }

procedure ProgressReport;
  {--  Maintans reassuring msg. on screen }

procedure Header;
  {--  Prints Listing header }

procedure WriteLst(S : String);
  {--  Writes S to .LST }

procedure WriteFinal;
  {--  Writes final report rest }

implementation

procedure Initialize;
  {--  Initialize program and tables }
begin
  InitAsmTable;
  InitSymTable;
  ProcessCmdLine;
  LinesPerPage := LinesPerPage - 6;
  OpenFiles;
  Header;
end; { Initialize }

procedure GetLine;
  {--  Get one line from source file }
begin
  readln(InFile,InpLine);
  Inc(LineNum);
  NeedOffset := _None;
  DSFlag := FALSE;
  ObjLen := 0;
end; { GetLine }

procedure GetField;
  {--  Starting at LinePtr, tryes to return next field in _Fld.
       Sets Found if sucessful. Moves LinePtr past field. }
label
  CopyField, FindNext;
var
  StrGEnd : Integer;
begin
  { find next non-delimiter or tun off end }
  while ((LinePtr <= EndPtr) and (InpLine[LinePtr] in Delim)) do
    Inc(LinePtr);

  { if past end, not found }
  if LinePtr > EndPtr then begin
    Found := FALSE;
    exit;
  end;

  { strings terminated by ' }
  if InpLine[LinePtr] = '''' then begin
    StrGEnd := Pos('''',Copy(InpLine, LinePtr+1, 255))+LinePtr+1;
    if StrGEnd = 0 then
      goto FindNext;
    LinePtr2 := StrGEnd;
    goto CopyField;
  end;

FindNext:
  { otherwise, find next delimiter or go 1 past end }
  LinePtr2 := LinePtr;
  while ((LinePtr2 <= EndPtr) and NOT (InpLine[LinePtr2] in Delim)) do
    Inc(LinePtr2);

CopyField:
  { copy field }
  _Fld := Copy(InpLine, LinePtr, LinePtr2 - LinePtr);

  { move LinePtr past field, set found and return }
  LinePtr := LinePtr2;
  Found := TRUE;
end; { GetField }

function NameAndNumLine(Num: LongInt) : String;
var
  S : String;
begin
  S := Long2Str(Num);
  NameAndNumLine:= InFileName+'('+S+') ';
end; { NameAndNumLine }

procedure WriteError(MSG:String);
  {--  Writes error message to LST and CON }
begin
  Errs := Errs + 1;
  if DefaultOptions and ofOutputListing <> 0 then begin
    Writeln(LstFile,ErrString+NameAndNumLine(LineNum)+MSG);
  end;
  if DefaultOptions and ofSupressMsg = 0 then begin
    if DefaultOptions and ofDisplayErrLine <> 0 then
      Writeln(InpLine);
    Writeln(ErrString+NameAndNumLine(LineNum)+MSG);
  end;
end; { WriteError }

procedure WriteWarning(MSG:String);
  {--  Writes warning message to LST and CON }
begin
  if (DefaultOptions AND (ofWarningLev1 OR ofWarningLev2) <> 0) then begin
    Diag := Diag + 1;
    if (DefaultOptions and ofOutputListing <> 0) then begin
      Writeln(LstFile,WarnString+NameAndNumLine(LineNum)+MSG);
    end;
    if DefaultOptions and ofSupressMsg = 0 then begin
      if DefaultOptions and ofDisplayErrLine <> 0 then
        Writeln(InpLine);
      Writeln(WarnString+NameAndNumLine(LineNum)+MSG);
    end;
  end;
end; { WriteError }

procedure ProgressReport;
  {--  Maintans reassuring msg. on screen }
begin
{
  write(^M,PassName[Pass],' pass in progress. Lines processed ',LineNum:5);
}
end; { ProgressReport }

procedure Header;
  {--  Prints Listing header }
var
  YY, MM, DD, Day : Word;
  HH, MI, SS, Sec100 : Word;
begin
  if DefaultOptions and ofOutputListing <> 0 then begin
    GetDate(YY, MM, DD, Day);
    GetTime(HH, Mi, SS, Sec100);
    Write(LstFile,ProcTitle,^I'    ');
    Write(LstFile,MM:2,'/',DD:2,'/',YY:2,' ');
    Write(LstFile,HH:2,':',MI:2,':',SS:2,^I'    ');
    Writeln(LstFile,PageString+Long2Str(PageNum));
    Writeln(LstFile,InFileName);
    Writeln(LstFile);
    Writeln(LstFile);
    Writeln(LstFile);
    Writeln(LstFile);
  end;
end; { Header }

const
  NewPage : Boolean = FALSE;

procedure WriteLst(S : String);
  {--  Writes S to .LST }
var
  SL : Byte absolute S;
  I  : Byte;
begin
  if NewPage then begin
    NewPage := FALSE;
    Header;
  end;
  if DefaultOptions and ofOutputListing <> 0 then begin
    for I := 1 to SL do
      if S[I] < ' ' then begin
        case  S[I] of
          ^L  : begin
            Write(LstFile,^L);
            LLine := 1;
            Inc(PageNum);
            NewPage := TRUE;
          end;
          ^M : begin
            if S[I+1] = ^J then begin
              Writeln(LstFile);
              Inc(LLine);
              if LLine >= LinesPerPage then begin
                Write(LstFile,^L);
                LLine := 1;
                Inc(PageNum);
                Header;
              end;
            end else Write(LstFile,S[I]);
          end;
          ^J : ; { skip }
          else Write(LstFile,S[I]);
        end; { case }
      end else
        Write(LstFile,S[I]);
  end;
end; { WriteLst }

procedure WriteFinal;
  {--  Writes final report rest }
begin
  if DefaultOptions and ofOutputListing <> 0 then begin
    WriteLst(^M^J);
    WriteLst(Pad(ErrorMessages,20)+Long2Str(Errs)+^M^J);
    WriteLst(Pad(WarningMessages,20)+Long2Str(Diag)+^M^J);
    WriteLst(Pad(Passes,20)+Long2Str(Pass)+^M^J);
    WriteLst(Pad(Memory,20)+Long2Str(MemAvail div 1024)+'k');
    WriteLst(^M^J^M^J^M^J^L);
  end;
  if DefaultOptions and ofSupressMsg = 0 then begin
    Writeln(Pad(ErrorMessages,20)+Long2Str(Errs));
    Writeln(Pad(WarningMessages,20)+Long2Str(Diag));
    Writeln(Pad(Passes,20)+Long2Str(Pass));
    Writeln(Pad(Memory,20)+Long2Str(MemAvail div 1024)+'k');
    Writeln(^M^J);
  end;
end; { WriteFinal }

end.
