Курсовая работа. / РЯП_Ксю / Other / Bosk_tjp / proga / src / USTACK

unit uStack;
interface
const
keywords: array[0..28] of String[8] =
('ALT', 'AND', 'ARRAY', 'BEGIN', 'BOOLEAN', 'CON', 'CONST', 'DIV',
'ELSE', 'END', 'FALSE', 'GOTO', 'IF', 'INV', 'INTEGER', 'LABEL', 'MOD',
'NOT', 'OF', 'OR', 'PROGRAM', 'READ', 'REPAET', 'SIZE', 'TRUE', 'TYPE',
'UNTIL', 'VAR', 'WRITE');

type
Tokens = String[8];
tList=^tNode;
tNode= record
value1: Tokens;
value2: Tokens;
token: Tokens;
next: tList;
end;
tTable=^tRow;
tRow= record
num: Word;
id: String;
col1: Tokens;
col2: Tokens;
col3: Tokens;
col4: Tokens;
next: tTable;
end;

var
typeTable, varTable, constTable, labelTable,
matrTable, hTable: tTable;
f_in: Text;
c: Char;

function toUpperCase(str_in: Tokens): Tokens;

function CreateList: tList;
procedure AddElem(var list: tList; value1, value2: String; token: Tokens);
procedure DelElems(var list: tList; num: Byte);
procedure getValue(var v1, v2: String; list: tList; num: Byte);
procedure WriteStack(list: tList);

function CreateTable(num: Word): tTable;
procedure AddRow(var list: tTable; id: String; col1, col2, col3, col4: Tokens);
procedure DelRow(var list: tTAble);
procedure DelHRow;
function SearchId(list: tTable; id: String): tTable;
function isExist(id: String): tTable;


implementation

function toUpperCase(str_in: Tokens): Tokens;
var
j: Byte;
begin
for j := 1 to Length(str_in) do
str_in[j] := UpCase(str_in[j]);
toUpperCase := str_in;
end;

function CreateList: tList;
var
p: tList;
begin
p := nil;
CreateList:=p;
end;

procedure AddElem(var list: tList; value1,value2: String; token: Tokens);
var
p: tList;
begin
new(p);
p^.token := token;
p^.value1 := value1;
p^.value2 := value2;
p^.next := list;
list:=p;
end;

procedure DelElems(var list: tList; num: Byte);
var
p: tList;
i: Byte;
begin
for i := 1 to num do begin
p := list;
list := list^.next;
Dispose(p);
end;
end;

procedure getValue(var v1, v2: String; list: tList; num: Byte);
var
p: tList;
i: Byte;
begin
i := 1;
while i <> num do begin
list := list^.next;
Inc(i)
end;
v1 := list^.value1;
v2 := list^.value2;
end;

procedure WriteStack(list: tList);
var
p: tList;
begin
repeat
Write(list^.token,'|');
list := list^.next;
until list = nil;
end;

function CreateTable(num: Word): tTable;
var
p: tTable;
begin
new(p);
p^.num := num;
p^.id := '';
p^.col1 := '';
p^.col2 := '';
p^.col3 := '';
p^.col4 := '';
p^.next := nil;
CreateTable:=p;
end;

procedure AddRow(var list: tTable; id: String; col1, col2, col3, col4: Tokens);
var
p: tTable;
num: Word;
begin
if list = nil then
num := 1
else
num := list^.num + 1;
new(p);

p^.num := num;
p^.id := toUpperCase(id);
p^.col1 := col1;
p^.col2 := col2;
p^.col3 := col3;
p^.col4 := col4;
p^.next := list;
list:=p;
end;

procedure DelRow(var list: tTable);
var
p: tTable;
begin
p := list;
list := list^.next;
Dispose(p);
end;

procedure DelHRow;
var
p: tTable;
begin
while hTable^.num <> 1200 do begin
p := hTable;
hTable := hTable^.next;
Dispose(p);
end
end;

function SearchId(list: tTable; id: String): tTable;
begin
SearchId := nil;
while list <> nil do begin
if list^.id = toUpperCase(id) then begin
SearchId := list;
break
end;
list := list^.next
end;
end;

function isExist(id: String): tTable;
var
p: tTable;
begin
(*Fix tmp add*) id := toUpperCase(id);

p := SearchId(typeTable,id);
if (p <> nil) then isExist := p
else begin
p := SearchId(constTable,id);
if (p <> nil) then isExist := p
else begin
p := SearchId(varTable,id);
if (p <> nil) then isExist := p
else begin
p := SearchId(labelTable,id);
if (p <> nil) then isExist := p
else begin
p := SearchId(matrTable,id);
if (p <> nil) then isExist := p
else begin
p := SearchId(hTable,id);
if (p <> nil) then isExist := p
else
isExist := nil
end
end
end
end
end
end;

end .