-- PCPack.mesa  last edit, Bruce  June 10, 1980  10:03 PM

DIRECTORY
  Copier: FROM "copier",
  DebugFormat: FROM "debugformat",
  DebugOps: FROM "debugops" USING [ReadCodeWord, ShortREAD],
  DI: FROM "di" USING [MapCtx],
  DSyms: FROM "dsyms",
  Frames: FROM "frames",
  Gf: FROM "gf",
  Lf: FROM "lf",
  Lookup: FROM "Lookup",
  MachineDefs: FROM "MachineDefs",
  Pc: FROM "pc",
  PrincOps: FROM "princops",
  SegmentDefs: FROM "segmentdefs",
  State: FROM "state",
  Storage: FROM "storage",
  StringDefs: FROM "stringdefs",
  Symbols: FROM "symbols",
  SymbolSegment: FROM "symbolsegment",
  SymbolTable: FROM "symboltable" USING [Base, Missing],
  Table: FROM "table";

PCPack: PROGRAM
  IMPORTS Copier, DebugOps, DI, DSyms, Frames, Gf, Lf, 
    Pc, SegmentDefs, State, Storage, SymbolTable, Table
  EXPORTS Pc =
  BEGIN OPEN PrincOps, Symbols;

  CantCacheInlines: ERROR = CODE;
  NotCallable: ERROR = CODE;
  NoBti: ERROR = CODE;
  
  FHandle: TYPE = MachineDefs.FHandle;
  GFHandle: TYPE = MachineDefs.GFHandle;
  EVRange: TYPE = Pc.EVRange;

  data: State.GSHandle ← State.GetGS[];
  cache: CacheBase ← Storage.Pages[1];
  Head, Free: Item;

  ItemNull: Item = LAST[Item];
  CacheLimit: CARDINAL = 
    (MachineDefs.PageSize/SIZE[ItemObject])*SIZE[ItemObject];
  CacheBase: TYPE = BASE POINTER TO UNSPECIFIED;
  Item: TYPE = CacheBase RELATIVE POINTER [0..256) TO ItemObject;

  ItemObject: TYPE = RECORD [
    link: Item,
    ep: EVRange,
    gf: GFHandle,
    start, end: BytePC,
    hasSons: BOOLEAN,
    inner: BOOLEAN,
    dCbti: CBTIndex,
    userCbti: CBTIndex];

  FirstFree: PROC RETURNS [i: Item] =
    BEGIN
    i ← Free;
    IF i = ItemNull THEN ERROR;
    Free ← cache[i].link;
    END;

  ResetCache: PUBLIC PROCEDURE =
    BEGIN
    i: Item;
    Free ← Head ← ItemNull;
    FOR i ← LOOPHOLE[0], i+SIZE[ItemObject] UNTIL
        LOOPHOLE[i,CARDINAL] >= CacheLimit DO
      cache[i].link ← Free; Free ← i;
      ENDLOOP;
    END;

  Enumerate: PROC [proc: PROC [Item] RETURNS [BOOLEAN], gf: GFHandle]
      RETURNS [i: Item] =
    BEGIN
    next, last: Item;
    FOR i ← Head, cache[i].link UNTIL i = ItemNull DO
      IF cache[i].gf = gf AND proc[i] THEN
	BEGIN
	IF i = Head THEN RETURN;
	cache[last].link ← cache[i].link; cache[i].link ← Head; Head ← i;
        RETURN
	END;
      last ← i;
      ENDLOOP;
    IF Free # ItemNull THEN RETURN;
    FOR i ← Head, next UNTIL i = last DO
      IF (next ← cache[i].link) # last THEN LOOP;
      cache[i].link ← ItemNull;
      cache[last].link ← Free;
      Free ← next;
      RETURN[ItemNull];
      ENDLOOP;
    END;
  
  FindEp: PROC [ep: EVRange, gf: GFHandle] RETURNS [Item] =
    BEGIN
    Find: PROC [i: Item] RETURNS [BOOLEAN] = {RETURN[ep = cache[i].ep]};
    RETURN[Enumerate[Find, gf]];
    END;

  FindPC: PROC [pc: BytePC, gf: GFHandle] RETURNS [Item] =
    BEGIN
    Find: PROC [i: Item] RETURNS [BOOLEAN] = 
      BEGIN
      RETURN[
	Card[pc] >= Card[cache[i].start] AND Card[pc] <= Card[cache[i].end]]
      END;
    RETURN[Enumerate[Find, gf]];
    END;

  FindCbti: PROC [cbti: CBTIndex] RETURNS [i: Item] =
    BEGIN
    FOR i ← Head, cache[i].link UNTIL i = ItemNull DO
      IF cache[i].dCbti = cbti THEN RETURN;
      ENDLOOP;
    END;

  EvalStackEmpty: PUBLIC PROCEDURE [sp: PrincOps.SVPointer ← NIL]
      RETURNS [BOOLEAN] =
    BEGIN
    SV: TYPE = RECORD [inst,ptr: MachineDefs.BYTE];
    sv: SV;
    IF sp = NIL THEN sp ← data.StatePtr;
    IF sp = NIL THEN RETURN[TRUE];
    sv ← DebugOps.ShortREAD[sp+8];  -- yech
    RETURN [sv.ptr = 0]
    END;

  Son: PUBLIC PROC [cbti: CBTIndex] RETURNS [BOOLEAN] =
    BEGIN
    i: Item ← FindCbti[cbti];
    IF i = ItemNull THEN ERROR NoBti;
    RETURN [cache[i].hasSons];
    END;

  EVSize: PUBLIC PROC [mdi: MDIndex] RETURNS [max: EVRange] =
    BEGIN
    FindMax: PROC [base: SymbolTable.Base] =
      BEGIN
      GetMax: PROC [bti: BTIndex] RETURNS [stop: BOOLEAN] =
	BEGIN
	WITH base.bb[bti] SELECT FROM
	  Callable => IF ~inline THEN max ← MAX[max,entryIndex];
	  ENDCASE;
	RETURN[FALSE]
	END;
      [] ← base.EnumerateBodies[Symbols.RootBti, GetMax];
      END;
    max ← 0;
    Copier.Outer[mdi,FindMax];
    END;

  Card: PROC [pc: BytePC] RETURNS [CARDINAL] = INLINE {RETURN[LOOPHOLE[pc]]};

  GetPc: PROC [gf: GFHandle, i: EVRange] RETURNS [pc: BytePC] =
    BEGIN OPEN PrincOps;
