Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!caen!news.cs.indiana.edu!rutgers!cmcl2!adm!news
From: AL282247%VMTECSLP.BITNET@uga.cc.uga.edu ( J Picazzo)
Newsgroups: comp.lang.pascal
Subject: (none)
Message-ID: <26894@adm.brl.mil>
Date: 14 May 91 17:57:19 GMT
Sender: news@adm.brl.mil
Lines: 212


> Can anyone send me a copy of Abstract Data Type Implementation
> in Pascal ? A copy was sent to me before but the mail is lost.
> Can the original sender who sent me that sent me again please
> or anyone else?

 I don't know if this is what you asked for, but here it goes: A
double linked lists unit for any data type.


unit lists;

interface

TYPE
  nodepointer = ^node;

  node = RECORD
    INFO   : pointer;
    size   : word;
    previous,
    next   : nodepointer;
  END;

  LIST = RECORD
    LEN        : word;
    FIRST,LAST : nodepointer;
  END;

PROCEDURE INITLIST(VAR l : LIST);
function FIRST(l : LIST) : nodepointer;
function last(l : LIST) : nodepointer;
function len(l : list) : word;
function emptylist(l : list) : boolean;
function NEXT(n : nodepointer) : nodepointer;
function previous(n : nodepointer) : nodepointer;
procedure insertleft(var l : list; n : nodepointer; var data; size : word);
procedure insertright(var l : list; n : nodepointer; var data; size : word);
procedure retrieve(n : nodepointer; var data);
procedure update(n : nodepointer; var data);
procedure deletenode(var l : list; var n : nodepointer);
procedure clearlist(var l : list);


implementation

PROCEDURE INITLIST(VAR l : LIST);
BEGIN
  l.FIRST:=NIL;
  l.LAST:=NIL;
  l.len:=0;
END;

function FIRST(l : LIST) : nodepointer;
BEGIN
  first:=l.FIRST;
END;

function last(l : LIST) : nodepointer;
BEGIN
  last:=l.last;
END;

function len(l : list) : word;
begin
  len:=l.len;
end;

function emptylist(l : list) : boolean;
begin
  emptylist:=l.first=nil;
end;

function NEXT(n : nodepointer) : nodepointer;
BEGIN
  if n<>nil
  then
    next:=n^.next
  else
    next:=nil;
END;

function previous(n : nodepointer) : nodepointer;
BEGIN
  if n<>nil
  then
    previous:=n^.previous
  else
    previous:=nil;
END;

procedure insertleft(var l : list; n : nodepointer; var data; size : word);
var
  p : nodepointer;
begin
  new(p);
  p^.size:=size;
  getmem(p^.info,size);
  move(data,p^.info^,size);
  inc(l.len);
  if n=nil
  then begin
    l.first:=p;
    l.last:=p;
    p^.next:=nil;
    p^.previous:=nil;
  end else if n=l.first
  then begin
    l.first^.previous:=p;
    p^.next:=l.first;
    p^.previous:=nil;
    l.first:=p;
  end else begin
    p^.next:=n;
    p^.previous:=n^.previous;
    n^.previous^.next:=p;
    n^.previous:=p;
  end;
end;

procedure insertright(var l : list; n : nodepointer; var data; size : word);
var
  p : nodepointer;
begin
  new(p);
  p^.size:=size;
  getmem(p^.info,size);
  move(data,p^.info^,size);
  inc(l.len);
  if n=nil
  then begin
    l.first:=p;
    l.last:=p;
    p^.next:=nil;
    p^.previous:=nil;
  end else if n=l.last
  then begin
    l.last^.next:=p;
    p^.previous:=l.last;
    p^.next:=nil;
    l.last:=p;
  end else begin
    p^.previous:=n;
    p^.next:=n^.next;
    n^.next^.previous:=p;
    n^.next:=p;
  end;
end;

procedure retrieve(n : nodepointer; var data);
begin
  if n<>nil
  then
    move(n^.info^,data,n^.size);
end;

procedure update(n : nodepointer; var data);
begin
  if n<>nil
  then
    move(data,n^.info^,n^.size);
end;

procedure deletenode(var l : list; var n : nodepointer);
var
  p : nodepointer;
begin
  if (n<>nil) and not emptylist(l)
  then begin
    freemem(n^.info,n^.size);
    dec(l.len);
    if n^.previous<>nil
    then
      n^.previous^.next:=n^.next
    else
      l.first:=n^.next;
    if n^.next<>nil
    then
      n^.next^.previous:=n^.previous
    else
      l.last:=n^.previous;
    p:=n^.next;
    dispose(n);
    n:=p;
  end;
end;

procedure clearlist(var l : list);
var
  i : word;
  n : nodepointer;
begin
  n:=l.first;
  for i:=1 to l.len do
    deletenode(l,n);
  l.len:=0;
  l.first:=nil;
  l.last:=nil;
end;

END.




+-----------------------------+--------------------------+-------------------+
|  Jorge Luis Noyola Picazzo  |  ITESM Campus San Luis   |                   |
|  Bitnet: AL282247@VMTECSLP  | San Luis Potosi - MEXICO |   This space is   |
+-----------------------------+--------------------------+                   |
|   The shortest distance between 2 points is usually    |    for your ad    |
|               closed for repair.                       |                   |
+--------------------------------------------------------+-------------------+