Скачиваний:
14
Добавлен:
01.05.2014
Размер:
23 Кб
Скачать
☆
unit TetCompUnit;

interface

uses Classes,SysUtils;
{Тетрады}
const
        COMVAR = 1;
        COMEQU = 2;
        COMADD = 3;
        COMSUB = 4;
        COMMUL = 5;
        COMWRITE = 6;
        COMCL = 7;
        COMCLE = 8;
        COMCE = 9;
        COMCGE = 10;
        COMCG = 11;
        COMCNE = 12;
        COMJF = 13;
        
        COMDEFL = 14;
        COMJMPL = 15;
        COMJMP = 16;
        COMJFL = 17;
        COMDIV = 18;
        COMAND = 19;
        COMOR = 20;
        COMNOT = 21;
        COMSHL = 22;
        COMSHR = 23;

type
        TTetCommand = record
                ComType:integer;
                Arg1,Arg2:string;
        end;

type
  TVarTable = class(TObject)

  end;
 {Основной класс перевода тетрад в ассемблер}
type
  TTetCompiler = class(TObject)

    procedure Reset;
    procedure Compile;
    procedure CompileLine(TetLine:string;Number:integer);
public
    LinesIn: TStrings;
    LinesOut: TStrings;
    LinesData: TStrings;
    LinesProg: TStrings;
    VarTable:TVarTable;
    LabelCounter:integer;

    
    function GetVarBit(Variable:string):integer;
    procedure AddVariable(Variable:string;Bits:integer);
public
    Variables:TStrings;
    VarBits:array[0..1000-1] of integer;
  end;

var
  TetCompiler: TTetCompiler;

implementation


function TTetCompiler.GetVarBit(Variable:string):integer;
var index:integer;
begin
        index:=Variables.IndexOf(Variable);
        if (index>=0) then
                GetVarBit:=VarBits[index]
        else
                GetVarBit:=-1;
end;

procedure TTetCompiler.AddVariable(Variable:string;Bits:integer);
begin
        Variables.Add(Variable);
        VarBits[Variables.Count-1]:=Bits;
end;

procedure TTetCompiler.Reset;
begin

        LinesIn:= TStringList.Create;
        LinesOut:=TStringList.Create;
        LinesData:= TStringList.Create;
        LinesProg:=TStringList.Create;
        Variables := TStringList.Create;
        LabelCounter:=0;
end;

