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