TListaPointer

{ JOAO PAULO SCHWARZ SCHULER }


                     unit U_GEN;


                      INTERFACE
uses crt,dos;

function NEW_UTILPOINTER:pointer;
{ aloca tabela de ponteiros realmente uteis }


   {----------- Objeto de lista de pointers ------------------}
   { permite uma lista com 65534 pointers !!!                 }
   { BASE : tabela de 256 ponteiros que apontam para tabelas com    }
   {        capacidade cada uma de outros 256 ponteiros, note que   }
   {        estas ultimas sao alocadas de acordo com a necessidade. }

type UTILPOINTER = record                { tabela de pointers }
                      PT:array [0..255] of pointer;   { ponteiros }
                      NUM:byte;                       { numero de ponteiros }
                   end;

type UTILPOINTERPTR = ^UTILPOINTER;      { pointer para tabela de pointers }

type LISTA_POINTER = object
                      BASE : array [0..255] of UTILPOINTERPTR;
      { BASE: tabela que aponta para tabelas de pointers uteis }
                      NUMP : word;
      { NUMP: numero de pointers na lista                      }

                      constructor INIT;
                      procedure INSERT(P:pointer);
                      { insere ponteiro P na lista }

                      procedure PUT(NUM:word;P:pointer);
                      { deposita pointer P na posicao NUM }

                      procedure KILL(NUM:word);
                      { deleta o iten NUM da lista }

                      procedure KILLALL;
                      { deleta todos os itens }

                      function GET(NUM:word):pointer;
                      { pega um ponteiro de indice NUM }

                      function GETNUM:word;
                      { retorna numero de elementos da lista }

                      destructor DONE;
                   { desaloca todas as tabelas de ponteiros realmente uteis }
                     end;


                    IMPLEMENTATION


function NEW_UTILPOINTER:pointer;
{ aloca tabela de ponteiros realmente uteis }
{ todos os pointers da nova tabela recebem nil }
var I:integer;
    UP:UTILPOINTERPTR;
begin
new(UP);
for I:=0 to 255 do UP^.PT[I]:=nil;
UP^.NUM:=0;
NEW_UTILPOINTER:=UP;
end;

constructor LISTA_POINTER.INIT;
{ Ponteiros de indice de arrays de ponteiros recebem NIL }
var I:integer;
begin
for I:=0 to 255 do BASE[I]:=nil;
NUMP:=0;
end;


procedure LISTA_POINTER.INSERT(P:pointer);
{ insere ponteiro P na lista }
var TABELA,POSICAO:byte;
    UP:UTILPOINTERPTR;
begin
inc(NUMP);
TABELA:=NUMP shr 8;           { pointer que aponta para tabela de pointers }
POSICAO:=NUMP and 255;        { posicao do pointer util }
if BASE[TABELA]=NIL           { tabela de pointers nao alocada ? }
   then begin
        BASE[TABELA]:=NEW_UTILPOINTER;   { aloca tabela }
        end;

UP:=BASE[TABELA];
if UP^.PT[POSICAO]=NIL
   then begin
        UP^.PT[POSICAO]:=P;         { Insere pointer }
        inc(UP^.NUM);
        end
   else begin
        UP^.PT[POSICAO]:=P;
        end;
end;

procedure LISTA_POINTER.PUT(NUM:word;P:pointer);
{ deposita pointer P na posicao NUM }
var TABELA,POSICAO:byte;
    UP:UTILPOINTERPTR;
begin
if NUM>NUMP then
   begin
   write('ERRO em PUT/LISTA_POINTER');
   halt;
   end
 else
   begin
   TABELA:=NUM shr 8;           { pointer que aponta para tabela de pointers }
   POSICAO:=NUM and 255;        { posicao do pointer util }
   UP:=BASE[TABELA];
   UP^.PT[POSICAO]:=P;
   end;
end;

function LISTA_POINTER.GETNUM:word;
{ retorna numero de elementos da lista }
begin
GETNUM:=NUMP;
end;

function LISTA_POINTER.GET(NUM:word):pointer;
{ pega um ponteiro de indice NUM }
var TABELA,POSICAO:byte;
    UP:UTILPOINTERPTR;
    RESULT:pointer;
begin
TABELA:=NUM shr 8;                { calcula posicao }
POSICAO:=NUM and 255;
if BASE[TABELA]=NIL               { tabela secundaria nao existe ? }
   then begin
        RESULT:=NIL;
        end
   else begin
        RESULT:=BASE[TABELA]^.PT[POSICAO];  { devolve conteudo }
        end;
GET:=RESULT;
end;

procedure LISTA_POINTER.KILL(NUM:word);
{ deleta o iten NUM da lista }
var COUNT:word;
    TABELA,POSICAO:byte;
    UP:UTILPOINTERPTR;

begin
for COUNT:=NUM to NUMP do     { shift na lista }
    PUT(COUNT,GET(succ(COUNT)));
TABELA:=NUMP shr 8;           { pointer que aponta para tabela de pointers }
POSICAO:=NUMP and 255;        { posicao do pointer util }
UP:=BASE[TABELA];
dec(UP^.NUM);
if UP^.NUM=0 then
   begin
   dispose(UP);
   BASE[TABELA]:=nil;        { desaloca tabela sem pointers }
   end;
dec(NUMP); { decrementa numero de pointers }
end;

procedure LISTA_POINTER.KILLALL;
{ deleta todos os itens }
var I:integer;
begin
NUMP:=0;
for I:=0 to 255 do
    begin
    if BASE[I]<>nil then
       begin
       DISPOSE(BASE[I]);
       BASE[I]:=nil;
       end;{ of if }
    end; { of for }
end; { of procedure }

destructor LISTA_POINTER.DONE;
{ desaloca todas as tabelas de ponteiros realmente uteis }
var I:integer;
begin
for I:=0 to 255 do
    begin
    if BASE[I]<>nil then
       DISPOSE(BASE[I]);
    end;
end;

end.

Return to the Home Page