HCCU - ID List

{
	Namelist - superfast implementation of the namelist
	---------------------------------------------------
	The namelist holds up to 1024 ID's of 11 bytes each.
	The seek goes through a balanced binary tree.
	---------------------------------------------------
	From Niklaus Wirth:
	 Algorithmen und Datenstrukturen in modula2
	 Balanced Binary Trees p228..233

	The new invention here is to replace the dynamic
	structure by a fixed array. This is possible as the
	max number of entries is known. Further, dynamic
	adressing is to be avoided at runtime. Because :
	1. RTKERNEL supplies a patched version of the unit
	   SYSTEM to accomodate reentrancy of dyn.var's.
	2. The Romtool from I-SYSTEMS also provide a patched
	   version of the unit system to provide romability
	-> the choice is clear :avoid dyn. variables.
	Note: the tasks are created dynamically on the heap
	      by CreateTask(..). At this time there is no
	      taskswitching as the tasks get their start
	      later by MAIN, after the setup of the tasks.
	---------------------------------------------------
	Each Entry in the ID table has a bit 
	 -Busy, set if the entry is in use by a task
	 -PreITS, set if the entry is to be emptied before the next command
	 -Map, set if the entry is new to the master
	 
	Further the is a bit for each of the possible adresses,
	where there are ANListLen choices
	 -AdrTab, set if the network adress is in use
	---------------------------------------------------
	netadress is standard as BaseAdress+Index
	---------------------------------------------------
	The code uses approx.  5.3kbyte
	The data uses approx. 19.5kbyte
	---------------------------------------------------
	Testprog is NAMETEST.PAS
	---------------------------------------------------
	update 8/june/96 :
	 GetNextRCD wrapping readout '' as none at all
	---------------------------------------------------
	Created		:1/1/94
	Last Update	:5/4/94

	Is updated version of :
}
{$F+}
{.$DEFINE EV}    { EPROMVERSION }
UNIT ANList;

INTERFACE

USES OPRoot,RTKERNEL;

CONST
 IDLen=11;
{$IFDEF EV}
 ANListLen=512;{ EPROMVERSION }
{$ELSE}
 ANListLen=20;{ RAMVERSION }
{$ENDIF}

