-- AMModelPrivateImpl.Mesa
-- Russ Atkinson, November 16, 1982 11:46 am
-- Paul Rovner, December 20, 1982 4:19 pm

DIRECTORY
    AMModel USING [CharIndex],
    AMModelPrivate USING
      [EPI, FGIndex, FGNull, NullPCOffset, PCOffset],
    RTSymbols USING [SymbolTableBase, BodyIndex, FineGrainTableEntry, nullBodyIndex,
                           rootBodyIndex, BodyTableEntry];

AMModelPrivateImpl: PROGRAM
  EXPORTS AMModelPrivate
  = BEGIN OPEN AMModel, AMModelPrivate, RTSymbols;

  -- local type definitions
  
  BodyPtr: TYPE = LONG POINTER TO BodyTableEntry;
  EPIndex: TYPE = AMModelPrivate.EPI;
  FGCard: TYPE = CARDINAL;
  FGPtr: TYPE = LONG POINTER TO FineGrainTableEntry;
  
  -- kludge for the missing FGI
  fudge: INT _ 8; -- number of characters to assume beyond the last fgi in a procedure

  -- procedures exported to AMModelPrivate

  FGIToEPI: PUBLIC PROC
      [stb: SymbolTableBase, fgi: FGIndex] RETURNS [epi: EPIndex _ 0] = {
    -- returns first fine grain index for the given procedure
    -- (0 for start proc OR invalid fgi)
    bti: BodyIndex;
    IF fgi = FGNull THEN RETURN;
    bti _ FGItoBTI[stb, fgi];
    IF bti # nullBodyIndex THEN
        {body: BodyPtr _ @stb.bb[bti];
         WITH ext: body^ SELECT FROM
           Callable => epi _ ext.entryIndex;
           ENDCASE => RETURN;
         };
    };

  EPIToFirstFGI: PUBLIC PROC
      [stb: SymbolTableBase, epi: EPIndex]
      RETURNS [fgi: FGIndex _ FGNull] = {
    -- returns first fine grain index for the given procedure
    -- (FGNull for invalid epi)
    bti: BodyIndex _ EPItoBTI[stb, epi];
    IF bti = nullBodyIndex THEN RETURN;
    WITH info: stb.bb[bti].info SELECT FROM
         External => fgi _ [fgCard: info.startIndex, fudge: FALSE];
         ENDCASE;
    };

  EPIToLastFGI: PUBLIC PROC
      [stb: SymbolTableBase, epi: EPIndex]
      RETURNS [fgi: FGIndex _ FGNull] = {
    -- returns last fine grain index for the given procedure
    -- (FGNull for invalid epi)
    bti: BodyIndex _ EPItoBTI[stb, epi];
    IF bti = nullBodyIndex THEN RETURN;
    WITH info: stb.bb[bti].info SELECT FROM
         External =>
           fgi _ [fgCard: info.startIndex + MAX[info.indexLength, 1] - 1,
                   fudge: TRUE];
         ENDCASE;
    };

  EPIToFirstPC: PUBLIC PROC
      [stb: SymbolTableBase, epi: EPIndex]
      RETURNS [pc: PCOffset _ NullPCOffset] = {
    -- returns offset (usually 0) of first byte in the procedure
    bti: BodyIndex _ EPItoBTI[stb, epi];
    IF bti = nullBodyIndex THEN RETURN;
    pc _ 0;
    };

  EPIToLastPC: PUBLIC PROC
      [stb: SymbolTableBase, epi: EPIndex]
      RETURNS [pc: PCOffset _ NullPCOffset] = {
    -- returns offset of last byte in the procedure (may be padding byte)
    bti: BodyIndex _ EPItoBTI[stb, epi];
    IF bti = nullBodyIndex THEN RETURN;
    WITH info: stb.bb[bti].info SELECT FROM
         External => {pc _ info.bytes; pc _ pc - 1};
         ENDCASE;
    };

  CharIndexToFGI: PUBLIC PROC
      [stb: SymbolTableBase, ci: CharIndex] RETURNS [fgi: FGIndex _ FGNull] = {
    -- returns the "best" fine grain index for the given character position
    -- (FGNull for invalid position)
      bti: BodyIndex _ nullBodyIndex;
      usedFudge: BOOL _ FALSE;
      [bti, usedFudge] _ CItoBTI[stb, ci];
      IF bti # nullBodyIndex THEN
         {body: BodyPtr _ @stb.bb[bti];
          WITH info: body.info SELECT FROM
             External =>
               {firstFGI: FGCard _ info.startIndex;
                lastFGI: FGCard _ firstFGI + MAX[info.indexLength, 1] - 1;
                thisCI: CharIndex _ body.sourceIndex;
                fgi _ [fgCard: firstFGI, fudge: FALSE];
                FOR tfgi: FGCard IN [firstFGI..lastFGI] DO
                  fp: FGPtr _ @stb.fgTable[tfgi];
                  nextCI: CharIndex _ thisCI;
                  fgi.fgCard _ tfgi;
                  -- we try not to stop at a source step, because source steps usually come
                  -- just before the pc step for the statement (sigh)
                  WITH fp^ SELECT FROM
                     normal => 
                       nextCI _ nextCI + deltaSource;
                     step => 
                       IF which = source THEN 
                          {thisCI _ nextCI + delta; LOOP};
                     ENDCASE;
                  IF nextCI > ci THEN RETURN;
                  thisCI _ nextCI;
                  ENDLOOP;
                fgi.fudge _ TRUE;
                };
             ENDCASE;
          };
    };

  PCToFGI: PUBLIC PROC
      [stb: SymbolTableBase, epi: EPIndex, pc: PCOffset]
      RETURNS [fgi: FGIndex _ FGNull] = {
    -- returns the "best" fine grain index for the given pc offset in the given procedure
    -- (FGNull for invalid epi or invalid pc)
    bti: BodyIndex _ EPItoBTI[stb, epi];
    IF bti # nullBodyIndex THEN
       {body: BodyPtr _  @stb.bb[bti];
        WITH info: body.info SELECT FROM
          External =>
            {firstFGI: FGCard _ info.startIndex;
             lastFGI: FGCard _ firstFGI + MAX[info.indexLength, 1] - 1;
             rem: INT _ pc;
             IF pc >= info.bytes THEN RETURN [FGNull];
             fgi _ [fgCard: firstFGI, fudge: FALSE];
             FOR tfgi: FGCard IN [firstFGI..lastFGI] DO
                fp: FGPtr _ @stb.fgTable[tfgi];
                fgi.fgCard _ tfgi;
                IF rem = 0 THEN RETURN;
                WITH fp^ SELECT FROM
                   normal => rem _ rem - deltaObject;
                   step => IF which = object THEN rem _ rem - delta;
                   ENDCASE;
                IF rem < 0 THEN RETURN;
                ENDLOOP;
             fgi.fudge _ TRUE;
             };
          ENDCASE;
        };
    };

  NextFGI: PUBLIC PROC
      [stb: SymbolTableBase, fgi: FGIndex, epi: EPIndex]
      RETURNS [nfgi: FGIndex _ FGNull] = {
    -- takes a FGIndex & entry point, returns the next FGIndex
    -- returns FGNull if next fgi is in a different proc than entryPointIndex
    -- OR the given FGIndex or entry point was not valid
    bti: BodyIndex;
    IF fgi = FGNull THEN RETURN;
    bti _ EPItoBTI[stb, epi];
    IF bti # nullBodyIndex THEN
         WITH info: stb.bb[bti].info SELECT FROM
           External =>
             {firstFGI: FGCard _ info.startIndex;
              lastFGI: FGCard _ firstFGI + MAX[info.indexLength, 1] - 1;
              IF fgi.fudge OR fgi.fgCard NOT IN [firstFGI..lastFGI] THEN RETURN;
              IF fgi.fgCard = lastFGI
                 THEN fgi.fudge _ TRUE
                 ELSE fgi.fgCard _ fgi.fgCard + 1;
              nfgi _ fgi;
              };
           ENDCASE;
    };

  FGIToFirstChar: PUBLIC PROC
      [stb: SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex _ -1] = {
    -- takes a FGIndex, returns the first character position
    -- -1 for invalid fgi
    bti: BodyIndex _ FGItoBTI[stb, fgi];
    IF bti # nullBodyIndex THEN
         {body: BodyPtr _ @stb.bb[bti];
          WITH info: body.info SELECT FROM
            External =>
              {firstFGI: FGCard _ info.startIndex;
               fgc: FGCard _ fgi.fgCard + (IF fgi.fudge THEN 1 ELSE 0);
               ci _ body.sourceIndex;
               FOR tfgc: FGCard IN [firstFGI..fgc) DO
                 fp: FGPtr _ @stb.fgTable[tfgc];
                 WITH fp^ SELECT FROM
                    normal => ci _ ci + deltaSource;
                    step => IF which = source THEN ci _ ci + delta;
                    ENDCASE;
                 ENDLOOP;
               IF fgc > firstFGI THEN
                  {-- look back one fgi to see if this it was a source step
                   -- if it was, subtract it out
                   fp: FGPtr _ @stb.fgTable[fgc - 1];
                   WITH fp^ SELECT FROM
                      step => IF which = source THEN ci _ ci - delta;
                      ENDCASE;
                   };
               };
            ENDCASE;
          };
    };

  FGIToLastChar: PUBLIC PROC
      [stb: SymbolTableBase, fgi: FGIndex] RETURNS [ci: CharIndex _ -1] = {
    -- takes a FGIndex, returns the last character position
    -- -1 for invalid fgi
    bti: BodyIndex _ FGItoBTI[stb, fgi];
    IF bti # nullBodyIndex THEN
         {body: BodyPtr _ @stb.bb[bti];
         WITH info: body.info SELECT FROM
           External =>
             {firstFGI: FGCard _ info.startIndex;
              lastFGI: FGCard _ firstFGI + MAX[info.indexLength, 1] - 1;
              ci _ body.sourceIndex;
              FOR tfgi: FGCard IN [firstFGI..fgi.fgCard] DO
                 fp: FGPtr _ @stb.fgTable[tfgi];
                 WITH fp^ SELECT FROM
                    normal => ci _ ci + deltaSource;
                    step => IF which = source THEN ci _ ci + delta;
                    ENDCASE;
                 ENDLOOP;
              IF fgi.fudge
                 THEN ci _ ci + fudge
                 ELSE ci _ ci - 1;
              };
           ENDCASE;
         };
    };

  FGIToFirstPC: PUBLIC PROC
      [stb: SymbolTableBase, fgi: FGIndex] RETURNS [pc: PCOffset _ NullPCOffset] = {
    -- takes a FGIndex, returns the first character position
    -- (NullPCOffset for invalid fgi)
    bti: BodyIndex _ FGItoBTI[stb, fgi];
    IF bti # nullBodyIndex THEN
         {body: BodyPtr _ @stb.bb[bti];
          WITH info: body.info SELECT FROM
            External =>
              {firstFGI: FGCard _ info.startIndex;
               tfgi: FGCard _ fgi.fgCard + (IF fgi.fudge THEN 1 ELSE 0);
               pc _ 0;
               FOR tfgi IN [firstFGI..tfgi) DO
                 fp: FGPtr _ @stb.fgTable[tfgi];
                 WITH fp^ SELECT FROM
                    normal => pc _ pc + deltaObject;
                    step => IF which = object THEN pc _ pc + delta;
                    ENDCASE;
                 ENDLOOP;
               };
            ENDCASE;
          };
    };

  FGIToLastPC: PUBLIC PROC
      [stb: SymbolTableBase, fgi: FGIndex] RETURNS [pc: PCOffset _ NullPCOffset] = {
    -- returns offset of last byte in the fine grain entry
    -- (NullPCOffset for invalid fgi)
      bti: BodyIndex _ FGItoBTI[stb, fgi];
      IF bti # nullBodyIndex THEN
         {body: BodyPtr _ @stb.bb[bti];
         WITH info: body.info SELECT FROM
           External =>
             {firstFGI: FGCard _ info.startIndex;
              IF fgi.fudge THEN
                 {pc _ info.bytes; pc _ pc - 1; RETURN};
              pc _ 0;
              FOR tfgi: FGCard IN [firstFGI..fgi.fgCard] DO
                 fp: FGPtr _ @stb.fgTable[tfgi];
                 WITH fp^ SELECT FROM
                    normal => pc _ pc + deltaObject;
                    step => IF which = object THEN pc _ pc + delta;
                    ENDCASE;
                 ENDLOOP;
              pc _ pc - 1;
              };
           ENDCASE;
         };
    };

  -- implementation procedures

  EPItoBTI: PROC
      [stb: SymbolTableBase, epi: EPIndex] RETURNS [outerBti: BodyIndex _ nullBodyIndex] = {
    -- takes a SymbolTableBase & entry point
    -- returns a Callable BTI for the entry point
    -- or nullBodyIndex if that can't be done
    innerEPItoBTI: PROC [bti: BodyIndex] RETURNS [stop: BOOL _ FALSE] = {
      body: BodyPtr _ @stb.bb[bti];
      thisEPI: EPIndex _ 0;
      WITH ext: body^ SELECT FROM
        Callable => thisEPI _ ext.entryIndex;
        ENDCASE => RETURN;
      WITH info: body.info SELECT FROM
         External =>
           IF epi = thisEPI THEN {outerBti _ bti; stop _ TRUE};
         ENDCASE;
      };
    [] _ stb.EnumerateBodies[rootBodyIndex, innerEPItoBTI];
    };

  FGItoBTI: PROC
      [stb: SymbolTableBase, fgi: FGIndex] RETURNS [outerBti: BodyIndex _ nullBodyIndex] = {
    -- takes a SymbolTableBase & FGIndex
    -- returns a Callable BTI containing the FGIndex
    -- or nullBodyIndex if that can't be done
    innerFGItoBTI: PROC [bti: BodyIndex] RETURNS [stop: BOOL _ FALSE] = {
      body: BodyPtr _ @stb.bb[bti];
      thisEPI: EPIndex _ 0;
      WITH ext: body^ SELECT FROM
        Callable => thisEPI _ ext.entryIndex;
        ENDCASE => RETURN;
      WITH info: body.info SELECT FROM
         External =>
           {firstFGI: FGCard _ info.startIndex;
            lastFGI: FGCard _ firstFGI + MAX[info.indexLength, 1] - 1;
            IF fgi.fgCard IN [firstFGI..lastFGI] THEN
               {outerBti _ bti; stop _ TRUE};
            };
         ENDCASE;
      };
    [] _ stb.EnumerateBodies[rootBodyIndex, innerFGItoBTI];
    };

  CItoBTI: PROC
      [stb: SymbolTableBase, ci: CharIndex]
      RETURNS [bestBTI: BodyIndex _ nullBodyIndex, usedFudge: BOOL _ FALSE] = {
    -- takes a SymbolTableBase & character position
    -- returns a Callable BTI containing the FGIndex
    -- or nullBodyIndex if that can't be done
    innerCItoBTI: PROC [bti: BodyIndex] RETURNS [stop: BOOL _ FALSE] = {
      -- NOTE: we assume that the character ranges
      -- covered by the Callable BTI's are disjoint or nested
      -- and the smallest source range containing the index is the one desired
      body: BodyPtr _ @stb.bb[bti];
      thisEPI: EPIndex _ 0;
      bestCI: CharIndex _ 0;
      WITH ext: body^ SELECT FROM
        Callable => thisEPI _ ext.entryIndex;
        ENDCASE => RETURN;
      WITH info: body.info SELECT FROM
         External =>
           {firstFGI: FGCard _ info.startIndex;
            lastFGI: FGCard _ firstFGI + MAX[info.indexLength, 1] - 1;
            thisCI: CharIndex _ body.sourceIndex;
            IF thisCI <= ci AND bestCI <= thisCI THEN
               {-- determine from fine grain table if this char index is valid
                lastCI: CharIndex _ thisCI;
                FOR tfgi: FGCard IN [firstFGI..lastFGI] DO
                  fp: FGPtr _ @stb.fgTable[tfgi];
                  WITH fp^ SELECT FROM
                    normal => lastCI _ lastCI + deltaSource;
                    step => IF which = source THEN lastCI _ lastCI + delta;
                    ENDCASE;
                  IF lastCI >= ci THEN EXIT; -- this index is OK
                  ENDLOOP;
                IF lastCI < ci
                   THEN
                     {IF lastCI+fudge < ci THEN RETURN; -- no match here
                      usedFudge _ TRUE}
                    ELSE usedFudge _ FALSE;
                bestBTI _ bti;
                bestCI _ thisCI;
                };
            };
         ENDCASE;
      };
    [] _ stb.EnumerateBodies[rootBodyIndex, innerCItoBTI];
    };

  END.

