Скачиваний:
12
Добавлен:
01.05.2014
Размер:
22.67 Кб
Скачать
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.201434 б12oper.stt
  • #
    01.05.201425 б12relation.stt
  • #
    01.05.201483 б13resWord.stt
  • #
    01.05.201420 б12separ.stt
  • #
    01.05.201417.21 Кб12TetCompUnit.dcu
  • #
    01.05.201422.67 Кб12TetCompUnit.pas
  • #
    01.05.201422.6 Кб12TetCompUnit.~pas
  • #
    01.05.2014395 б13tjap.cnt
  • #
    01.05.201410.82 Кб13tjap.GID
  • #
    01.05.201419.59 Кб12tjap.hlp
  • #
    01.05.201415.17 Кб12tjap.hsc