-- PcCold.mesa  last edit, Bruce  October 9, 1980  4:08 PM

DIRECTORY
  Copier USING [CopyExternalBody, Outer],
  DebugFormat USING [EXOI],
  DI USING [CTXIndex, MapCtx],
  DSyms USING [GFHandle, GFrameMdi], 
  Frames USING [Invalid],
  Gf USING [FrameGfi, GFI],
  MachineDefs USING [FHandle, GFHandle, MaxParmsInStack, WordLength],
  Pc USING [
    Bti, BytePC, CacheCBti, CtxItem, CtxLink, EpToCBti, EVRange, GetPc, NullPC, Reason],
  PcOps USING [
    BytePC, cache, CacheLimit, FindUserCbti, Free, Head, Item, ItemNull, ItemObject],
  PrincOps USING [BytePC, ControlLink, EPIndex],
  Storage USING [Node],
  Symbols USING [
    bodyType, BTIndex, BTNull, CBTIndex, CBTNull, ContextLevel, CTXIndex, CTXNull,
    ISEIndex, ISENull, MDIndex, RecordSEIndex, RecordSENull, RootBti, seType],
  SymbolTable USING [Base, Missing],
  Table USING [Base, Bounds];

PcCold: PROGRAM
  IMPORTS Copier, DI, DSyms, Frames, Gf, Pc, PcOps,
    Storage, SymbolTable, Table
  EXPORTS Pc, PcOps =
  BEGIN OPEN PcOps, PrincOps, MachineDefs, Symbols;

  NotInAnyProcedure: PUBLIC SIGNAL = CODE;
  CantCacheInlines: ERROR = CODE;
  NotCallable: ERROR = CODE;
  NoBti: ERROR = CODE;
  BadReason: ERROR = CODE;
  
  FHandle: TYPE = MachineDefs.FHandle;
  GFHandle: TYPE = MachineDefs.GFHandle;
  EVRange: TYPE = Pc.EVRange;

  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;

  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 [BytePC] RETURNS [CARDINAL] = MACHINE CODE BEGIN END;

  GetEp: PROC [pc: BytePC, gf: GFHandle, mdi: MDIndex]
    RETURNS [ep: EVRange, start: BytePC] =
    BEGIN
    i, maxEp: EVRange;
    diff: CARDINAL _ LAST[CARDINAL];
    anyProcedure: BOOLEAN _ FALSE;
    last: BytePC;
    maxEp _ EVSize[mdi];
    FOR i IN [0..maxEp] DO
      last _ Pc.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;
      anyProcedure _ TRUE;
      ENDLOOP;
    IF ~anyProcedure THEN SIGNAL NotInAnyProcedure;
    RETURN;
    END;

  EpCold: PUBLIC PROC [pc: BytePC, gf: GFHandle]
    RETURNS [ep: EVRange, start: BytePC] =
    BEGIN
    mdi: MDIndex = DSyms.GFrameMdi[gf];
    [ep, start] _ GetEp[pc,gf,mdi];
    CheckPc[pc,ConvertEp[ep,start,gf,mdi]];
    END;

  CheckPc: PROC [pc: BytePC, i: Item] = {
    IF LOOPHOLE[pc,CARDINAL] >= LOOPHOLE[cache[i].start,CARDINAL] AND 
	LOOPHOLE[pc,CARDINAL] <= LOOPHOLE[cache[i].end,CARDINAL] THEN RETURN;
    SIGNAL NotInAnyProcedure};

  EpToCBtiCold: PUBLIC PROC [ep: EVRange, gf: GFHandle, start: BytePC]
    RETURNS [cbti: CBTIndex] =
    BEGIN
    cbti _ cache[ConvertEp[ep,start,gf,DSyms.GFrameMdi[gf !
      Frames.Invalid, SymbolTable.Missing => GOTO exit]]].dCbti;
    EXITS
      exit => RETURN [CBTNull]
    END;

  CacheCBtiCold: PUBLIC PROC [mdi: MDIndex, gf: GFHandle, cbti: CBTIndex]
    RETURNS [dCbti: CBTIndex] =
    BEGIN
    initialPc: BytePC;
    ep: EVRange;
    i: Item;
    FillInEp: PROC [base: SymbolTable.Base] = {ep _ base.bb[cbti].entryIndex};
    Copier.Outer[mdi,FillInEp];
    initialPc _ Pc.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 _ Pc.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 _ Pc.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;

  ParentCbtiCold: PUBLIC PROC [pc: BytePC, gf: GFHandle, mdi: MDIndex] RETURNS [i: Item] =
    BEGIN
    ep: EVRange;
    start: BytePC;
    [ep, start] _ GetEp[pc,gf,mdi];
    i _ ConvertEp[ep,start,gf,mdi];
    CheckPc[pc,i];
    END;

  ConvertCbti: PUBLIC 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;

  argGf: GFHandle;

  ContextList: PUBLIC PROC [
    pc: BytePC, gf: GFHandle, reason: Pc.Reason, exoi: DebugFormat.EXOI _ in]
    RETURNS [Pc.CtxLink] =
    BEGIN
    bti: BTIndex _ Pc.Bti[pc,gf];
    list: Pc.CtxLink;
    mdi: Symbols.MDIndex _ DSyms.GFrameMdi[gf];
    Base: PROC [iBase: SymbolTable.Base] = {list _ Walk[bti,iBase,reason,exoi]};
    argGf _ gf;
    CollectCbtis[mdi,bti];
    Copier.Outer[mdi,Base];
    FOR i: Pc.CtxLink _ list, i.link UNTIL i = NIL DO
      IF ~i.mapped THEN i.ictx _ DI.MapCtx[mdi,i.ictx];
      ENDLOOP;
    SELECT reason FROM
      search => RETURN[list];
      print => RETURN[Reverse[list]];
      ENDCASE => ERROR BadReason;
    END;

  CollectCbtis: PROC [mdi: Symbols.MDIndex, bti: BTIndex] = {
    list: ARRAY Symbols.ContextLevel OF CBTIndex _ ALL[Symbols.CBTNull];
    length: Symbols.ContextLevel _ 0;
    Collect: PROC [iBase: SymbolTable.Base] = {
      FOR ibti: BTIndex _ bti, iBase.ParentBti[ibti] UNTIL ibti = Symbols.BTNull DO
	WITH iBase.bb[ibti] SELECT FROM
	  Callable => {list[length] _ LOOPHOLE[ibti]; length _ length + 1};
	  ENDCASE;
	IF bti = Symbols.RootBti THEN EXIT;
	ENDLOOP};
    Copier.Outer[mdi,Collect];
    FOR i: Symbols.ContextLevel IN [0..length) DO
      [] _ Pc.CacheCBti[mdi,argGf,list[i]];
      ENDLOOP};

  Walk: PROC [
    bti: Symbols.BTIndex, base: SymbolTable.Base, why: Pc.Reason, ex: DebugFormat.EXOI] 
      RETURNS [list: Pc.CtxLink] =
    BEGIN
    ibti: Symbols.BTIndex;
    indent: CARDINAL _ 0;
    list _ NIL;
    FOR ibti _ bti, base.ParentBti[ibti] UNTIL ibti = Symbols.BTNull DO
      indent _ indent + 2;
      WITH base.bb[ibti] SELECT FROM
	Callable => IF why = print THEN EXIT;
	ENDCASE;
      IF ibti = Symbols.RootBti THEN EXIT;
      ENDLOOP;
    FOR ibti _ bti, base.ParentBti[ibti] UNTIL ibti = Symbols.BTNull DO
      WITH body: base.bb[ibti] SELECT FROM
	Callable =>
	  BEGIN
	  list _ AddToList[list, body.localCtx, indent, body.level];
	  IF why = print THEN RETURN;
	  list _ AddArguments[list,ibti,ex];
	  ex _ in;
	  END;
	ENDCASE => list _ AddToList[list, body.localCtx, indent, body.level];
      indent _ indent - 2;
      IF ibti = Symbols.RootBti THEN RETURN;
      ENDLOOP;
    END;

  AddToList: PROC [
    list: Pc.CtxLink, ctx: Symbols.CTXIndex, indent: CARDINAL, level: Symbols.ContextLevel] 
    RETURNS [newList: Pc.CtxLink] =
    BEGIN
    null: BOOLEAN _ ctx = Symbols.CTXNull;
    newList _ Storage.Node[SIZE[Pc.CtxItem]];
    IF null THEN
      newList^ _ [
	link: list, indirect: FALSE, indent: indent, onStack: FALSE,
	mapped: null, null: null, body: empty[level]]
    ELSE newList^ _ [
	link: list, indirect: FALSE, indent: indent, onStack: FALSE,
	mapped: null, null: null, body: context[ctx]];
    END;

  AddArguments: PROC [list: Pc.CtxLink, bti: BTIndex, ex: DebugFormat.EXOI]
      RETURNS [newList: Pc.CtxLink] =
    BEGIN
    i: Item = FindUserCbti[argGf, LOOPHOLE[bti]];
    seb: Table.Base = Table.Bounds[Symbols.seType].base;
    bb: Table.Base = Table.Bounds[Symbols.bodyType].base;
    cbti: CBTIndex;
    IF i = ItemNull THEN ERROR NotCallable;
    cbti _ cache[i].dCbti;
    WITH seb[bb[cache[i].dCbti].ioType] SELECT FROM
      transfer => {
        newList _ AddRecord[seb, list, LOOPHOLE[outRecord], ex = exit];
        newList _ AddRecord[seb, newList, LOOPHOLE[inRecord], ex = entry] };
      ENDCASE => ERROR NotCallable;
    END;

  AddRecord: PROC [
      seb: Table.Base, list: Pc.CtxLink, rsei: Symbols.RecordSEIndex, onStack: BOOLEAN] 
    RETURNS [newList: Pc.CtxLink] =
    BEGIN
    IF rsei = Symbols.RecordSENull THEN RETURN [list];
    newList _ Storage.Node[SIZE[Pc.CtxItem]];
    newList^ _ [link: list, indent:, onStack: onStack, mapped: TRUE, null: FALSE, 
      indirect: seb[rsei].length/MachineDefs.WordLength > MaxParmsInStack,
      body: context[seb[rsei].fieldCtx]];
    END;

  Reverse: PROC [list: Pc.CtxLink] RETURNS [reverse: Pc.CtxLink] =
    BEGIN
    next: Pc.CtxLink;
    reverse _ NIL;
    FOR i: Pc.CtxLink _ list, next UNTIL i = NIL DO
      next _ i.link;
      i.link _ reverse;
      reverse _ i;
      ENDLOOP;
    END;

  END.