unit Declarations;

interface

procedure CompileProgram;

implementation

uses Common, Scaner, Statements, Identifiers;

procedure CompileDeclaration; forward;

function ConstExpression: Integer;
var Result: Integer;

  procedure CompileIdentifier;
  begin
    if FindIdent(Identifier) = nil then Error(ecUnknownIdent);
    if CurrentIdent^.IdClass = cConst then
      if CurrentIdent^.IdType = tInt
      then Result := CurrentIdent^.Data
      else Error(ecWrongType)
    else Error(ecConstExpected);
  end; { CompileIdentifier }

  procedure CompileBrackets;
  begin
    Result := ConstExpression;
    if ReadLexem <> opRightBracket then Error(ecRBExpected);
  end; { CompileBrackets }

  procedure Compile1st; { identifier constant () }
  begin
    case Lexem of
      ltIdentifier: CompileIdentifier;
      ltIntConst: Result := IntConst;
      ltCharConst: Result := Ord(CharConst);
      opLeftBracket: CompileBrackets;
    else Error(ecSyntaxError) end;
    ReadLexem;
  end; { Compile1st }

  procedure Compile2nd; { + - }
  begin
    case ReadLexem of
      opPlus : Compile2nd;
      opMinus: begin
        Compile2nd;
        Result := -Result;
      end;
      opNot: begin
        Compile2nd;
        if Result = 0 then Result := 1 else Result := 0;
      end;
    else Compile1st;
    end;
  end; { Compile2nd }

  procedure Compile3rd; { * / % }
  var
    Operator: opMul..opMod;
    Radical: Integer;
  begin
    Compile2nd;
    Radical := Result;
    while Lexem in [opMul..opMod] do begin
      Operator := Lexem;
      Compile2nd;
      case Operator of
        opMul: Radical := Radical * Result;
        opDiv: Radical := Radical div Result;
        opMod: Radical := Radical mod Result;
      end;
    end;
    Result := Radical;
  end; { Compile3rd }

  procedure Compile4th; { + - }
  var
    Operator: opPlus..opMinus;
    Radical: Integer;
  begin
    Compile3rd;
    Radical := Result;
    while Lexem in [opPlus, opMinus] do begin
      Operator := Lexem;
      Compile3rd;
      case Operator of
        opPlus: Inc(Radical, Result);
        opMinus: Dec(Radical, Result);
      end;
    end;
    Result := Radical;
  end; { Compile4th }

  procedure Compile5th; { > < == <> >= <= }
  var
    Operator: opGreater..opLessEqual;
    Radical: Integer;
  begin
    Compile4th;
    Radical := Result;
    while Lexem in [opGreater..opLessEqual] do begin
      Operator := Lexem;
      Compile4th;
      case Operator of
        opGreater     : if Radical > Result then Radical := 1 else Radical := 0;
        opLess        : if Radical < Result then Radical := 1 else Radical := 0;
        opEqual       : if Radical = Result then Radical := 1 else Radical := 0;
        opNotEqual    : if Radical <> Result then Radical := 1 else Radical := 0;
        opGreaterEqual: if Radical >= Result then Radical := 1 else Radical := 0;
        opLessEqual   : if Radical <= Result then Radical := 1 else Radical := 0;
      end;
    end;
    Result := Radical;
  end; { Compile5th }

  procedure Compile6th; { & | }
  var
    Operator: opAnd..opOr;
    Radical: Integer;
  begin
    Compile5th;
    Radical := Result;
    while Lexem in [opAnd..opOr] do begin
      Operator := Lexem;
      Compile5th;
      case Operator of
        opAnd: if (Radical <> 0) and (Result <> 0) then Radical := 1 else Radical := 0;
        opOr : if (Radical <> 0) or (Result <> 0) then Radical := 1 else Radical := 0;
      end;
    end;
    Result := Radical;
  end; { Compile6th }

begin
  Compile6th;
  PredLexem;
  ConstExpression := Result;
end; { ConstExpression }

procedure CompileVarDec;
var
  VarType: TType;
  VarName: TIdentStr;
  VarPtr: PIdentRec;
  DefStr: string[2];
  Count: Integer;