Κw–
"Mesa" style˜IprocšžΟcsΟk	œ
žœ!žœžœ:žœ’
žœžœžœ
žœ(œžœžœ
žœ
žœžœžœžœžœžœžœ
žœ
žœœ	žœEœ)œΟnœžœ
žœ,žœ<œ'œžœžœ
žœ$žœžœ1žœžœ
žœ9žœžœŸ
œžœ
žœ2žœ<œœ-žœžœ
žœžœžœ
žœ=žœžœŸœžœ
žœ2žœ;œœ-žœžœ
žœžœžœ
žœBžœ5žœžœŸœžœ
žœ2žœ'=œ-žœžœ
žœŸœžœ
žœ2žœ%Hœ-žœžœ
žœžœžœ
žœ?žœŸœžœ
žœ-žœ!Hœ#œ7žœžœ3žœžœ3žœžœ
žœ{žœ™
žœžœžœ˜
Jœ4œžœžœ
žœŒ
žœžœ6žœžœžœ
žœ
žœ7žœžœ"žœŸœžœ
žœ@žœ!Vœ,œ-žœž
œ/žœžœ
žœržœ-žœžœžœ
žœ8žœžœžœžœdžœ	žœ
žœžœžœ
žœRžœžœ'žœžœ	žœ
žœžœžœžœŸœžœ
žœ@žœ";œJœ5œžœžœ
žœ$žœžœ
žœžœ
žœužœ)žœžœžœ
žœžœ
žœžœ'žœ
žœžœTžœŸœžœ
žœ,žœ9œœ-žœžœ3žœžœ
žœwžœžœžœ:žœžœžœCžœžœ
žœRžœžœ&žœžœžœžœjœIžœžœ
žœžœžœ(žœ6žœŸ
œžœ
žœ,žœ8œœ-žœžœ2žœžœ
žœužœNžœžœžœCžœžœ
žœRžœžœ&žœžœžœžœ"žœ*žœŸœžœ
žœ,žœ'9œ$œ-žœžœ3žœžœ
žœxžœžœžœ+žœžœžœCžœžœ
žœRžœžœ&žœžœ žœŸœžœ
žœ,žœ%9œ$œ1žœžœ2žœžœ
žœXžœžœ1žœ'žœžœžœCžœžœ
žœRžœžœ&žœžœ9žœœŸœžœ,žœ/)œ.œœ
œžœžœžœžœLžœžœ
žœ7žœžœžœžœ
žœ!žœžœžœžœQŸœžœ,žœ/%œ1œœ
œžœžœžœžœLžœžœ
žœ7žœžœžœžœ
žœožœ'žœžœžœ(žœžœQŸœžœ3žœ1žœžœ
0œ1œœ
œžœžœžœžœ-œ8œIœcžœžœ
žœ7žœžœžœžœ
žœožœYžœžœžœ?œ<žœžœžœEžœžœ
žœZžœžœ.žœžœžœ
žœœžœžœ žœžœžœ
žœœ"žœžœ
žœmžœPžœ˜Άp—…—88>΅