Курсовая работа. / РЯП_Ксю / 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 .