-- file LiteralPack.Mesa
-- last modified by Satterthwaite,  9-Feb-82  9:48:21

DIRECTORY
  Alloc: TYPE USING [
    Handle, Notifier, OrderedIndex,
    AddNotify, Bounds, DropNotify, Failure, Top, Words],
  Literals: TYPE,
  LiteralOps: TYPE USING [ValueDescriptor],
  Strings: TYPE USING [
    String, SubString, SubStringDescriptor,
    AppendChar, AppendSubString, EqualSubStrings],
  Symbols: TYPE USING [SEIndex];

LiteralPack: PROGRAM
    IMPORTS Alloc, Strings
    EXPORTS LiteralOps =
 PUBLIC {
  OPEN Literals;

  table: PRIVATE Alloc.Handle;
  zone: PRIVATE UNCOUNTED ZONE _ NIL;
  
  ltb: PRIVATE Literals.Base;	-- literal table base
  stb: PRIVATE Literals.Base;	-- string table base

  UpdateBases: PRIVATE Alloc.Notifier = {
    -- called whenever the main symbol table is repacked
    ltb _ base[ltType];  stb _ base[stType];  RETURN};


  LTMax: Alloc.OrderedIndex = FIRST[Alloc.OrderedIndex] + (LAST[LTIndex]-FIRST[LTIndex]);
  STMax: Alloc.OrderedIndex = FIRST[Alloc.OrderedIndex] + (LAST[STIndex]-FIRST[STIndex]);

  initialized: PRIVATE BOOLEAN _ FALSE;

  Initialize: PROC [ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] = { 
    -- called to set up the compiler's literal table 
    IF initialized THEN Finalize[];
    zone _ scratchZone;
    hashVec _ zone.NEW[ARRAY LitHVIndex OF LTIndex];
    sHashVec _ zone.NEW[ARRAY SLitHVIndex OF MSTIndex];
    table _ ownTable;  table.AddNotify[UpdateBases];
    [] _ ForgetEntries[];  sHashVec^ _ ALL[MSTNull];
    stLimit _ localStart _ FIRST[STIndex];  locals _ markBit _ FALSE;
    initialized _ TRUE};
   
  Finalize: PROC = {
    table.DropNotify[UpdateBases]; table _ NIL;
    zone.FREE[@sHashVec];  zone.FREE[@hashVec];  zone _ NIL;
    initialized _ FALSE};
   

 -- literal table management

  LitHVLength: PRIVATE INTEGER = 53;
  LitHVIndex: PRIVATE TYPE = [0..LitHVLength);

  hashVec: PRIVATE LONG POINTER TO ARRAY LitHVIndex OF LTIndex;


  Find: PROC [v: WORD] RETURNS [lti: LTIndex] = {
    hvi: LitHVIndex = v MOD LitHVLength;
    FOR lti _ hashVec[hvi], ltb[lti].link UNTIL lti = LTNull DO
      WITH entry: ltb[lti] SELECT FROM
	short => IF entry.value = v THEN EXIT;
	ENDCASE;
      REPEAT
	FINISHED => {
	  ti: Alloc.OrderedIndex = table.Words[ltType, SIZE[short LTRecord]];
	  IF ti >= LTMax THEN ERROR table.Failure[ltType];
	  lti _ ti;  ltb[lti] _ LTRecord[datum: short[value: v], link: hashVec[hvi]];
	  hashVec[hvi] _ lti};
      ENDLOOP;
    RETURN};

  FindMultiWord: PRIVATE PROC [baseP: Literals.Finger, desc: LitDescriptor]
      RETURNS [lti: LTIndex] = {
    v: WORD _ 0;
    hvi: LitHVIndex;
    lLti: Literals.Base RELATIVE POINTER [0..Literals.Limit) TO long LTRecord;
    FOR i: CARDINAL IN [0 .. desc.length) DO v _ v + baseP^[desc.offset][i] ENDLOOP;
    hvi _ v MOD LitHVLength;
    FOR lti _ hashVec[hvi], ltb[lti].link UNTIL lti = LTNull DO
      WITH entry: ltb[lti] SELECT FROM
	long =>
	  IF desc.length = entry.length THEN
	    FOR i: CARDINAL IN [0 .. desc.length) DO
	      IF entry.value[i] # baseP^[desc.offset][i] THEN EXIT;
	      REPEAT
	        FINISHED => GO TO found;
	      ENDLOOP;
	ENDCASE;
      REPEAT
	found => NULL;
	FINISHED => {
	  ti: Alloc.OrderedIndex = table.Words[ltType, SIZE[long LTRecord] + desc.length];
	  IF ti >= LTMax THEN ERROR table.Failure[ltType];
	  lLti _ ti;
	  ltb[lLti] _ LTRecord[
		link: hashVec[hvi],
		datum: long[codeIndex: 0, length: desc.length, value: ]];
	  FOR i: CARDINAL IN [0 .. desc.length) DO
	    ltb[lLti].value[i] _ baseP^[desc.offset][i] ENDLOOP;
	  hashVec[hvi] _ lti _ lLti};
      ENDLOOP;
    RETURN};

  Value: PROC [lti: LTIndex] RETURNS [WORD] = {
    WITH entry: ltb[lti] SELECT FROM
	short => RETURN [entry.value];
	long => IF entry.length = 1 THEN RETURN [entry.value[0]];
      ENDCASE;
    ERROR};


  FindDescriptor: PROC [desc: LiteralOps.ValueDescriptor] RETURNS [LTIndex] = {
    base: Literals.Base _ LOOPHOLE[BASE[desc]];
    RETURN [IF LENGTH[desc] = 1
      THEN Find[desc[0]]
      ELSE FindMultiWord[@base, [offset:LOOPHOLE[0], length:LENGTH[desc]]]]};

  deltaShort: CARDINAL = LOOPHOLE[@(NIL[POINTER TO short LTRecord]).value];
  deltaLong: CARDINAL = LOOPHOLE[@(NIL[POINTER TO long LTRecord]).value];

  DescriptorValue: PROC [lti: LTIndex] RETURNS [LitDescriptor] = {
    RETURN [WITH entry: ltb[lti] SELECT FROM
      short => [offset: LOOPHOLE[lti + deltaShort], length: 1],
      long => [offset: LOOPHOLE[lti + deltaLong], length: entry.length],
      ENDCASE => ERROR]};


  CopyLiteral: PROC [literal: LTId] RETURNS [lti: LTIndex] = {
    desc: LitDescriptor;
    WITH entry: literal.baseP^[literal.index] SELECT FROM
      short => lti _ Find[entry.value];
      long => {
	desc _ [offset: LOOPHOLE[literal.index + deltaLong], length: entry.length];
	lti _ FindMultiWord[literal.baseP, desc]};
      ENDCASE => ERROR;
    RETURN};

  ForgetEntries: PROC RETURNS [currentSize: CARDINAL] = {
    hashVec^ _ ALL[LTNull]; RETURN [table.Bounds[ltType].size]};


 -- string literal table management

  MSTNull: PRIVATE MSTIndex = LOOPHOLE[STNull];
  SLitHVLength: PRIVATE INTEGER = 23;
  SLitHVIndex: PRIVATE TYPE = [0..SLitHVLength);

  sHashVec: PRIVATE LONG POINTER TO ARRAY SLitHVIndex OF MSTIndex;

  stLimit, localStart: STIndex;
  locals: BOOLEAN;
  markBit: BOOLEAN;


  FindString: PROC [s: Strings.SubString] RETURNS [STIndex] = {
    CpW: CARDINAL = 2;	-- String.CharsPerWord
    hash: WORD _ 0;
    hvi: SLitHVIndex;
    sti: MSTIndex;
    FOR i: CARDINAL IN [s.offset .. s.offset+s.length) DO
      hash _ hash + LOOPHOLE[s.base[i], CARDINAL] ENDLOOP;
    hvi _ hash MOD SLitHVLength;
    FOR sti _ sHashVec[hvi], stb[sti].link UNTIL sti = MSTNull DO
      v: Strings.String = StringValue[sti];
      desc: Strings.SubStringDescriptor _ [base:v, offset:0, length:v.length];
      IF Strings.EqualSubStrings[s, @desc] THEN EXIT;
      REPEAT
	FINISHED => {
	  nw: CARDINAL = SIZE[StringBody[s.length]];
	  ti: Alloc.OrderedIndex = table.Words[stType, SizeSTPrefix + nw];
	  IF ti >= STMax THEN ERROR table.Failure[stType];
	  sti _ ti;
	  stb[sti] _ STRecord[master[
	      info: 0,
	      codeIndex: 0,
	      local: FALSE,
	      link: sHashVec[hvi],
	      string: [
		length: 0,
		maxlength: ((s.length + (CpW-1))/CpW) * CpW,
		text: ]]];
	  Strings.AppendSubString[@stb[sti].string, s];
	  FOR i: CARDINAL IN [s.length .. stb[sti].string.maxlength) DO
	    Strings.AppendChar[@stb[sti].string, 0C] ENDLOOP;
	  stb[sti].string.length _ s.length;
	  stLimit _ stLimit + (SizeSTPrefix + nw);
	  sHashVec[hvi] _ sti};
      ENDLOOP;
    RETURN [sti]};


  MasterString: PROC [sti: STIndex] RETURNS [MSTIndex] = {
    RETURN [WITH s: stb[sti] SELECT FROM
      master => LOOPHOLE[sti],
      copy => s.link,
      heap => s.link,
      ENDCASE => MSTNull]};

  StringReference: PROC [sti: STIndex] = {
    WITH s: stb[sti] SELECT FROM
      master => s.info _ s.info + 1;
      ENDCASE => NULL};

  StringValue: PROC [sti: STIndex] RETURNS [Strings.String] = {
    RETURN [@stb[MasterString[sti]].string]};

  TextType: PROC [sti: STIndex] RETURNS [Symbols.SEIndex] = {
    RETURN [WITH s: stb[sti] SELECT FROM heap => s.type, ENDCASE => ERROR]};

  ResetLocalStrings: PROC RETURNS [key: STIndex] = {
    IF ~locals THEN key _ STNull
    ELSE {key _ localStart; markBit _ ~markBit};
    locals _ FALSE;  localStart _ table.Top[stType];
    RETURN};


  FindHeapString: PROC [key: STIndex, type: Symbols.SEIndex] RETURNS [sti: STIndex] = {
    next: STIndex;
    master: MSTIndex = MasterString[key];
    FOR sti _ FIRST[STIndex], next UNTIL sti = stLimit DO
      WITH s: stb[sti] SELECT FROM
	master => next _ sti + SizeSTPrefix + SIZE[StringBody[s.string.maxlength]];
	copy => next _ sti + SIZE[copy STRecord];
	heap => {
	  IF s.type = type AND s.link = master THEN EXIT;
	  next _ sti + SIZE[heap STRecord]};
	ENDCASE;
      REPEAT
	FINISHED => {
	  ti: Alloc.OrderedIndex = table.Words[stType, SIZE[heap STRecord]];
	  IF ti >= STMax THEN ERROR table.Failure[stType];
	  sti _ ti;
	  stb[sti] _ STRecord[heap[type: type, info: 0, link: master]];
	  stLimit _ stLimit + SIZE[heap STRecord]};
      ENDLOOP;
    RETURN};

  FindLocalString: PROC [key: STIndex] RETURNS [sti: STIndex] = {
    next: STIndex;
    master: MSTIndex = MasterString[key];
    FOR sti _ localStart, next UNTIL sti = stLimit DO
      WITH s: stb[sti] SELECT FROM
	master =>
	  next _ sti + SizeSTPrefix + SIZE[StringBody[s.string.maxlength]];
	copy => {
	  IF s.link = master THEN EXIT;
	  next _ sti + SIZE[copy STRecord]};
	heap => next _ sti + SIZE[heap STRecord];
	ENDCASE;
      REPEAT
	FINISHED => {
	  ti: Alloc.OrderedIndex = table.Words[stType, SIZE[copy STRecord]];
	  IF ti >= STMax THEN ERROR table.Failure[stType];
	  sti _ ti;  stb[sti] _ STRecord[copy[mark: markBit, link: master]];
	  stLimit _ stLimit + SIZE[copy STRecord];
	  locals _ TRUE};
      ENDLOOP;
    RETURN};


  EnumerateHeapStrings: PROC [proc: PROC [STIndex]] = {
    next: STIndex;
    FOR sti: STIndex _ FIRST[STIndex], next UNTIL sti = stLimit DO
      WITH s: stb[sti] SELECT FROM
	master => next _ sti + SizeSTPrefix + SIZE[StringBody[s.string.maxlength]];
	copy => next _ sti + SIZE[copy STRecord];
	heap => {proc[sti]; next _ sti + SIZE[heap STRecord]};
	ENDCASE => ERROR;
      ENDLOOP};

  EnumerateLocalStrings: PROC [key: STIndex, proc: PROC [MSTIndex]] = {
    next: STIndex;
    started, mark: BOOLEAN;
    IF key = STNull THEN RETURN;
    started _ FALSE;
    FOR sti: STIndex _ key, next UNTIL sti = stLimit DO
      WITH s: stb[sti] SELECT FROM
	master => next _ sti + SizeSTPrefix + SIZE[StringBody[s.string.maxlength]];
	copy => {
	  IF ~started THEN {mark _ s.mark;  started _ TRUE};
	  IF s.mark # mark THEN EXIT;
	  proc[s.link];
	  next _ sti + SIZE[copy STRecord]};
	heap => next _ sti + SIZE[heap STRecord];
	ENDCASE => ERROR;
      ENDLOOP};

  EnumerateMasterStrings: PROC [proc: PROC [MSTIndex]] = {
    next: STIndex;
    FOR sti: STIndex _ FIRST[STIndex], next UNTIL sti = stLimit DO
      WITH s: stb[sti] SELECT FROM
	master => {
	  proc[LOOPHOLE[sti]];
	  next _ sti + SizeSTPrefix + SIZE[StringBody[s.string.maxlength]]};
	copy => next _ sti + SIZE[copy STRecord];
	heap => next _ sti + SIZE[heap STRecord];
	ENDCASE => ERROR;
      ENDLOOP};

  }.