--    CSegP: TYPE = POINTER TO MachineDefs.CSegPrefix;
--	gf, LOOPHOLE[@LOOPHOLE[0,CSegP].entry[i].initialpc]];
    InitialPcOffset: CARDINAL = 0;
    wpc: INTEGER ← DebugOps.ReadCodeWord[
      gf, SIZE[PrefixHeader]+i*SIZE[EntryVectorItem]+InitialPcOffset];
    odd: BOOLEAN ← wpc < 0;
    pc ← [ABS[wpc]*2+LOOPHOLE[odd, INTEGER]];
    END; 

  GetEp: PROC [pc: BytePC, gf: GFHandle, mdi: MDIndex]
    RETURNS [ep: EVRange, start: BytePC] =
    BEGIN
    i, maxEp: EVRange;
    diff: CARDINAL ← LAST[CARDINAL];
    last: BytePC;
    maxEp ← EVSize[mdi];
    FOR i IN [0..maxEp] DO
      last ← GetPc[gf,i];
      IF Card[last] > Card[pc] THEN LOOP;
      IF Card[pc] - Card[last] > diff THEN LOOP;
      diff ← Card[pc] - Card[last];
      ep ← i; start ← last;
      ENDLOOP;
    RETURN;
    END;

  Ep: PUBLIC PROC [pc: BytePC, gf: GFHandle]
    RETURNS [ep: EVRange, start: BytePC] =
    BEGIN
    old: Item ← FindPC[pc, gf];
    mdi: MDIndex;
    IF old # ItemNull THEN RETURN[cache[old].ep, cache[old].start];
    mdi ← DSyms.GFrameMdi[gf];
    [ep, start] ← GetEp[pc,gf,mdi];
    [] ← ConvertEp[ep,start,gf,mdi];
    RETURN;
    END;

  EpToCBti: PUBLIC PROC [
      ep: EVRange, gf: GFHandle, start: BytePC ← Pc.NullPC]
    RETURNS [cbti: CBTIndex] =
    BEGIN
    old: Item ← FindEp[ep, gf];
    IF old # ItemNull THEN RETURN[cache[old].dCbti];
    cbti ← cache[ConvertEp[ep,start,gf,DSyms.GFrameMdi[gf !
      SegmentDefs.InvalidFP, SymbolTable.Missing,
      Frames.Invalid => GOTO exit]]].dCbti;
    EXITS
      exit => RETURN [CBTNull]
    END;

  CacheCBti: PUBLIC PROC [mdi: MDIndex, gf: GFHandle, cbti: CBTIndex]
    RETURNS [dCbti: CBTIndex, initialPc: BytePC] =
    BEGIN
    ep: EVRange;
    i: Item;
    FillInEp: PROC [base: SymbolTable.Base] = {ep ← base.bb[cbti].entryIndex};
    Copier.Outer[mdi,FillInEp];
    initialPc ← GetPc[gf,ep];
    i ← CacheIt[cbti,ep,initialPc,gf,mdi];
    dCbti ← cache[i].dCbti;
    END;

  CacheIt: PROC [cbti: CBTIndex,
      ep: EVRange, start: BytePC, gf: GFHandle, mdi: MDIndex]
    RETURNS [i: Item] =
    BEGIN
    CheckInline: PROC [base: SymbolTable.Base] =
     {IF base.bb[cbti].inline THEN ERROR CantCacheInlines};
    FillInFromTable: PROC [base: SymbolTable.Base] =
      BEGIN
      cache[i].hasSons ← base.bb[cbti].firstSon # BTNull;
      WITH base.bb[cbti].info SELECT FROM
	External => cache[i].end ← [(start+bytes-1)];
	ENDCASE => ERROR;
      WITH base.bb[cbti] SELECT FROM
	Inner => cache[i].inner ← TRUE;
	ENDCASE;
      END;
    Copier.Outer[mdi,CheckInline];
    i ← FirstFree[];
    cache[i] ← [link: Head, ep: ep, gf: gf, start: start, userCbti: cbti,
      end:, dCbti:, hasSons:, inner: FALSE];
    Head ← i;
    Copier.Outer[mdi,FillInFromTable];
    cache[i].dCbti ← Copier.CopyExternalBody[mdi,cbti];
    END;

  FindBtiWithEp: PROC [ep: Pc.EVRange, mdi: MDIndex] RETURNS [bti: BTIndex] =
    BEGIN
    Find: PROC [base: SymbolTable.Base] =
      BEGIN
      SearchForEp: PROC [bti: BTIndex] RETURNS [BOOLEAN] =
	BEGIN
	WITH base.bb[bti] SELECT FROM
	  Callable => RETURN[~inline AND ep = entryIndex];
	  ENDCASE => RETURN[FALSE]
	END;
	bti ← base.EnumerateBodies[Symbols.RootBti, SearchForEp];
      END;
    Copier.Outer[mdi,Find];
    IF bti = BTNull THEN ERROR NoBti;
    END;

  ConvertEp: PROC [
      ep: EVRange, start: BytePC, gf: GFHandle, mdi: MDIndex]
    RETURNS [i: Item] =
    BEGIN
    bti: BTIndex ← FindBtiWithEp[ep,mdi];
    IF start = Pc.NullPC THEN start ← GetPc[gf,ep];
    i ← CacheIt[LOOPHOLE[bti],ep,start,gf,mdi];
    END;

  LinkToCbti: PUBLIC PROC [pd: PrincOps.ControlLink] RETURNS [cbti: CBTIndex]=
    BEGIN
    EntryPoint: TYPE = RECORD [SELECT OVERLAID * FROM
      detail => [gfi: [0..4), ep: PrincOps.EPIndex],
      index => [i: EVRange],
      ENDCASE];
    ep: EntryPoint;
    gf: GFHandle ← Gf.FrameGfi[pd.gfi];
    ep.ep ← pd.ep; ep.gfi ← pd.gfi - Gf.GFI[gf];
    cbti ← EpToCBti[LOOPHOLE[ep], gf
      ! CantCacheInlines => {cbti ← Symbols.CBTNull; CONTINUE}];
    END;

  LinkToIsei: PUBLIC PROC [pd: PrincOps.ControlLink] RETURNS [Symbols.ISEIndex]=
    BEGIN
    cbti: CBTIndex ← LinkToCbti[pd];
    IF cbti = CBTNull THEN RETURN[Symbols.ISENull];
    RETURN[Table.Bounds[bodyType].base[cbti].id];
    END;

  Fixup: PROC [pc: BytePC, gf: GFHandle] RETURNS [BytePC, GFHandle] =
    BEGIN
    IF gf = NIL THEN gf ← State.GF[];
    IF pc = Pc.NullPC THEN pc ← GetPc[gf,0];
    RETURN[pc,gf];
    END;

  ParentCbti: PROC [pc: BytePC, gf: GFHandle]
      RETURNS [old: Item, mdi: MDIndex] =
    BEGIN
    ep: EVRange;
    start: BytePC;
    old ← FindPC[pc,gf];
    mdi ← DSyms.GFrameMdi[gf !
	SegmentDefs.InvalidFP, SymbolTable.Missing,
	Frames.Invalid => GOTO noSyms];
    IF old = ItemNull THEN
      BEGIN
      [ep, start] ← GetEp[pc,gf,mdi];
      old ← ConvertEp[ep,start,gf,mdi];
      END;
    RETURN;
    EXITS
      noSyms => {mdi ← Symbols.MDNull; RETURN};
    END;

  ConvertCbti: PROC [
    lastBti: BTIndex, pc, start: BytePC, base: SymbolTable.Base]
      RETURNS [bti: BTIndex] =
    BEGIN
    bodyStart: BytePC;
    bti ← lastBti;
    DO
      FOR lastBti ← base.SonBti[bti], base.SiblingBti[lastBti]
      UNTIL lastBti = BTNull DO
	WITH body: base.bb[lastBti] SELECT FROM
	  Callable => LOOP;
	  Other =>
	    BEGIN
	    bodyStart ← [start + body.relOffset];
	    WITH body.info SELECT FROM
	      External => IF pc IN [bodyStart..bodyStart+bytes) THEN
		BEGIN bti ← lastBti; EXIT END;
	      ENDCASE;
	    END;
	  ENDCASE;
	REPEAT
	  FINISHED => RETURN
	ENDLOOP;
      ENDLOOP;
    END;

  Bti: PUBLIC PROC [pc: BytePC ← Pc.NullPC, gf: GFHandle ← MachineDefs.NullGF]
      RETURNS [bti: BTIndex] =
    BEGIN
    mdi: MDIndex;
    lpc: BytePC;
    lgf: GFHandle;
    i: Item;
    ClosestBti: PROC [base: SymbolTable.Base] =
      BEGIN
      bti ← ConvertCbti[bti,pc,cache[i].start,base];
      END;
    [lpc,lgf] ← Fixup[pc,gf];
    [i,mdi] ← ParentCbti[lpc,lgf];
    IF mdi = Symbols.MDNull OR i = ItemNull THEN RETURN[BTNull];
    IF (bti ← cache[i].userCbti) = BTNull THEN RETURN;
    IF ~cache[i].hasSons THEN RETURN;
    Copier.Outer[mdi,ClosestBti];
    END;

  CBti: PUBLIC PROC [
      pc: BytePC ← Pc.NullPC, gf: GFHandle ← MachineDefs.NullGF]
    RETURNS [cbti: CBTIndex] =
    BEGIN
    lpc: BytePC;
    lgf: GFHandle;
    i: Item;
    [lpc,lgf] ← Fixup[pc,gf];
    IF (i ← ParentCbti[lpc, lgf].old) = ItemNull THEN RETURN[CBTNull];
    RETURN[cache[i].dCbti];
    END;

  ContextList: PUBLIC PROC [
      pc: BytePC, gf: GFHandle, why: Pc.Reason, ex: DebugFormat.EXOI ← in]
    RETURNS [mapped: Pc.CtxLink] =
    BEGIN
    bti: BTIndex ← Bti[pc,gf];
    mdi: Symbols.MDIndex ← DSyms.GFrameMdi[gf];
    list: Pc.CtxLink;
    Base: PROC [base: SymbolTable.Base] = {list ← Walk[base,bti,NIL,why,ex]};
    Copier.Outer[mdi,Base];
    mapped ← NIL;
    IF why = search THEN
      BEGIN
      FOR i: Pc.CtxLink ← list, i.link UNTIL i = NIL DO
	i.ictx ← DI.MapCtx[mdi,i.ctx];
	ENDLOOP;
      mapped ← list;
      END
    ELSE
      BEGIN
      FOR i: Pc.CtxLink ← list, i.link UNTIL i = NIL DO
	mapped ← AddToList[mapped, DI.MapCtx[mdi,i.ctx]];
	ENDLOOP;
      Pc.FreeContextList[list];
      END;
    END;

  Walk: PROC [
    base: SymbolTable.Base, bti: Symbols.BTIndex,
    oldList: Pc.CtxLink, why: Pc.Reason, ex: DebugFormat.EXOI] 
      RETURNS [newList: Pc.CtxLink] =
    BEGIN
    myBti: Symbols.BTIndex = bti;
    added: BOOLEAN ← FALSE;
    WITH body: base.bb[bti] SELECT FROM
      Callable =>
	IF why = search AND body.level = Symbols.lG THEN RETURN[oldList]
	ELSE
	  BEGIN
	  newList ← AddToList[oldList, body.localCtx];
	  IF why = print THEN RETURN;
	  added ← TRUE;
 	  WITH base.seb[body.ioType] SELECT FROM
	    transfer =>
	      BEGIN
	      newList ←
		AddRecord[newList, base, LOOPHOLE[outRecord], ex = exit];
	      newList ←
		AddRecord[newList, base, LOOPHOLE[inRecord], ex = entry];
	      ex ← in;
	      END;
	    ENDCASE => ERROR NotCallable;
	  END;
      ENDCASE => newList ← oldList;
    IF (bti ← base.ParentBti[bti]) = Symbols.BTNull THEN RETURN;
    newList ← Walk[base,bti,newList,why,ex];
    IF ~added THEN newList ← AddToList[newList, base.bb[myBti].localCtx];
    END;

  AddToList: PROC [list: Pc.CtxLink, ctx: Symbols.CTXIndex] 
    RETURNS [newList: Pc.CtxLink] =
    BEGIN
    newList ← Storage.Node[SIZE[Pc.CtxItem]];
    newList↑ ← [link: list, onStack: FALSE, context: user[ctx: ctx]];
    END;

  AddRecord: PROC [
    list: Pc.CtxLink, base: SymbolTable.Base, rsei: Symbols.RecordSEIndex,
    onStack: BOOLEAN] 
    RETURNS [newList: Pc.CtxLink] =
    BEGIN
    ctx: Symbols.CTXIndex;
    IF rsei = Symbols.RecordSENull THEN RETURN [list];
    ctx ← base.seb[rsei].fieldCtx;
    newList ← Storage.Node[SIZE[Pc.CtxItem]];
    newList↑ ← [link: list, onStack: onStack, context: user[ctx: ctx]];
    RETURN;
    END;

  EntryPC: PUBLIC PROC [ep: EVRange, gf: GFHandle, noSyms: BOOLEAN ← FALSE] 
    RETURNS [pc: BytePC] =
    BEGIN
    i: Item;
    cbti: CBTIndex;
    mdi: MDIndex;
    FirstFGTEntry: PROC [base: SymbolTable.Base] =
      BEGIN
      j: CARDINAL;
      WITH base.bb[cbti].info SELECT FROM
	External =>
	  FOR j IN (startIndex..startIndex+indexLength) DO
	    WITH entry: base.fgTable[j] SELECT FROM
	      normal => {pc ← [pc + entry.deltaObject]; EXIT};
	      step =>
		IF entry.which = object THEN {pc ← [pc + entry.delta]; EXIT};
	      ENDCASE;
	    ENDLOOP;
        ENDCASE;
      END;
    pc ← GetPc[gf,ep];
    IF noSyms THEN RETURN;
    mdi ← DSyms.GFrameMdi[gf, TRUE ! DSyms.NoFGT => GOTO ret];
    IF (i ← FindEp[ep,gf]) = ItemNull THEN i ← ConvertEp[ep,pc,gf,mdi];
    IF (cbti ← cache[i].userCbti) = CBTNull THEN RETURN;
    Copier.Outer[mdi,FirstFGTEntry];
    EXITS ret => RETURN;
    END;

  ExitPC: PUBLIC PROC [cbti: CBTIndex] RETURNS [BytePC] =
    BEGIN RETURN[cache[FindCbti[cbti]].end] END;

  CbtiItem: PROC [f: FHandle, pc: BytePC] RETURNS [Item, BytePC] =
    BEGIN
    SELECT TRUE FROM
      f = NIL => BEGIN f ← State.LF[]; pc ← Lf.PC[f] END;
      pc = Pc.NullPC => pc ← Lf.PC[f];
      ENDCASE;
    RETURN[FindCbti[CBti[pc, Lf.GF[f]]], pc];
    END;

  Entry: PUBLIC PROCEDURE [
      f: FHandle ← NIL, pc: BytePC ← Pc.NullPC] RETURNS [BOOLEAN] =
    BEGIN
    i: Item;
    [i,pc] ← CbtiItem[f,pc];
    IF i = ItemNull THEN ERROR SymbolTable.Missing[NIL];
    RETURN[(cache[i].start = pc) OR
      (cache[i].inner AND Card[cache[i].start]+2 = Card[pc])];
    END;

  Exit: PUBLIC PROCEDURE [
      f: FHandle ← NIL, pc: BytePC ← Pc.NullPC] RETURNS [BOOLEAN] =
    BEGIN
    i: Item;
    [i,pc] ← CbtiItem[f,pc];
    IF i = ItemNull THEN ERROR SymbolTable.Missing[NIL];
    RETURN[cache[i].end = pc];
    END;

  END.