procedure TTetCompiler.Compile;
var Line:integer;
begin
        for Line:=1 to LinesIn.Count do
        begin
                CompileLine(LinesIn.Strings[Line-1],Line);
        end;
        //Stack definitions
        LinesOut.Add('PROG_STACK SEGMENT STACK ''Stack'' ; стек приложения');
        LinesOut.Add('DW       16384 DUP (?)');
        LinesOut.Add('_false equ 0');
        LinesOut.Add('_true equ 1');

        LinesOut.Add('PROG_STACK ENDS');
        LinesOut.Add('');

        LinesOut.Add('DATA      SEGMENT            ; сегмент данных');
        //Global definitions
        LinesOut.Add('StringWaitForKey   db   13,10,''Press any key to exit...'',13,10,''$''        ; строка для вывода в конце работы программы');
        LinesOut.Add('number_string   db   ''+00000'',''$''                                         ; строка для вывода числа ');
        LinesOut.AddStrings(LinesData);

        LinesOut.Add('DATA      ENDS');
        LinesOut.Add('');

        LinesOut.Add('CODE      SEGMENT             ; сегмент кода');
        LinesOut.Add('ASSUME CS:CODE, DS:DATA, SS:PROG_STACK');
        LinesOut.Add(';Фунция конвертирования числа (в регистре AX) в строку и вывод на экран');
        LinesOut.Add('WriteAX PROC NEAR');
        LinesOut.Add('   push bp');
        LinesOut.Add('   push cx');
        LinesOut.Add('   push dx');
        LinesOut.Add('   push bx');
        LinesOut.Add('   mov  bp,5');
        LinesOut.Add('   mov  bx,1');
        LinesOut.Add('   cmp  ax,0');
        LinesOut.Add('   jge  label_0              ; если число отрицательное');
        LinesOut.Add('   neg  bx');
        LinesOut.Add('   neg  ax');
        LinesOut.Add('label_0:');
        LinesOut.Add('   mov  cx,10                 ; первая цифра числа');
        LinesOut.Add('   mov  dx,0');
        LinesOut.Add('   div  cx');
        LinesOut.Add('   mov  dh,0');
        LinesOut.Add('   add  dx,48');
        LinesOut.Add('   mov  [number_string+bp],dl');
        LinesOut.Add('   sub  bp,1');
        LinesOut.Add('loop_1:                       ; вторая и последующие цифры');
        LinesOut.Add('   mov  dx,0');
        LinesOut.Add('   div  cx');
        LinesOut.Add('   cmp  dl,0');
        LinesOut.Add('   je   label_1');
        LinesOut.Add('   mov  dh,0');
        LinesOut.Add('   add  dx,48');
        LinesOut.Add('   mov  [number_string+bp],dl');
        LinesOut.Add('   sub  bp,1');
        LinesOut.Add('   jmp  loop_1');
        LinesOut.Add('label_1:');
        LinesOut.Add('   cmp  bx,-1');
        LinesOut.Add('   jne  label_2');
        LinesOut.Add('   mov  [number_string+bp],''-''');
        LinesOut.Add('   sub  bp,1');
        LinesOut.Add('label_2:');
        LinesOut.Add('   add  bp,1');
        LinesOut.Add('   mov  DX,OFFSET number_string');
        LinesOut.Add('   add  dx,bp');
        LinesOut.Add('   mov  AH,9');
        LinesOut.Add('   int  21H');
        LinesOut.Add('   pop bx ');
        LinesOut.Add('   pop dx ');
        LinesOut.Add('   pop cx ');
        LinesOut.Add('   pop bp');
        LinesOut.Add('   RET');
        LinesOut.Add('WriteAX ENDP');
        LinesOut.Add('');
        LinesOut.Add('Main      PROC  FAR   ; Основная функция');

        LinesOut.Add('  push  DS            ; Сохранение адреса начала PSP в стеке');
        LinesOut.Add('  sub   AX,AX         ; для последующего восстановления по');
        LinesOut.Add('  push  AX            ; команде ret, завершающей процедуру.');
        LinesOut.Add('  mov   AX,DATA       ; Загрузка сегментного');
        LinesOut.Add('  mov   DS,AX         ; регистра данных.');
        LinesOut.Add('  push  CX');
        LinesOut.Add('  push  DX');

        LinesOut.AddStrings(LinesProg);

        LinesOut.Add('  mov   DX,OFFSET	StringWaitForKey     ; Вывод на экран строки');
        LinesOut.Add('  mov   AH,9');
        LinesOut.Add('  int   21h           ; Вызов функции DOS по прерыванию');

	LinesOut.Add('  mov	AH,0');
	LinesOut.Add('  int	16H         ; ожидаем нажатие клавиши');

        LinesOut.Add('');
        LinesOut.Add('  pop   DX');
        LinesOut.Add('  pop   CX');
        LinesOut.Add('  RET');
        LinesOut.Add('Main    ENDP');
        LinesOut.Add('');
        LinesOut.Add('CODE    ENDS');
        LinesOut.Add('        END Main');



end;

function ArgNumToName(Arg:string):string;
var tmp:string;
begin
        tmp:=Arg;
        if length(Arg)>0 then
        if ((Arg[1]='(') and (Arg[length(Arg)]=')')) then
        begin
                tmp[1]:='_';
                tmp[length(Arg)]:='_';
        end;
        ArgNumToName:=tmp;
end;

