-- file SymbolPackExt.Mesa
-- last modified by Satterthwaite, April 6, 1979  12:44 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [CharsPerWord],
  StringDefs: FROM "stringdefs" USING
    [SubString, SubStringDescriptor, AppendSubString, EqualSubStrings],
  Symbols: FROM "symbols" USING [
    htType, ssType, seType, ctxType, mdType, bodyType,
    ExtensionType, HVIndex, HTRecord, HTIndex,
    SERecord, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CTXRecord, BTIndex,
    HTNull, SENull, ISENull, CSENull, CTXNull, BTNull, lZ, typeTYPE],
  SymbolOps: FROM "symbolops" USING [HashValue, NextSe, TypeForm, XferMode],
  SymbolPack: FROM "symbolpack",
  SymbolSegment: FROM "symbolsegment" USING
    [ExtIndex, ExtRecord, STHeader, extType, ltType, treeType],
  Table: FROM "table" USING
    [Base, Index, Notifier, AddNotify, Allocate, Bounds, DropNotify],
  Tree: FROM "tree" USING [Link];

SymbolPackExt: PROGRAM
    IMPORTS
	StringDefs, Table, SymbolOps,
	own: SymbolPack
    EXPORTS SymbolOps SHARES Symbols =
 PUBLIC
  BEGIN
  OPEN SymbolOps, Symbols;

  SubString: TYPE = StringDefs.SubString;

  StaticNestError: SIGNAL = CODE;