begin
  VarType := TType(Ord(tInt) + Ord(Lexem) - Ord(rwInt));
  if VarType = tChar then DefStr := 'db' else DefStr := 'dw';
  ReadLexem;
  while Lexem = ltIdentifier do begin
    VarName := Identifier;
    if ReadLexem = opLeftParent then begin
      VarPtr := AddIdent(VarName, cArray, VarType);
      VarPtr^.Data := ConstExpression;
      Write(VarFile, VarName, #9, DefStr, #9);
      if ReadLexem <> opRightParent then Error(ecRPExpected);
      if ReadLexem = opAssign then
        {$B+}
        if (VarType = tChar) and (ReadLexem = ltStrConst) then begin
        {$B-}
          Byte(StrConst[0]) := VarPtr^.Data;
          WriteLn(VarFile, '''', StrConst, '''');
          ReadLexem;
        end else begin
          PredLexem;
          for Count := 1 to VarPtr^.Data do begin
            Write(VarFile, ConstExpression);
            if Count < VarPtr^.Data
            then Write(VarFile, ',')
            else WriteLn(VarFile);
          end;
          ReadLexem;
      end else WriteLn(VarFile, VarPtr^.Data, ' dup (?)');
    end else begin
      AddIdent(VarName, cVar, VarType);
      Write(VarFile, VarName, #9, DefStr, #9);
      if Lexem = opAssign then begin
        WriteLn(VarFile, ConstExpression);
        ReadLexem;
      end else WriteLn(VarFile, '?');
    end;
  end;
  PredLexem;
end; { CompileVarDec }

procedure CompileConstDec;
var ConstName: TIdentStr;
begin
  while ReadLexem = ltIdentifier do begin
    ConstName := Identifier;
    if ReadLexem <> opAssign then Error(ecAssignExpected);
    AddIdent(ConstName, cConst, tInt)^.Data := ConstExpression;
  end;
  PredLexem;
end; { CompileConstDec }

procedure CompileProcDec;
var
  ProcName: TIdentStr;
  ProcType: TType;

  procedure CompileLocalDec;
  var VarType: TType;
  begin
      VarType := TType(Ord(tInt) + Ord(Lexem) - Ord(rwInt));
      while ReadLexem = ltIdentifier do begin
        AddIdent(Identifier, cVar, VarType);
        Write(DestFile, #9'LOCAL ', Identifier);
        case VarType of
          tInt, tWord: WriteLn(DestFile, ':WORD');
          tChar: WriteLn(DestFile, ':BYTE');
        end;
      end;
    WriteLn(DestFile);
    PredLexem;
  end; { CompileLocalDec }

  procedure CompileParamDec;
  var VarType: TType;
  begin
    ReadLexem;
    while Lexem <> opRightBracket do begin
      if not (Lexem in [rwInt..rwWord]) then Error(ecSyntaxError);
      VarType := TType(Ord(tInt) + Ord(Lexem) - Ord(rwInt));
      while ReadLexem = ltIdentifier do begin
        AddIdent(Identifier, cVar, VarType);
        Write(DestFile, ', ', Identifier);
        Inc(LocalTable^.Data);
        case VarType of
          tInt, tWord: Write(DestFile, ':WORD');
          tChar: Write(DestFile, ':BYTE');
        end;
      end;
    end;
  end; { CompileParamDec }

begin
  if ReadLexem in [rwInt..rwWord] then begin
    ProcType := TType(Ord(tInt) + Ord(Lexem) - Ord(rwInt));
    ReadLexem;
  end else ProcType := tVoid;
  if Lexem <> ltIdentifier then Error(ecIdentExpected);
  ProcName := Identifier;
  LocalTable := AddIdent(ProcName, cProc, ProcType);
  LocalTable^.Data := 0;
  Write(DestFile, #13#10, Identifier, #9'PROC NEAR');
  if ReadLexem = opLeftBracket then CompileParamDec else PredLexem;
  WriteLn(DestFile);
  while ReadLexem in [rwInt..rwWord] do CompileLocalDec;
  if Lexem <> rwBegin then PredLexem;
  while ReadLexem <> rwEnd do CompileStatement;
  WriteLn(DestFile, '_Exit:'#9'ret');
  WriteLn(DestFile, ProcName, #9'ENDP');
  ClearLocalData;
end; { CompileProcDec }

procedure ProcDeclare;
var
  ProcType: TType;
  procedure CompileParamDec;
  begin
    ReadLexem;
    while Lexem <> opRightBracket do begin
      if not (Lexem in [rwInt..rwWord]) then Error(ecSyntaxError);
      while ReadLexem = ltIdentifier do Inc(GlobalTable^.Data);
    end;
  end; { CompileParamDec }
begin
  if ReadLexem in [rwInt..rwWord] then begin
    ProcType := TType(Ord(tInt) + Ord(Lexem) - Ord(rwInt));
    ReadLexem;
  end else ProcType := tVoid;
  if Lexem <> ltIdentifier then Error(ecIdentExpected);
  AddIdent(Identifier, cProc, ProcType)^.Data := 0;
  if ReadLexem = opLeftBracket then CompileParamDec else PredLexem;
end; { ProcDeclare }

procedure CompileExtern;
var ProcName: TIdentStr;
procedure VarExtern;
var
  VarType: TType;
  VarName: TIdentStr;
  DefStr: string[5];
begin
  VarType := TType(Ord(tInt) + Ord(Lexem) - Ord(rwInt));
  case VarType of
    tInt, tWord: DefStr := ':WORD';
    tChar: DefStr := ':BYTE';
    else Error(ecWrongType);
  end;
  ReadLexem;
  while Lexem = ltIdentifier do begin
    VarName := Identifier;
    if ReadLexem = opLeftParent then begin
      AddIdent(VarName, cArray, VarType)^.Data := ConstExpression;
      if ReadLexem <> opRightParent then Error(ecRPExpected);
      ReadLexem
    end else AddIdent(VarName, cVar, VarType);
    WriteLn(DestFile, #9'EXTRN ', VarName, ':', DefStr);
  end;
  PredLexem;
end; { VarExtern }
begin
  case ReadLexem of
    rwInt..rwWord: VarExtern;
    rwProc: begin
      ProcDeclare;
      WriteLn(DestFile, #9'EXTRN ', GlobalTable^.Name, ':NEAR');
    end;
  else Error(ecSyntaxError);
  end;
end; { CompileExtern }

procedure CompilePublic;
var
  IdentPtr, OldPtr: PIdentRec;
begin
  OldPtr := GlobalTable;
  case ReadLexem of
    rwInt..rwWord: CompileVarDec;
    rwProc: CompileProcDec;
  else Error(ecSyntaxError);
  end;
  IdentPtr := GlobalTable;
  while IdentPtr <> OldPtr do begin
    WriteLn(DestFile, #9'PUBLIC ', IdentPtr^.Name);
    IdentPtr := IdentPtr^.Prev;
  end;
end; { CompilePublic }

procedure CompileInclude;
var
  ASourceFileName: string[12];
  ALine, AColumn: Word;
  APos, ASavePos: LongInt;
begin
  while ReadLexem = ltStrConst do begin
    APos := FilePos(SourceFile);
    Close(SourceFile);
    ASourceFileName := SourceFileName;
    ALine := Line;
    AColumn := Column;
    ASavePos := SavePos;
    SourceFileName := StrConst;
    Line := 1;
    Column := 1;
    SavePos := 0;
    Assign(SourceFile, SourceFileName);
    Reset(SourceFile);
    while ReadLexem <> ltEmpty do CompileDeclaration;
    Close(SourceFile);
    SourceFileName := ASourceFileName;
    Line := ALine;
    Column := AColumn;
    SavePos := ASavePos;
    Assign(SourceFile, SourceFileName);
    Reset(SourceFile);
    Seek(SourceFile, APos);
  end;
  PredLexem;
end; { CompileInclude }

procedure CompileDeclaration;
begin
  case Lexem of
    rwConst  : CompileConstDec;
    rwInt..
    rwChar   : CompileVarDec;
    rwProc   : CompileProcDec;
    rwExtern : CompileExtern;
    rwPublic : CompilePublic;
    rwInclude: CompileInclude;
  else Error(ecSyntaxError) end;
end; { CompileDeclaration }

procedure CompileProgram;
begin
  while ReadLexem <> ltEmpty do CompileDeclaration;
  WriteLn(DestFile, #13#10#9'INCLUDE var.asm');
  WriteLn(DestFile, #13#10#9'END');
end; { CompileProgram }

end.