// Keyword.bcpl -- main portion of keyword table package,
//		containing primitives to look up keywords and to
//		enumerate and destroy keyword tables.
// Copyright Xerox Corporation 1979, 1982

// Last modified May 13, 1982  3:55 PM by Taft

get "Keyword.decl"

external
[
// outgoing procedures
KTLookup; KTEnumerate; KTDestroy; BinarySearch; CompareKey

// incoming procedures
StringCompare; Free; Max
]

//---------------------------------------------------------------------------
let KTLookup(kt, key, lvTableKey; numargs na) = valof
//---------------------------------------------------------------------------
// Looks up key in kt and returns a pointer to the corresponding entry
// if it is found, zero if not found.  If the key is an initial substring of
// exactly one entry it is considered found, but if it is an initial substring
// of more than one entry it is considered not found.
// If lvTableKey is provided, a pointer to the keyword string in the matching
// entry is stored in @lvTableKey if the key is either found or ambiguous.
// To clarify:
//   Condition:			  returns:	  @lvTableKey:
// Exact match			entry pointer	matching table key
// Unique initial substring	entry pointer	matching table key
// Ambiguous initial substring	zero		first matching table key
// No match			zero		zero
[
if na ls 3 then lvTableKey = lv na
let numEntries = kt>>KT.numEntries
let r = BinarySearch(key, kt, numEntries, CompareKey)
let i = Max(r, not r)  // index of smallest entry ge key
let kte = lv kt>>KT.kte^0 + i * kt>>KT.lenKTE
let entry = lv kte>>KTE.entry
if r ls 0 then
   [  // not exact match, test for substring match
   if i ge numEntries % StringCompare(key, kte>>KTE.key) ne -2 then
      [ @lvTableKey = 0; resultis 0 ]  // not substring match
   if i+1 ls numEntries & CompareKey(key, kt, i+1) eq -2 then
      entry = 0  // ambiguous
   ]
@lvTableKey = kte>>KTE.key
resultis entry
]

//---------------------------------------------------------------------------
and KTEnumerate(kt, Proc, arg) be
//---------------------------------------------------------------------------
// Calls Proc(entry, kt, keyword, arg) for each entry in the table.
// Proc may change the entry but must not insert or delete keys.
[
let kte = lv kt>>KT.kte^0
let endKTE = kte + kt>>KT.numEntries * kt>>KT.lenKTE
until kte eq endKTE do
   [
   Proc(lv kte>>KTE.entry, kt, kte>>KTE.key, arg)
   kte = kte + kt>>KT.lenKTE
   ]
]

//---------------------------------------------------------------------------
and KTDestroy(kt) be
//---------------------------------------------------------------------------
// Destroys keyword table
[
KTEnumerate(kt, FreeKey)
Free(kt>>KT.zone, kt)
]

//---------------------------------------------------------------------------
and FreeKey(entry, kt, keyword, nil) be Free(kt>>KT.zone, keyword)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and CompareKey(key, kt, i) =
   StringCompare(key, (lv kt>>KT.kte^0 + i * kt>>KT.lenKTE)>>KTE.key)
//---------------------------------------------------------------------------
// Compares key against the kt entry whose index is i.  Returns a value
// describing the outcome:
// -2 the key is an initial substring of the entry
// -1 the key is "less than" the entry but not an initial substring
//  0 the key is "equal to" the entry
//  1 the key is "greater than" the entry

//---------------------------------------------------------------------------
and BinarySearch(key, tbl, lenTbl, Compare) = valof
//---------------------------------------------------------------------------
// Searches for key in the sorted table tbl, which has entries numbered
// zero to lenTbl-1.  The comparison procedure Compare(key, tbl, i) is
// expected to compare key against entry i in the table and return
// a negative number if the key is "less than" the entry, zero if "equal",
// or a positive number if "greater than".
// If the requested key is found, BinarySearch returns the index of the
// matching entry in the table.  If not found, returns -i-1 (= not i),
// where i is the index of the entry before which the key should be inserted.
[
let low, high = 0, lenTbl-1
   [
   if high ls low resultis not low
   let probe = (low+high) rshift 1
   let r = Compare(key, tbl, probe)
   if r eq 0 resultis probe
   test r ls 0
      ifso high = probe-1
      ifnot low = probe+1
   ] repeat
]