-- file SymbolPack.Mesa
-- last modified by Satterthwaite, October 30, 1979  3:09 PM

DIRECTORY
  AltoDefs: FROM "altodefs"
    USING [BytesPerWord, charlength, maxcharcode, wordlength],
  InlineDefs: FROM "inlinedefs" USING [BITAND, BITXOR],
  StringDefs: FROM "stringdefs"
    USING [SubString, SubStringDescriptor, EqualSubStrings],
  Symbols: FROM "symbols",
  SymbolOps: FROM "symbolops",
  SymbolSegment: FROM "symbolsegment"
    USING [ExtIndex, ExtRecord, FGTEntry, STHeader],
  Table: FROM "table" USING [Base],
  Tree: FROM "tree" USING [Link, Null];

SymbolPack: PROGRAM
    IMPORTS InlineDefs, StringDefs
    EXPORTS SymbolOps SHARES Symbols =
 PUBLIC
  BEGIN
  OPEN Symbols;

  SymbolTableBase: TYPE = POINTER TO FRAME[SymbolPack];

  link: SymbolTableBase;
  cacheInfo: POINTER;

  -- tables defining the current symbol table
    hashVec: DESCRIPTOR FOR ARRAY OF HTIndex;		-- hash index
    ht: DESCRIPTOR FOR ARRAY HTIndex OF HTRecord;	-- hash table
    ssb: STRING;		-- id string
    seb: Table.Base;		-- se table
    ctxb: Table.Base;		-- context table
    mdb: Table.Base;		-- module directory base
    bb: Table.Base;		-- body table
    tb: Table.Base;		-- tree area
    ltb: Table.Base;		-- literal area
    extb: Table.Base;		-- extension map

    stHandle: POINTER TO SymbolSegment.STHeader;

  -- info defining the source file links
    sourceFile: STRING;
    fgTable: DESCRIPTOR FOR ARRAY OF SymbolSegment.FGTEntry;

 -- the following procedure is called if the base values change
  notifier: PROCEDURE [SymbolTableBase];

  NullNotifier: PROCEDURE [SymbolTableBase] = BEGIN  RETURN  END;


 -- hash manipulation

  SubString: TYPE = StringDefs.SubString;

  FindString: PROCEDURE [s: SubString] RETURNS [hti: HTIndex] =
    BEGIN
    desc: StringDefs.SubStringDescriptor;
    ss: SubString = @desc;
    hti ← hashVec[HashValue[s]];
    WHILE hti # HTNull
      DO
      SubStringForHash[ss, hti];
      IF StringDefs.EqualSubStrings[s,ss] THEN EXIT;
      hti ← ht[hti].link;
      ENDLOOP;
    RETURN
    END;

  HashValue: PROCEDURE [s: SubString] RETURNS [HVIndex] =
    BEGIN  -- computes the hash index for string s
    CharBits: PROCEDURE [CHARACTER, WORD] RETURNS [WORD] =
      LOOPHOLE[InlineDefs.BITAND];
    Mask: WORD = 337B;		-- masks out ASCII case shifts
    n: CARDINAL = s.length;
    b: STRING = s.base;
    v: WORD;
    v ← CharBits[b[s.offset], Mask]*177B + CharBits[b[s.offset+(n-1)], Mask];
    RETURN [InlineDefs.BITXOR[v, n*17B] MOD LENGTH[hashVec]]
    END;

  SubStringForHash: PROCEDURE [s: SubString, hti: HTIndex] =
    BEGIN -- gets string for hash table entry
    s.base ← ssb;
    IF hti = HTNull
      THEN s.offset ← s.length ← 0
      ELSE s.length ← ht[hti].ssIndex - (s.offset ← ht[hti-1].ssIndex);
    RETURN
    END;


 -- context management

  CtxEntries: PROCEDURE [ctx: CTXIndex] RETURNS [n: CARDINAL] =
    BEGIN
    sei: ISEIndex;
    n ← 0;
    IF ctx = CTXNull THEN RETURN;
    WITH c: ctxb[ctx] SELECT FROM
      included =>  IF ~c.reset THEN RETURN;
      ENDCASE;
    FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = SENull
      DO  n ← n+1  ENDLOOP;
    RETURN
    END;

  FirstCtxSe: PROCEDURE [ctx: CTXIndex] RETURNS [ISEIndex] =
    BEGIN
    RETURN [IF ctx = CTXNull THEN ISENull ELSE ctxb[ctx].seList]
    END;

  NextSe: PROCEDURE [sei: ISEIndex] RETURNS [ISEIndex] =
    BEGIN
    RETURN [
      IF sei = SENull
	THEN ISENull
	ELSE
	  WITH id: seb[sei] SELECT FROM
	    terminal => ISENull,
	    sequential => sei + SIZE[sequential id SERecord],
	    linked => id.link,
	    ENDCASE => ISENull]
    END;

  SearchContext: PROCEDURE [hti: HTIndex, ctx: CTXIndex] RETURNS [ISEIndex] =
    BEGIN
    sei, root: ISEIndex;
    IF ctx # CTXNull AND hti # HTNull
      THEN
	BEGIN  sei ← root ← ctxb[ctx].seList;
	  DO
	  IF sei = SENull THEN EXIT;
	  IF seb[sei].hash = hti THEN  RETURN [sei];
	  WITH id: seb[sei] SELECT FROM
	    sequential =>  sei ← sei + SIZE[sequential id SERecord];
	    linked =>  IF (sei ← id.link) = root THEN EXIT;
	    ENDCASE => EXIT;
	  ENDLOOP;
	END;
    RETURN [ISENull]
    END;


 -- type manipulation

  NormalType: PROCEDURE [type: CSEIndex] RETURNS [nType: CSEIndex] =
    BEGIN
    nType ← type;
      DO
      WITH seb[nType] SELECT FROM
	subrange =>  nType ← UnderType[rangeType];
	long, real =>  nType ← UnderType[rangeType];
	ENDCASE =>  EXIT;
      ENDLOOP;
    RETURN [nType]
    END;

  RecordLink: PROCEDURE [type: RecordSEIndex] RETURNS [RecordSEIndex] =
    BEGIN
    RETURN [WITH t: seb[type] SELECT FROM
      linked => LOOPHOLE[UnderType[t.linkType], RecordSEIndex],
      ENDCASE => RecordSENull]
    END;

  RecordRoot: PROCEDURE [type: RecordSEIndex] RETURNS [root: RecordSEIndex] =
    BEGIN
      DO
      root ← type;
      IF (type ← RecordLink[root]) = SENull THEN EXIT;
      ENDLOOP;
    RETURN
    END;

  TransferTypes: PROCEDURE [type: SEIndex]
      RETURNS [typeIn, typeOut: RecordSEIndex] =
    BEGIN
    sei: CSEIndex = UnderType[type];
    WITH t: seb[sei] SELECT FROM
      transfer => RETURN [typeIn: t.inRecord, typeOut: t.outRecord];
      ENDCASE;
    RETURN [RecordSENull, RecordSENull]
    END;

  TypeForm: PROCEDURE [type: SEIndex] RETURNS [TypeClass] =
    BEGIN
    RETURN [seb[UnderType[type]].typeTag]
    END;

  TypeLink: PROCEDURE [type: SEIndex] RETURNS [SEIndex] =
    BEGIN
    sei: CSEIndex = UnderType[type];
    RETURN [WITH se: seb[sei] SELECT FROM
      record =>
	WITH se SELECT FROM
	  linked => linkType,
	  ENDCASE => SENull,
      ENDCASE => SENull]
    END;

  TypeRoot: PROCEDURE [type: SEIndex] RETURNS [root: CSEIndex] =
    BEGIN
    link: SEIndex;
    link ← type;
      DO
      root ← UnderType[link];
      IF (link ← TypeLink[root]) = SENull THEN EXIT;
      ENDLOOP;
    RETURN
    END;

  UnderType: PROCEDURE [type: SEIndex] RETURNS [CSEIndex] =
    BEGIN  -- strips off type identifiers
    sei: SEIndex ← type;
    WHILE sei # SENull
      DO
      WITH se: seb[sei] SELECT FROM
	id =>
	  BEGIN
	  IF se.idType # typeTYPE THEN ERROR;
	  sei ← se.idInfo;
	  END;
	ENDCASE =>  EXIT;
      ENDLOOP;
    RETURN [LOOPHOLE[sei, CSEIndex]]
    END;

  XferMode: PROCEDURE [type: SEIndex] RETURNS [TransferMode] =
    BEGIN
    sei: CSEIndex = UnderType[type];
    RETURN[WITH t: seb[sei] SELECT FROM
      transfer => t.mode,
      ENDCASE => none]
    END;


 -- information returning procedures

  WordLength: CARDINAL = AltoDefs.wordlength;
  WordFill: CARDINAL = WordLength-1;
  ByteLength: CARDINAL = AltoDefs.charlength;
  BytesPerWord: CARDINAL = AltoDefs.BytesPerWord;

  BitsForType: PROCEDURE [type: SEIndex] RETURNS [CARDINAL] =
    BEGIN
    sei: CSEIndex = UnderType[type];
    RETURN [IF sei = SENull
      THEN 0
      ELSE
	WITH t: seb[sei] SELECT FROM
	  basic => t.length,
	  enumerated => BitsForRange[Cardinality[sei]-1],
	  record => t.length,
	  subrange => IF t.empty THEN 0 ELSE BitsForRange[Cardinality[sei]-1],
	  ENDCASE => WordsForType[sei]*WordLength]
    END;

  BitsForRange: PROCEDURE [maxValue: CARDINAL] RETURNS [nBits: CARDINAL] =
    BEGIN
    fieldMax: CARDINAL;
    nBits ← 1;  fieldMax ← 1;
    WHILE nBits < WordLength AND fieldMax < maxValue
      DO  nBits ← nBits + 1;  fieldMax ← 2*fieldMax + 1  ENDLOOP;
    RETURN
    END;

  Cardinality: PROCEDURE [type: SEIndex] RETURNS [CARDINAL] =
    BEGIN
    sei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[sei] SELECT FROM
      enumerated => t.nValues,
      subrange => IF t.empty OR t.flexible THEN 0 ELSE t.range+1,
      basic => IF t.code = codeCHARACTER THEN AltoDefs.maxcharcode+1 ELSE 0,
      relative => Cardinality[t.offsetType],
      ENDCASE => 0]
    END;

  FindExtension: PROCEDURE [sei: ISEIndex] RETURNS [type: ExtensionType, tree: Tree.Link] =
    BEGIN  OPEN SymbolSegment;
    exti: ExtIndex;
    extLimit: ExtIndex = LOOPHOLE[stHandle.extBlock.size];
    FOR exti ← FIRST[ExtIndex], exti + SIZE[ExtRecord] UNTIL exti = extLimit
      DO
      IF extb[exti].sei = sei THEN RETURN [extb[exti].type, extb[exti].tree];
      ENDLOOP;
    RETURN [none, Tree.Null]
    END;

  FnField: PROCEDURE [field: ISEIndex] RETURNS [offset: BitAddress, size: CARDINAL] =
    BEGIN
    sei: ISEIndex;
    word, nW: CARDINAL;
    word ← 0;
    FOR sei ← FirstCtxSe[seb[field].idCtx], NextSe[sei]
      DO
      nW ← WordsForType[seb[sei].idType];
      IF sei = field THEN EXIT;
      word ← word + nW;
      ENDLOOP;
    RETURN [offset: BitAddress[wd:word, bd:0], size: nW * WordLength]
    END;

  LinkMode: PROCEDURE [sei: ISEIndex] RETURNS [Linkage] =
    BEGIN
    RETURN [SELECT XferMode[seb[sei].idType] FROM
      procedure, program =>
	IF seb[sei].constant
	  THEN  IF seb[sei].extended THEN val ELSE manifest
	  ELSE  val,
      signal, error => IF seb[sei].constant THEN manifest ELSE val,
      ENDCASE => IF seb[sei].constant THEN manifest ELSE ref]
    END;

  WordsForType: PROCEDURE [type: SEIndex] RETURNS [CARDINAL] =
    BEGIN
    sei: CSEIndex = UnderType[type];
    b: CARDINAL;
    RETURN [IF sei = SENull
      THEN 0
      ELSE
	WITH t: seb[sei] SELECT FROM
	  mode => 1,	-- fudge for compiler (Pass4:Binding)
	  basic => (t.length + WordFill)/WordLength,
	  enumerated => 1,
	  record => (t.length + WordFill)/WordLength,
	  pointer => 1,
	  array =>
	    IF (b←BitsForType[t.componentType]) <= ByteLength AND t.oldPacked
	      THEN (Cardinality[t.indexType] + (BytesPerWord-1))/BytesPerWord
	      ELSE Cardinality[t.indexType] * ((b+WordFill)/WordLength),
	  arraydesc => 2,
	  transfer => IF t.mode = port THEN 2 ELSE 1,
	  relative => WordsForType[t.offsetType],
	  subrange => IF t.empty THEN 0 ELSE 1,
	  long => WordsForType[t.rangeType] + 1,
	  real => 2,
	  ENDCASE => 0]
    END;

  END.