TYPE
 IDTyp=STRING[IDLen];     { 12 bytes }

 Node=RECORD              { 7 bytes }
  key,left,right:WORD;
  Bal:BYTE;
 END;
 NameListTypPtr=^NameListTyp;
 NameListTyp=OBJECT              { ANListLen * 19 + 6 bytes }
  L:ARRAY[1..ANListLen]OF IDTyp;
  S:ARRAY[1..ANListLen]OF Node;
  A:ARRAY[1..ANListLen]OF WORD;
  Busy, PreITS, Maptab,AdrTab:BitSet;
  Entries,Root,LastNode,LastID,LastAdr,LastMapRead:WORD;
  PROCEDURE Init;
{ --- user proc's --- }
  { id }
  FUNCTION FindID(ID:IDTyp):WORD;
  FUNCTION AddID(ID:IDTyp):WORD; { unused }
  PROCEDURE RemoveID(z:WORD);
  FUNCTION GetID(z:WORD):IDTyp;  { unused }
  FUNCTION GetNrOfEntries:WORD;
  FUNCTION AddNameUMap(ID:IDTyp;q:WORD):WORD;  { $umap }
  FUNCTION AddNameAndLock(CName:IDTyp):WORD;   { $exc }
  FUNCTION GetNextAndLock(Last:WORD):WORD;     { $poll }
  { map }
  PROCEDURE SetRCDMapped(z:WORD);
  PROCEDURE ResetMMUMap;
  FUNCTION IsNewRCD:BOOLEAN;
  FUNCTION GetNewRCD:IDTyp;
  FUNCTION GetNextRCD:IDTyp; { new :wrapping readout }
  { preits }
  PROCEDURE SetITSFlag(z:WORD);
  FUNCTION IsITS(z:WORD):BOOLEAN; { also clears flag }
  { busy }
  FUNCTION IsBusy(z:WORD):BOOLEAN;{ access? }  { here,exc,poll }
  PROCEDURE WaitForLock(z,d:WORD);       { lock access }
  PROCEDURE Unlock(z:WORD);	{ unlock access }
  { netadress }
  FUNCTION GetNextFreeAdress:WORD;
  PROCEDURE ReleaseAdress(z:WORD);
  PROCEDURE SetAdress(z,n:WORD);   { by qmap }
{ --- internals highlevel --- }
  FUNCTION FindName(ID:IDTyp;VAR p:WORD):WORD;
  PROCEDURE Search(ID:word;VAR p:WORD;VAR h:BOOLEAN); { insert }
  PROCEDURE Delete(ID:WORD;VAR p:WORD;VAR h:BOOLEAN);
{ --- internals lowlevel --- }
  FUNCTION GetFreeNode:WORD;
  PROCEDURE FreeNode(p:WORD);
  FUNCTION GetFreeID:WORD;
  PROCEDURE BalanceL(VAR p:WORD;VAR h:BOOLEAN);
  PROCEDURE BalanceR(VAR p:WORD;VAR h:BOOLEAN);
 END;

VAR
 N:NameListTyp;
 BaseAdr:WORD;
 
VAR ListAccess:RTKERNEL.Semaphore;

IMPLEMENTATION
{== local var's ====================================================}
{== EXTERNAL PROCS =================================================}

PROCEDURE NameListTyp.Init;
VAR i:WORD;
BEGIN
 FOR i:=1 TO ANListLen DO BEGIN
   L[i]:='';
   S[i].Key:=0;
   S[i].bal:=0;
   S[i].left:=0;
   S[i].right:=0;
   A[i]:=0;
  END;
 Entries:=0; Root:=0;
 BaseAdr:=$1000;LastMapRead:=0;
 LastNode:=0;LastID:=0;LastAdr:=0;
 IF Not Busy.Init(ANListLen) THEN ;
 IF Not PreITS.Init(ANListLen) THEN ;
 IF Not Maptab.Init(ANListLen) THEN ;
 IF Not AdrTab.Init(ANListLen) THEN ;
END;

FUNCTION NameListTyp.FindID(ID:IDTyp):WORD;
BEGIN
 Wait(ListAccess);
 FindID:=FindName(ID,Root);
 Signal(ListAccess);
END;

FUNCTION NameListTyp.AddID(ID:IDTyp):WORD;
VAR z:WORD; h:BOOLEAN;
BEGIN
 Wait(ListAccess);
 IF (Entries0) THEN Maptab.SetBit(i);
{ Signal(ListAccess);}
END;

FUNCTION NameListTyp.IsNewRCD:BOOLEAN;
BEGIN
{ Wait(ListAccess);}
 IsNewRCD:=(Maptab.FirstSet<>NoMoreBits);
{ Signal(ListAccess);}
END;

FUNCTION NameListTyp.GetNewRCD:IDTyp; { assumedly called when exist }
VAR i :WORD;
BEGIN
 Wait(ListAccess);
 i:=Maptab.FirstSet;
 GetNewRCD:=L[i];
 Maptab.ClearBit(i);
 Signal(ListAccess);
END;

FUNCTION NameListTyp.GetNextRCD:IDTyp; { wrapping readout }
VAR i,j:WORD;q:BOOLEAN;
BEGIN
 Wait(ListAccess);
 i:=LastMapRead; j:=i; q:=FALSE;
 REPEAT
  IF (j0) THEN BEGIN
      q:=TRUE;
      GetNextRCD:=L[i];
     END;
   END
  ELSE j:=0;
 UNTIL (q) OR(i=j);
 LastMapRead:=j;
 IF (i=j) THEN BEGIN
   IF (ord(L[j][0])<>0) THEN 
    GetNextRCD:=L[i]
   ELSE GetNextRCD:='';
  END;
 Signal(ListAccess);
END;

PROCEDURE NameListTyp.SetITSFlag(z:WORD);
BEGIN
 Wait(ListAccess);
 PreITS.SetBit(z);
 Signal(ListAccess);
END;

FUNCTION NameListTyp.IsITS(z:WORD):BOOLEAN; { also clears flag }
BEGIN
 Wait(ListAccess);
 IsITS:=PreITS.TestClearBit(z);
 Signal(ListAccess);
END;

FUNCTION NameListTyp.IsBusy(z:WORD):BOOLEAN;{ access? }  { here,exc,poll }
BEGIN
 Wait(ListAccess);
 IsBusy:=Busy.BitIsSet(z);
 Signal(ListAccess);
END;

PROCEDURE NameListTyp.WaitForLock(z,d:WORD);       { lock access }
VAR ok:BOOLEAN;
BEGIN
 ok:=FALSE;
 REPEAT
  Wait(ListAccess);
  IF (Not Busy.BitIsSet(z)) THEN BEGIN
    Busy.SetBit(z);
    ok:=TRUE;
   END;
  Signal(ListAccess);
  IF (Not ok) THEN 
   RTKERNEL.Delay(d);
 UNTIL ok;
END;

PROCEDURE NameListTyp.Unlock(z:WORD);	{ unlock access }
BEGIN
 Wait(ListAccess);
 Busy.ClearBit(z);
 Signal(ListAccess);
END;

{ netadress }
FUNCTION NameListTyp.GetNextFreeAdress:WORD;
VAR i:LONGINT;
BEGIN
 Wait(ListAccess);
 IF (LastAdr=ANListLen) THEN LastAdr:=0;
 i:=AdrTab.NextClear(LastAdr);
 IF (i=NoMoreBits) THEN i:=AdrTab.NextClear(0);
 AdrTab.SetBit(i);
 LastAdr:=i;
 GetNextFreeAdress:=BaseAdr+i;
 Signal(ListAccess);
END;

PROCEDURE NameListTyp.ReleaseAdress(z:WORD);
BEGIN
 Wait(ListAccess);
 AdrTab.ClearBit(z-BaseAdr);
 Signal(ListAccess);
END;

PROCEDURE NameListTyp.SetAdress(z,n:WORD);
BEGIN
 Wait(ListAccess);
 A[z]:=n;
 Signal(ListAccess);
END;

FUNCTION NameListTyp.GetNextAndLock(Last:WORD):WORD; {  poll }
VAR loop,n :WORD;
 found :BOOLEAN;
BEGIN
 Wait(ListAccess);
 found:=FALSE;
 n:=last;
 IF (n=0) THEN n:=ANListLen;
 loop:=last;
 REPEAT
  IF (loop0) THEN Busy.SetBit(Loop); { lock }
 Signal(ListAccess);
END;

{== INTERNAL HIGHLEVEL ===================================================}
{ searches array of nodes for free entry, returns zero if none }
FUNCTION NameListTyp.GetFreeNode:WORD;
VAR i:WORD;
 f:BOOLEAN;
BEGIN
 i:=LastNode;f:=FALSE;
 REPEAT
  IF (i=i2[i]);
 UNTIL f OR (i=IDLen);
 Smaller:=f;
END;

{ searches tree for given ID from p, returns handle if found, zero otherwise }
FUNCTION NameListTyp.FindName(ID:IDTyp;VAR p:WORD):WORD;
VAR p1:WORD;
BEGIN
 IF (L[S[p].key]=ID) THEN FindName:=S[p].Key
 ELSE BEGIN
   IF (L[S[p].key]>ID) THEN BEGIN
     IF (S[p].left<>0) THEN p1:=FindName(ID,S[p].Left) ELSE p1:=0;
    END
   ELSE BEGIN
     IF (L[S[p].key]0) THEN p1:=FindName(ID,S[p].right) ELSE p1:=0;
      END;
    END;
   FindName:=p1;
  END;
END;

{ insert ID referenced by ID, start at p, h signals balance }
PROCEDURE NameListTyp.Search(ID:word;VAR p:WORD;VAR h:BOOLEAN);
VAR p1,p2:WORD;
BEGIN
{ Write('+',id,',',p);}
 IF (p=0) THEN BEGIN
   p:=GetFreeNode;h:=TRUE;
   S[p].key:=ID;S[p].left:=0;S[p].right:=0;S[p].Bal:=0;
   Inc(Entries);
{   Writeln;}
  END
 ELSE BEGIN
   IF (L[S[p].key]>L[ID]) THEN { was L[p]> } BEGIN
     Search(ID,S[p].Left,h);
     IF (h) THEN BEGIN
       CASE S[p].bal OF
	  1:BEGIN S[p].bal:=0; h:=FALSE; END;
	  0:S[p].bal:=$FF;
	$FF:BEGIN
	     p1:=S[p].left;
	     IF (S[p1].bal=$FF) THEN BEGIN
		S[p].left:=S[p1].right;
		S[p1].right:=p;
		S[p].bal:=0;p:=p1;
	       END
	     ELSE BEGIN
	       p2:=S[p1].right;
	       S[p1].right:=S[p2].left;S[p2].left:=p1;
	       S[p].left:=S[p2].right;S[p2].right:=p;
	       IF (S[p2].bal=$FF)THEN S[p].bal:=1 ELSE S[p].bal:=0;
	       IF (S[p2].bal=1)THEN S[p1].bal:=$FF ELSE S[p1].bal:=0;
	       p:=p2;
	      END;
	     S[p].bal:=0;h:=FALSE;
	    END; {-1}
       END; { case }
      END; { if h }
    END { if > }
   ELSE BEGIN
     IF (L[S[p].key]=0) THEN}
       IF (b1=0)OR(b1=1) THEN BEGIN
	 S[p].right:=S[p1].left;S[p1].left:=p;
	 IF (b1=0)THEN BEGIN S[p].bal:=1;S[p1].bal:=$FF;h:=FALSE; END
	 ELSE BEGIN S[p].bal:=0;S[p1].bal:=0; END;
	 p:=p1;
	END
       ELSE BEGIN
	 p2:=S[p1].left;b2:=S[p2].bal;
	 S[p1].left:=S[p2].right;S[p2].right:=p1;
	 S[p].Right:=S[p2].left;S[p2].left:=p;
	 IF (b2=1) THEN S[p].bal:=$FF ELSE S[p].bal:=0;
	 IF (b2=$FF) THEN S[p1].bal:=1 ELSE S[p1].bal:=0;
	 p:=p2;S[p2].bal:=0;
	END;
      END; { 1 }
 END; { case }
END; { balancel }

{ balance right tree }
PROCEDURE NameListTyp.BalanceR(VAR p:WORD;VAR h:BOOLEAN);
VAR p1,p2:WORD;b1,b2:BYTE;
BEGIN
 CASE (S[p].bal) OF
    1:S[p].bal:=0;
    0:BEGIN S[p].bal:=$FF;h:=FALSE; END;
  $FF:BEGIN
       p1:=S[p].left;b1:=S[p1].bal;
{       IF (b1<=0) THEN}
       IF (b1=$FF)or(b1=0) THEN
	BEGIN
	 S[p].left:=S[p1].right;S[p1].right:=p;
	 IF (b1=0)THEN BEGIN S[p].bal:=$FF;S[p1].bal:=1;h:=FALSE; END
	 ELSE BEGIN S[p].bal:=0;S[p1].bal:=0; END;
	 p:=p1;
	END
       ELSE BEGIN
	 p2:=S[p1].right;b2:=S[p2].bal;
	 S[p1].right:=S[p2].left;S[p2].left:=p1;
	 S[p].left:=S[p2].right;S[p2].right:=p;
	 IF (b2=$FF) THEN S[p].bal:=1 ELSE S[p].bal:=0;
	 IF (b2=1) THEN S[p1].bal:=$FF ELSE S[p1].bal:=0;
	 p:=p2;S[p2].bal:=0;
	END;
      END; { 1 }
 END; { case }
END; { balancer }

PROCEDURE NameListTyp.Delete(ID:WORD;VAR p:WORD;VAR h:BOOLEAN);
VAR q:WORD;

 PROCEDURE Del(VAR r:WORD;VAR h:BOOLEAN);
 BEGIN
  IF (S[r].right<>0) THEN BEGIN
    Del(S[r].right,h);
    IF h THEN BalanceR(r,h);
   END
  ELSE BEGIN
    S[q].key:=S[r].Key;
    q:=r;r:=S[r].left;h:=TRUE;
   END;
 END; { del }

BEGIN
 IF (p=0) THEN
  h:=false { key not in tree }
 ELSE BEGIN
{   IF (S[p].key>ID) THEN}
   IF (L[S[p].key]>L[ID]) THEN BEGIN
     Delete(ID,S[p].left,h);
     IF h THEN BalanceL(p,h);
    END
   ELSE BEGIN
{     IF (S[p].key


 home

 

 

last updated 4.dec.99







Copyright (99,2000) Ing.Büro R.Tschaggelar