-- tables defining the current symbol table

  hashVector: PRIVATE ARRAY HVIndex OF HTIndex;
  ht: PRIVATE DESCRIPTOR FOR ARRAY HTIndex OF HTRecord;

  hashVec: PRIVATE DESCRIPTOR FOR ARRAY OF HTIndex = DESCRIPTOR[hashVector];
  htb: PRIVATE Table.Base;		-- hash table
  ssb: PRIVATE STRING;			-- id string
  seb: PRIVATE Table.Base;		-- se table
  ctxb: PRIVATE Table.Base;		-- context table
  mdb: PRIVATE Table.Base;		-- module directory base
  bb: PRIVATE Table.Base;		-- body table
  extb: PRIVATE Table.Base;		-- extension table

  stHeader: SymbolSegment.STHeader;

  UpdateBases: PRIVATE Table.Notifier =
    BEGIN  -- called whenever the main symbol table is repacked
    own.hashVec ← hashVec;
    htb ← base[htType];
    own.ssb ← ssb ← LOOPHOLE[base[ssType], STRING];
    own.ht ← ht ← DESCRIPTOR[htb, LENGTH[ht]];
    own.seb ← seb ← base[seType];
    own.ctxb ← ctxb ← base[ctxType];  own.mdb ← mdb ← base[mdType];
    own.bb ← bb ← base[bodyType];
    own.tb ← base[SymbolSegment.treeType];
    own.ltb ← base[SymbolSegment.ltType];
    own.extb ← extb ← base[SymbolSegment.extType];
    own.notifier[own];
    RETURN
    END;

  AllocateHash: PRIVATE PROCEDURE RETURNS [HTIndex] =
    BEGIN
    hti: HTIndex = LENGTH[ht];
    [] ← Table.Allocate[htType, SIZE[HTRecord]];
    own.ht ← ht ← DESCRIPTOR[htb, LENGTH[ht]+1];
    ht[hti] ← HTRecord[
	anyInternal: FALSE,
	anyPublic: FALSE,
	link: HTNull,
	ssIndex: ssb.length];
    RETURN [hti]
    END;

  HashBlock: PROCEDURE RETURNS [base: POINTER, length: CARDINAL] =
    BEGIN
    base ← BASE[hashVector];  length ← LENGTH[hashVector];  RETURN
    END;

 -- variables for building the symbol string

  ssw: PRIVATE Table.Index;


  initialized: PRIVATE BOOLEAN ← FALSE;

  Initialize: PROCEDURE = 
    BEGIN  -- called to set up the compiler's symbol table 
    i: HVIndex;
    IF initialized THEN Finalize[];
    own.notifier ← own.NullNotifier;
    stHeader.extBlock.size ← 0;
    own.stHandle ← @stHeader;  own.sourceFile ← NIL;
    FOR i IN HVIndex DO hashVector[i] ← HTNull ENDLOOP;
    ht ← DESCRIPTOR[NIL, 0];
    Table.AddNotify[UpdateBases];
    ssw ← Table.Allocate[ssType, SIZE[StringBody]] + SIZE[StringBody];
    ssb↑ ← StringBody[length:0, maxlength:0, text:];
    IF AllocateHash[] # HTNull THEN ERROR;
    IF MakeNonCtxSe[SIZE[nil cons SERecord]] # SENull THEN ERROR;
    seb[CSENull] ← SERecord[mark3: FALSE, mark4: FALSE, body: cons[nil[]]];
    IF MakeNonCtxSe[SIZE[mode cons SERecord]] # typeTYPE THEN ERROR;
    seb[typeTYPE] ← SERecord[mark3: TRUE, mark4: TRUE, body: cons[mode[]]];
    IF Table.Allocate[ctxType, SIZE [nil CTXRecord]] # CTXNull THEN ERROR;
    ctxb[CTXNull] ← CTXRecord[FALSE, FALSE, ISENull, lZ, nil[]];
    initialized ← TRUE;  RETURN
    END;
   
  Finalize: PROCEDURE = 
    BEGIN  --  releases storage allocated for the symbol table blocks
    initialized ← FALSE;
    Table.DropNotify[UpdateBases];  RETURN
    END;
   

 -- hash entry creation

  EnterString: PROCEDURE [s: SubString] RETURNS [hti: HTIndex] =
    BEGIN
    OPEN StringDefs;
    hvi: HVIndex;
    desc: StringDefs.SubStringDescriptor ← [base:ssb, offset:, length:];
    CharsPerWord: CARDINAL = AltoDefs.CharsPerWord;
    offset, length, nw: CARDINAL;
    ssi: Table.Index;
    hvi ← HashValue[s];
    FOR hti ← hashVec[hvi], ht[hti].link UNTIL hti = HTNull
      DO
      desc.offset ← ht[hti-1].ssIndex;
      desc.length ← ht[hti].ssIndex - desc.offset;
      IF StringDefs.EqualSubStrings[s, @desc] THEN RETURN [hti];
      ENDLOOP;
    offset ← ssb.length;  length ← s.length;
    nw ← (offset+length+(CharsPerWord-1) - ssb.maxlength)/CharsPerWord;
    IF nw # 0
      THEN
	BEGIN  ssi ← Table.Allocate[ssType, nw];
	IF ssi # ssw THEN ERROR;
	ssw ← ssw + nw;
	ssb↑ ← StringBody[
		length: ssb.length,
		maxlength: ssb.maxlength + nw*CharsPerWord,
		text:];
	END;
    StringDefs.AppendSubString[ssb, s];
    hti ← AllocateHash[];
    ht[hti].link ← hashVec[hvi];  hashVec[hvi] ← hti;
    RETURN
    END;


 -- lexical level accounting

  NextLevel: PROCEDURE [cl: ContextLevel] RETURNS [nl: ContextLevel] =
    BEGIN  -- increments static height, checking for overflow
    IF cl+1 < LAST[ContextLevel]
      THEN  nl ← cl+1
      ELSE  BEGIN  SIGNAL StaticNestError;  nl ← cl  END;
    RETURN
    END;


 -- context table manipulation

  NewCtx: PROCEDURE [level: ContextLevel] RETURNS [ctx: CTXIndex] =
    BEGIN  -- makes a non-include context entry
    ctx ← Table.Allocate[ctxType, SIZE[simple CTXRecord]];
    ctxb[ctx] ← [
	mark: FALSE,
	varUpdated: FALSE,
	seList: ISENull,
	level: level,
	extension: simple[ctxNew: CTXNull]];
    RETURN
    END;

  ResetCtxList: PROCEDURE [ctx: CTXIndex] =
    BEGIN  -- change the list for ctx to a proper chain
    OPEN ctxb[ctx];
    sei: ISEIndex = seList;
    IF sei # SENull
      THEN BEGIN  seList ← NextSe[seList];  SetSeLink[sei, ISENull]  END;
    RETURN
    END;


  FirstVisibleSe: PROCEDURE [ctx: CTXIndex] RETURNS [sei: ISEIndex] =
    BEGIN
    sei ← ctxb[ctx].seList;
    WHILE sei # SENull AND seb[sei].idCtx # ctx
      DO sei ← NextSe[sei] ENDLOOP;
    RETURN
    END;

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


  ContextVariant: PROCEDURE [ctx: CTXIndex] RETURNS [ISEIndex] =
    BEGIN
    sei: ISEIndex;
    IF ctx = CTXNull THEN RETURN [ISENull];
    FOR sei ← ctxb[ctx].seList, NextSe[sei] UNTIL sei = SENull 
      DO
      IF TypeForm[seb[sei].idType] = union THEN RETURN [sei];
      ENDLOOP;
    RETURN [ISENull]
    END;



 -- semantic entry creation

  MakeSeChain: PROCEDURE [ctx: CTXIndex, n: CARDINAL, linked: BOOLEAN] RETURNS [sechain: ISEIndex] =
    BEGIN
    sei: ISEIndex;
    IF n = 0 THEN RETURN [ISENull];
    sechain ← Table.Allocate[seType,
	     (n-1)*SIZE[sequential id SERecord] + 
		(IF linked
		  THEN SIZE[linked id SERecord]
		  ELSE SIZE[terminal id SERecord])];
    sei ← sechain;
    THROUGH [1..n)
      DO
      seb[sei] ← [mark3: FALSE, mark4: FALSE,
		body: id[,,ctx,,,,,,HTNull,,sequential[]]];
      sei ← sei + SIZE[sequential id SERecord];
      ENDLOOP;
    IF linked
      THEN
	seb[sei] ← SERecord[mark3: FALSE, mark4: FALSE,
		body: id[,,ctx,,,,,,HTNull,,linked[ISENull]]]
      ELSE
	seb[sei] ← SERecord[mark3: FALSE, mark4: FALSE,
		body: id[,,ctx,,,,,,HTNull,,terminal[]]];
    RETURN
    END;


  MakeCtxSe: PROCEDURE [hti: HTIndex, ctx: CTXIndex] RETURNS [sei: ISEIndex] =
    BEGIN  -- makes an id-tagged entry for a declared item
    next, psei: ISEIndex;
    sei ← Table.Allocate[seType, SIZE[linked id SERecord]];
    IF ctx = CTXNull
      THEN  next ← ISENull
      ELSE
	BEGIN  psei ← ctxb[ctx].seList;
	IF psei = SENull
	    THEN next ← sei
	    ELSE  BEGIN  next ← NextSe[psei];  SetSeLink[psei, sei]  END;
	ctxb[ctx].seList ← sei;
	END;
    seb[sei] ← SERecord[
	mark3: FALSE,
	mark4: FALSE,
	body: id[,,ctx,,,,,,hti,,linked[link: next]]];
    RETURN
    END;

  NameClash: SIGNAL [hti: HTIndex] = CODE;

  FillCtxSe: PROCEDURE [sei: ISEIndex, hti: HTIndex, public: BOOLEAN] =
    BEGIN
    psei: ISEIndex;
    ctx: CTXIndex = seb[sei].idCtx;
    seb[sei].hash ← hti;
    IF hti # HTNull
      THEN
	BEGIN
	IF ht[hti].anyInternal AND ctx # CTXNull
	  THEN
	    FOR psei ← ctxb[ctx].seList, NextSe[psei] UNTIL psei = sei
	      DO
	      IF seb[psei].hash = hti THEN GO TO duplicate;
	      REPEAT
		duplicate => SIGNAL NameClash[hti];
	      ENDLOOP;
	ht[hti].anyInternal ← TRUE;
	IF public THEN ht[hti].anyPublic ← TRUE;
	END;
    RETURN
    END;

  EnterExtension: PROCEDURE [sei: ISEIndex, type: ExtensionType, tree: Tree.Link] =
    BEGIN  OPEN SymbolSegment;
    exti: ExtIndex;
    extLimit: ExtIndex = LOOPHOLE[Table.Bounds[extType].size];
    FOR exti ← FIRST[ExtIndex], exti + SIZE[ExtRecord] UNTIL exti = extLimit
      DO
      IF extb[exti].sei = sei THEN EXIT;
      REPEAT
	FINISHED =>
	  BEGIN
	  exti ← Table.Allocate[extType, SIZE[ExtRecord]];
	  stHeader.extBlock.size ← stHeader.extBlock.size + SIZE[ExtRecord];
	  END;
      ENDLOOP;
    extb[exti] ← ExtRecord[sei: sei, type: type, tree: tree];
    seb[sei].extended ← TRUE;
    RETURN
    END;

  SetSeLink: PROCEDURE [sei, next: ISEIndex] =
    BEGIN
    WITH seb[sei] SELECT FROM
      linked => link ← next;
      ENDCASE => ERROR;
    RETURN
    END;


  MakeNonCtxSe: PROCEDURE [size: CARDINAL] RETURNS [sei: CSEIndex] =
    BEGIN  -- makes a non-ctx se entry for a constructed type
    sei ← Table.Allocate[seType, size];
    seb[sei] ← [mark3: FALSE, mark4: FALSE, body: cons[typeInfo: ]];
    RETURN
    END;


  ConstantId: PROCEDURE [sei: ISEIndex] RETURNS [BOOLEAN] =
    BEGIN
    RETURN [IF ~seb[sei].constant
      THEN FALSE
      ELSE
	SELECT XferMode[seb[sei].idType] FROM
	  procedure, signal, error, program =>
	    seb[sei].mark4 AND seb[sei].idInfo = BTNull,
	  ENDCASE => TRUE]
    END;


 -- body table utilities

  ParentBti: PROCEDURE [bti: BTIndex] RETURNS [BTIndex] =
    BEGIN
    UNTIL bb[bti].link.which = parent DO bti ← bb[bti].link.index ENDLOOP;
    RETURN [bb[bti].link.index]
    END;

  LinkBti: PROCEDURE [bti, parent: BTIndex] =
    BEGIN
    prev: BTIndex;
    IF (prev ← bb[parent].firstSon) = BTNull
      THEN  bb[parent].firstSon ← bti
      ELSE
	BEGIN
	UNTIL bb[prev].link.which = parent
	  DO  prev ← bb[prev].link.index  ENDLOOP;
	bb[prev].link ← [which:sibling, index:bti];
	END;
    bb[bti].link ← [which:parent, index:parent];
    END;

  DelinkBti: PROCEDURE [bti: BTIndex] =
    BEGIN
    prev, next: BTIndex;
    parent: BTIndex = ParentBti[bti];
    prev ← bb[parent].firstSon;
    IF prev = bti
      THEN  bb[parent].firstSon ←
	IF bb[bti].link.which = parent THEN BTNull ELSE bb[bti].link.index
      ELSE
	BEGIN
	UNTIL (next ← bb[prev].link.index) = bti DO prev ← next ENDLOOP;
	bb[prev].link ← bb[next].link;
	END;
    bb[bti].link ← [which:parent, index:BTNull];
    END;

  END.