procedure GetCommandInString(s:string; var TetCommand:TTetCommand);
var     shift,zptpos,ind:integer;
begin
        //Get Command
        if (AnsiStrPos(pchar(S), pchar('VAR '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMVAR;
        end;
        if (AnsiStrPos(pchar(S), pchar('EQU '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMEQU;
        end;
        if (AnsiStrPos(pchar(S), pchar('ADD '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMADD;
        end;
        if (AnsiStrPos(pchar(S), pchar('SUB '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMSUB;
        end;
        if (AnsiStrPos(pchar(S), pchar('MUL '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMMUL;
        end;
        if (AnsiStrPos(pchar(S), pchar('WRITE '))<>nil) then
        begin
                shift:=6;
                TetCommand.ComType:=COMWRITE;
        end;
        if (AnsiStrPos(pchar(S), pchar('CL  '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMCL;
        end;
        if (AnsiStrPos(pchar(S), pchar('CLE '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMCLE;
        end;
        if (AnsiStrPos(pchar(S), pchar('CE  '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMCE;
        end;
        if (AnsiStrPos(pchar(S), pchar('CGE '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMCGE;
        end;
        if (AnsiStrPos(pchar(S), pchar('CG  '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMCG;
        end;
        if (AnsiStrPos(pchar(S), pchar('CNE '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMCNE;
        end;
        if (AnsiStrPos(pchar(S), pchar('JF  '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMJF;
        end;
        if (AnsiStrPos(pchar(S), pchar('DEFL '))<>nil) then
        begin
                shift:=5;
                TetCommand.ComType:=COMDEFL;
        end;
        if (AnsiStrPos(pchar(S), pchar('JMPL '))<>nil) then
        begin
                shift:=5;
                TetCommand.ComType:=COMJMPL;
        end;
        if (AnsiStrPos(pchar(S), pchar('JMP '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMJMP;
        end;
        if (AnsiStrPos(pchar(S), pchar('JFL '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMJFL;
        end;
        if (AnsiStrPos(pchar(S), pchar('DIV '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMDIV;
        end;
        if (AnsiStrPos(pchar(S), pchar('AND '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMAND;
        end;
        if (AnsiStrPos(pchar(S), pchar('OR  '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMOR;
        end;
        if (AnsiStrPos(pchar(S), pchar('NOT '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMNOT;
        end;
        if (AnsiStrPos(pchar(S), pchar('SHL '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMSHL;
        end;
        if (AnsiStrPos(pchar(S), pchar('SHR '))<>nil) then
        begin
                shift:=4;
                TetCommand.ComType:=COMSHR;
        end;
        //Get Arg1
        zptpos:=Pos(',',S);
        TetCommand.Arg1:=Copy(S,shift+1,zptpos-shift-1);
        TetCommand.Arg2:=Copy(S,zptpos+1,length(S)-zptpos);
        TetCommand.Arg1:=ArgNumToName(TetCommand.Arg1);
        TetCommand.Arg2:=ArgNumToName(TetCommand.Arg2);

end;

procedure TTetCompiler.CompileLine(TetLine:string;Number:integer);
var     TetCommand:TTetCommand;
        TMPstr,TMPvar:string;
        Bits:integer;
        AXAL:string;
begin
       GetCommandInString(TetLine,TetCommand);
       if (TetCommand.ComType=COMVAR) then
       begin
            LinesData.Add('');
            LinesData.Add(';;; '+TetLine);
            LinesData.Add('');
       end
       else
       begin
            LinesProg.Add('');
            LinesProg.Add(';;; '+TetLine);
            LinesProg.Add('');
       end;
       LinesProg.Add('label_'+inttostr(Number)+'_:');
       if length(TetCommand.Arg1)>0 then
       if (TetCommand.Arg1[1] in['A'..'Z', 'a'..'z']) then
          TetCommand.Arg1:='_'+TetCommand.Arg1;
       if length(TetCommand.Arg2)>0 then
       if (TetCommand.Arg2[1] in['A'..'Z', 'a'..'z']) then
          TetCommand.Arg2:='_'+TetCommand.Arg2;

       case TetCommand.ComType of
       COMVAR:  begin   {объявление перем}
                        AddVariable(TetCommand.Arg1,16);
                        LinesData.Add(TetCommand.Arg1+'   DW   1');
                end;

       COMEQU:  begin   {присваивание перем}
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   '+TetCommand.Arg2+',AX');
                end;
       COMADD:  begin   {сложение}
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  add   AX,CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMSUB:  begin   {вычитание}
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  sub   AX,CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMMUL:  begin   {умножение}
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  mul   CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMWRITE:begin   {вывод на экран}
                        if (TetCommand.Arg1[1]='''') then
                        begin
                                TMPstr:='string_'+inttostr(LabelCounter);
                                LinesData.Add(TMPstr+'   DB   '+TetCommand.Arg1+',''$''');
                                inc(LabelCounter);
                                LinesProg.Add('  mov   DX,OFFSET '+TMPstr);
                                LinesProg.Add('  mov   AH,9');
                                LinesProg.Add('  int   21H');
                        end;
                        if (TetCommand.Arg1='#13#10') then
                        begin
                                TMPstr:='string_'+inttostr(LabelCounter);
                                LinesData.Add(TMPstr+'   DB   13,10,''$''');
                                inc(LabelCounter);
                                LinesProg.Add('  mov   DX,OFFSET '+TMPstr);
                                LinesProg.Add('  mov   AH,9');
                                LinesProg.Add('  int   21H');
                        end;
                        if (TetCommand.Arg1[1]='_') then   {вывод нашей переменной, см. наше преобразование имен}
                        begin
                                LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                                LinesProg.Add('  call  WriteAX');
                        end;
                        if (TetCommand.Arg1[1] in ['0'..'9','-','+']) then
                        begin
                                LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                                LinesProg.Add('  call  WriteAX');
                        end;
                end;
{What is DW 0}
       COMCL:   begin   {less}
                        TMPstr:='_'+inttostr(Number)+'_';
                        LinesData.Add(TMPstr+'   DW   0');
                        LinesProg.Add('  mov   '+TMPstr+',1');
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,CX');
                        LinesProg.Add('  jl    label_'+inttostr(Number)+'__');
                        LinesProg.Add('  mov   '+TMPstr+',0');
                        LinesProg.Add('label_'+inttostr(Number)+'__:');
                end;
       COMCLE:   begin  {less or equ}
                        TMPstr:='_'+inttostr(Number)+'_';
                        LinesData.Add(TMPstr+'   DW   0');
                        LinesProg.Add('  mov   '+TMPstr+',1');
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,CX');
                        LinesProg.Add('  jle   label_'+inttostr(Number)+'__');
                        LinesProg.Add('  mov   '+TMPstr+',0');
                        LinesProg.Add('label_'+inttostr(Number)+'__:');
                end;
       COMCE:   begin   {equal}
                        TMPstr:='_'+inttostr(Number)+'_';
                        LinesData.Add(TMPstr+'   DW   0');
                        LinesProg.Add('  mov   '+TMPstr+',1');
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,CX');
                        LinesProg.Add('  je    label_'+inttostr(Number)+'__');
                        LinesProg.Add('  mov   '+TMPstr+',0');
                        LinesProg.Add('label_'+inttostr(Number)+'__:');
                end;
       COMCGE:   begin  {greater or equ}
                        TMPstr:='_'+inttostr(Number)+'_';
                        LinesData.Add(TMPstr+'   DW   0');
                        LinesProg.Add('  mov   '+TMPstr+',1');
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,CX');
                        LinesProg.Add('  jge   label_'+inttostr(Number)+'__');
                        LinesProg.Add('  mov   '+TMPstr+',0');
                        LinesProg.Add('label_'+inttostr(Number)+'__:');
                end;
       COMCG:   begin   {greater}
                        TMPstr:='_'+inttostr(Number)+'_';
                        LinesData.Add(TMPstr+'   DW   0');
                        LinesProg.Add('  mov   '+TMPstr+',1'); {consider condition is TRUE}
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,CX');
                        LinesProg.Add('  jg    label_'+inttostr(Number)+'__');
                        LinesProg.Add('  mov   '+TMPstr+',0');  {no, condition is FALSE}
                        LinesProg.Add('label_'+inttostr(Number)+'__:');
                end;
       COMCNE:   begin  {not equal}
                        TMPstr:='_'+inttostr(Number)+'_';
                        LinesData.Add(TMPstr+'   DW   0');
                        LinesProg.Add('  mov   '+TMPstr+',1');
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,CX');
                        LinesProg.Add('  jne   label_'+inttostr(Number)+'__');
                        LinesProg.Add('  mov   '+TMPstr+',0');
                        LinesProg.Add('label_'+inttostr(Number)+'__:');
                end;
       COMJF:   begin   {if Arg2 = 0 then goto label_Arg1 || use to check preceding condition}
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,0');
                        LinesProg.Add('  je    label'+TetCommand.Arg1);
                end;
       COMDEFL: begin
                        LinesProg.Add(TetCommand.Arg1+':');
                end;
       COMJMPL: begin
                        LinesProg.Add('   jmp '+TetCommand.Arg1);
                end;
       COMJMP: begin
                        LinesProg.Add('   jmp '+TetCommand.Arg1);
                end;
       COMJFL: begin    {pascal label}
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg2);
                        LinesProg.Add('  cmp   AX,0');
                        LinesProg.Add('  je    '+TetCommand.Arg1);
                end;
       COMDIV:  begin
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  mov   DX,0');
                        LinesProg.Add('  div   CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMAND:  begin
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  and   AX,CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMOR:  begin
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  or    AX,CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMNOT:  begin
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,1');
                        LinesProg.Add('  sub   CX,AX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,CX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMSHL:  begin
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  shl    AX,CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       COMSHR:  begin
                        LinesProg.Add('  mov   AX,'+TetCommand.Arg1);
                        LinesProg.Add('  mov   CX,'+TetCommand.Arg2);
                        LinesProg.Add('  shr    AX,CX');
                        LinesProg.Add('  mov   _'+inttostr(Number)+'_,AX');

                        LinesData.Add('_'+inttostr(Number)+'_   DW   1');
                end;
       end;
       //LinesProg.Add(TetCommand.Arg1+' '+TetCommand.Arg2);
end;


end.

Соседние файлы в папке compiler
  • #
    01.05.201425 б14relation.stt
  • #
    01.05.201483 б15resWord.stt
  • #
    01.05.201420 б14separ.stt
  • #
    01.05.201423 Кб14TetCompUnit.~pas
  • #
    01.05.201417 Кб14TetCompUnit.dcu
  • #
    01.05.201423 Кб14TetCompUnit.pas
  • #
    01.05.2014395 б15tjap.cnt
  • #
    01.05.201411 Кб15tjap.GID
  • #
    01.05.201420 Кб14tjap.hlp
  • #
    01.05.201415 Кб14tjap.hsc
  • #
    01.05.201459 б14type.stt