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