-- YGREC8/ASM/dictionary.vhdl -- version dim. nov. 7 20:50:25 CET 2021 : init -- -- -- Used for symbol tables, opcode lookup and other things. -- -- The structure is a two-level lookup table : -- - an array indexed by the key size (1 to 16 char) -- - an array indexed by the first char of the key (27 entries, 'A'-'Z' and '_') -- Since the 2nd array is allocated only if one symbol of the same size -- is defined, in average, no much memory would be allocated. -- Then it's a linked list. package dictionary is constant MAX_SYM_LEN : integer := 16; type SymType is array (1 to MAX_SYM_LEN) of character; -- Linked list entries : type DictEntry; -- Forward declaration type DictEntryPtr is access DictEntry; type DictEntry is record EntryValue, EntryType : integer; NextEntry : DictEntryPtr; Key : SymType; end record; -- The 2nd level of lookup, A-Z and _ : type AlphaLookupType is array (0 to 26) of DictEntryPtr; type AlphaLookupTypePtr is access AlphaLookupType; -- The 1st level of lookup type DictType is array (1 to MAX_SYM_LEN) of AlphaLookupTypePtr; type DictTypePtr is access DictType; impure function CreateDictionary return DictTypePtr; procedure FindKey(Dict: inout DictTypePtr; Key: string; entry: out DictEntryPtr); procedure AddKey(Dict: inout DictTypePtr; Key: string; entry: inout DictEntryPtr); procedure DumpKeys(Dict: inout DictTypePtr); procedure FreeDict(Dict: inout DictTypePtr); end dictionary; package body dictionary is impure function CreateDictionary return DictTypePtr is begin return new DictType; end CreateDictionary; procedure FindKey(Dict: inout DictTypePtr; Key: string; entry: out DictEntryPtr) is variable i, j, k: integer; variable l: integer := Key'length; variable ALTP : AlphaLookupTypePtr; variable DEP : DictEntryPtr; variable c : character; begin assert (Dict /= null) report "invalid dictionary argument" severity failure; assert l > 0 report "Can't find empty key !" severity failure; assert l <= MAX_SYM_LEN report "Can't Find key ! " & Key & " is too long" severity failure; entry := NULL; -- default value until we find it -- first level of lookup: ALTP := Dict(l); if ALTP = NULL then return; end if; -- second level of lookup: c := Key(Key'low); if c = '_' then i := 26; else i := character'pos(c) - character'pos('A'); assert (i >= 0) and (i < 26) report "Character '" & c & "' is out of range for symbol" severity failure; end if; DEP := ALTP(i); -- Scan the linked list for the requested string while DEP /= NULL loop -- compare the strings if string(DEP.key(1 to l)) = Key then entry := DEP; return; end if; DEP := DEP.NextEntry; end loop; end FindKey; -- Note : no search for the key is performed so it could be defined more than once, -- with the last definition being foud first in the linked list. procedure AddKey(Dict: inout DictTypePtr; Key: string; entry: inout DictEntryPtr) is variable i, j, k: integer; variable l: integer := Key'length; variable ALTP : AlphaLookupTypePtr; variable DEP : DictEntryPtr; variable c : character; begin assert Dict /= NULL report "invalid dictionary argument" severity failure; assert l > 0 report "Can't add empty key !" severity failure; assert l <= MAX_SYM_LEN report "Can't add key ! " & Key & " is too long" severity failure; ALTP := Dict(l); if ALTP = NULL then ALTP := new AlphaLookupType; Dict(l) := ALTP; end if; -- second level of lookup: c := Key(Key'low); if c='_' then i := 26; else i := character'pos(c) - character'pos('A'); assert i >= 0 and i < 26 report "Character '" & c & "' is out of range for symbol" severity failure; end if; DEP := ALTP(i); entry := new DictEntry; -- Copy the key value j := entry.Key'low; k := Key'low; loop entry.Key(j) := Key(k); j := j+1; k := k+1; exit when j > l; end loop; -- insert the entry into the existing list if DEP /= NULL then entry.NextEntry := DEP; end if; ALTP(i) := entry; end AddKey; procedure DumpKeys(Dict: inout DictTypePtr) is variable l, c : integer; variable ALTP : AlphaLookupTypePtr; variable DEP : DictEntryPtr; begin report "=== Dictionary dump ==="; for l in DictType'range loop ALTP := Dict(l); if ALTP /= NULL then report " * Length " & integer'image(l); for c in AlphaLookupType'range loop DEP := ALTP(c); while DEP /= NULL loop report " - Key:'" & string(DEP.Key(1 to l)) & "' val:" & integer'image(DEP.EntryValue); DEP := DEP.NextEntry; end loop; end loop; end if; end loop; end DumpKeys; procedure FreeDict(Dict: inout DictTypePtr) is variable l, c : integer; variable ALTP : AlphaLookupTypePtr; variable DEP, DEP2 : DictEntryPtr; begin for l in DictType'range loop ALTP := Dict(l); if ALTP /= NULL then for c in AlphaLookupType'range loop DEP := ALTP(c); while DEP /= NULL loop DEP2 := DEP; DEP := DEP.NextEntry; deallocate(DEP2); end loop; end loop; deallocate(ALTP); end if; end loop; deallocate(Dict); end FreeDict; end dictionary;