-- 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.