[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]

    unit link;
    {$o-,g-,d-,l-,y-,q-,r-,s-,t-,v-,x-,n-,e-,b-}

    INTERFACE

    type
      pstring=^string;
      pdata=^tdatarec;
      tdatarec=record
                 name:pstring;
                 size:byte;
               end;
      plink=^tlink;
      tlink=record
              prev,next:plink;
              data:pdata;
            end;

    procedure inilink(var l:plink);
    function  addlink(var l:plink;var d:pdata):boolean;
    function  addlink2(var l:plink;var d:string):boolean;
    procedure dellink(var l:plink);
    procedure linkdata(var l:plink;var p:pdata);
    function  linkdata2(var l:plink):string;
    function  numlinks(var l:plink):longint;
    procedure killink(var l:plink);

    IMPLEMENTATION

    procedure inilink(var l:plink);
    begin
      l^.prev:=nil; l^.next:=nil; l^.data:=nil; l:=nil;
    end;

    function addlink(var l:plink;var d:pdata):boolean;
    begin
      addlink:=false;
      if(memavail<(d^.size+16))then exit;
      if(l^.next=nil)then
      begin
        new(l^.next);
        l^.next^.next:=nil;
        l^.next^.prev:=l;
        new(l^.next^.data);
        getmem(l^.next^.data^.name,d^.size);
        l^.next^.data^.name^:='';
        l^.next^.data^.name^:=d^.name^;
    {    l^.next^.data^.name^[0]:=d[0];}
        l^.next^.data^.size:=d^.size;
      end else
      begin
        freemem(l^.next^.data^.name,l^.next^.data^.size);
        getmem(l^.next^.data^.name,d^.size);
        l^.next^.data^.name^:=d^.name^;
        l^.next^.data^.size:=d^.size;
      end;
      addlink:=true;
      l:=l^.next;
    end;

    function addlink2(var l:plink;var d:string):boolean;
    begin
      addlink2:=false;
      if(memavail<(succ(ord(d[0])))+16)then exit;
      if(l^.next=nil)then
      begin
        new(l^.next);
        l^.next^.next:=nil;
        l^.next^.prev:=l;
        new(l^.next^.data);
        getmem(l^.next^.data^.name,succ(ord(d[0])));
        l^.next^.data^.name^:='';
        l^.next^.data^.name^:=d;
        l^.next^.data^.name^[0]:=d[0];
        l^.next^.data^.size:=succ(ord(d[0]));
      end else
      begin
        freemem(l^.next^.data^.name,l^.next^.data^.size);
        getmem(l^.next^.data^.name,succ(ord(d[0])));
        l^.next^.data^.name^:=d;
        l^.next^.data^.size:=succ(ord(d[0]));
      end;
      addlink2:=true;
      l:=l^.next;
    end;

    procedure dellink(var l:plink);
    var tmp:plink;
    begin
      tmp:=l;
      if((tmp^.prev=nil)and(tmp^.next=nil))or(tmp^.data=nil)then exit;
      if(tmp^.prev<>nil)and(tmp^.next<>nil)then tmp^.prev:=tmp^.next;
      if(tmp^.prev<>nil)and(tmp^.next<>nil)then tmp^.next^.prev:=tmp^.prev;
      l:=tmp^.next;
      freemem(tmp^.data^.name,tmp^.data^.size);
      dispose(tmp^.data);
      dispose(tmp);
    end;

    procedure linkdata(var l:plink;var p:pdata);
    begin
      if(p=nil)then
      begin
        new(p);
        new(p^.name);
      end;
      p^.name^:=l^.data^.name^;
    end;

    function linkdata2(var l:plink):string;
    var tmp:string;
    begin
    {  tmp:=l^.data^.name^;
      linkdata2:=tmp;      }
      move(l^.data^.name^[1],tmp[1],succ(l^.data^.size));
      tmp[0]:=char(pred(l^.data^.size));
      linkdata2:=tmp;
    end;

    function numlinks(var l:plink):longint;
    var
      tmp:plink;
      cnt:longint;
    begin
      numlinks:=0;
      if(l=nil)then exit;
      tmp:=l;
      while(tmp^.prev<>nil)do tmp:=tmp^.prev;
      cnt:=1;
      while(tmp^.next<>nil)do
      begin
        inc(cnt);
        tmp:=tmp^.next;
      end;
      numlinks:=cnt;
    end;

    procedure killink(var l:plink);
    var c:longint;
    begin
      while(l^.prev<>nil)do l:=l^.prev;
      for c:=1 to numlinks(l)do dellink(l);
    end;

    end.

[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]