home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPU55A.ZIP / TPUAMS1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-10  |  29.1 KB  |  930 lines
  1. {$D+,O+,S+,R-,L+}
  2. Unit TPUAMS1;
  3.  
  4. (*****************)
  5. (**) INTERFACE (**)
  6. (*****************)
  7.  
  8. USES Dos;
  9.  
  10. TYPE
  11.  
  12.   Str2   = String[2]; Str4 = String[4];
  13.   RngB   = 0..65534;
  14.   RngW   = 0..32766;
  15.   AryB   = ARRAY[rngb] OF Byte;
  16.   AryW   = ARRAY[rngw] OF Word;
  17.   SrcNam = String[12];
  18.   LexNam = String[63];
  19.  
  20.   HdrAry = ARRAY[0..3] OF Char;
  21.  
  22.   LL  = Word;               { Local Scope Pointers (offsets) }
  23.  
  24.   LG  = RECORD              { Global Scope Pointers to Other Units }
  25.              UntLL : LL;    { Local to containing unit }
  26.              UntId : LL;    { Local to  external  unit }
  27.         END;
  28.  
  29.   { The following Record is the Header and Locator for a Unit File } {.CP26}
  30.  
  31.   UnitHeadPtr = ^UnitHeader;
  32.   UnitHeader = RECORD
  33.     FilHd : HdrAry;        { +00 : = 'TPU6'                     }
  34.     Fillr : HdrAry;        { +04 : = $00000000                  }
  35.     UDirE : LL;        { +08 : to Dictionary Head-This Unit }
  36.     UGHsh : LL;        { +0A : to Interface Hash Header     }
  37.     UHPrc : LL;        { +0C : to PROC Map                  }
  38.     UHCsg : LL;        { +0E : to CSeg Map                  }
  39.     UHDsT : LL;        { +10 : to DSeg Map-Typed CONST's    }
  40.     UHDsV : LL;        { +12 : to DSeg Map-GLOBAL Variables }
  41.     URULt : LL;        { +14 : to Donor Unit List           }
  42.     USRCF : LL;        { +16 : to Source file List          }
  43.     UDBTS : LL;        { +18 : to Debug Trace Step Controls }
  44.     UndNC : LL;        { +1A : to end non-code part of Unit }
  45.     ULCod : Word;        { +1C : Size of Code                 }
  46.     ULTCon: Word;        { +1E : Size of Typed Constant Data  }
  47.     ULPtch: Word;        { +20 : Size of Relo Patch List      }
  48.     Unknx : Word;        { +22 : Number of Virtual Objects??? }
  49.     ULVars: Word;        { +24 : Size of GLOBAL VAR Data      }
  50.     UHash2: LL;        { +26 : to Debug Hash Header         }
  51.     UOvrly: Word;        { +28 : Number of Procs to Overlay?? }
  52.     UVTPad: ARRAY[0..10]
  53.         OF Word;    { +2A : Reserved for Future Expansion ? }
  54.  
  55.   END; { UnitHeader }
  56.  
  57.   { The Records below provide access to the PROC Map }        {.CP12}
  58.  
  59.     ProcMapRecPtr  = ^ProcMapRec;
  60.     ProcMapRec = RECORD
  61.         CSegOfs : Word;    { offset within CSeg Map; $FFFF if null }
  62.         CSegJmp : Word;    { offset to entry point;  $FFFF if null }
  63.     END {ProcMapRec};
  64.  
  65.     ProcMapPtr = ^ProcMapTab;
  66.     ProcMapTab = RECORD
  67.         ProcMap : ARRAY[0..1] OF ProcMapRec; { model of PROC Map }
  68.     END; {ProcMapTab}
  69.  
  70.   { The Records below provide access to the CODE Map }        {.CP14}
  71.  
  72.     CSegMapRecPtr = ^CSegMapRec;
  73.     CSegMapRec = RECORD
  74.         CSegWd0 : Word;    { purpose is unknown              }
  75.         CSegCnt : Word;    { byte count of module code       }
  76.         CSegRel : Word;    { byte count of module Relo List  }
  77.         CSegTrc : Word;    { Trace table offset or $FFFF     }
  78.     END; {CSegMapRec}
  79.  
  80.     CSegMapTabPtr = ^CSegMapTab;
  81.     CSegMapTab = RECORD
  82.         CSegMap : ARRAY[0..1] OF CSegMapRec;    { model of CSeg Map }
  83.     END; {CSegMapTab}
  84.  
  85.   { The Records below provide access to the CONST DSeg Map }    {.cp14}
  86.  
  87.     DSegMapRecPtr = ^DSegMapRec;
  88.     DSegMapRec = RECORD
  89.         DSegWd0 : Word;    { purpose is unknown              }
  90.         DSegCnt : Word;    { byte count of data block        }
  91.         DSegRel : Word;    { byte count of data Relo List    }
  92.         DSegOwn : LL;      { To owner scope                  }
  93.     END; {DSegMapRec}
  94.  
  95.     DSegMapTabPtr = ^DSegMapTab;
  96.     DSegMapTab = RECORD
  97.         DSegMap : ARRAY[0..1] OF DSegMapRec;    { model of DSeg Map }
  98.     END; {DSegMapTab}
  99.  
  100.   { The Record below is one entry in the Relo List }{.CP15}
  101.  
  102.     ReloListEntryPtr = ^ReloListEntry;
  103.     ReloListEntry = RECORD
  104.         RloDnr : Byte;    { Donor Unit Offset }
  105.         RloFlg : Byte;    { Entry Format Flag }
  106.         RloWd1 : Word;    { Offset to Map Table  }
  107.         RloWd2 : Word;    { Effective Address Adjuster  }
  108.         RloOfs : Word;    { offset to patch point in code/data block }
  109.     END; {ReloListEntry}
  110.  
  111.     ReloListPtr = ^ReloListVector;
  112.     ReloListVector = RECORD
  113.         ReloList : ARRAY[0..1] OF ReloListEntry; { model of Relo List }
  114.     END; {ReloListVector}
  115.  
  116.   { The Record below maps the Dictionary Header in Turbo Units } {.CP08}
  117.  
  118.     DictHeadPtr = ^ DictHeadRecd;
  119.     DictHeadRecd = RECORD
  120.         HLink : LL;         { Hash Chain Link; Resolves Collisions }
  121.         DForm : Char;       { Symbol Type; See StubRecord for types}
  122.         DSymb : LexNam;     { Worst-Case Symbol Size (UPPER-CASE)  }
  123.     END;
  124.  
  125.   { The Record Below maps the Dictionary Stubs in Turbo Units  } {.CP10}
  126.  
  127.   DictStubPtr = ^ DictStubRcd;
  128.   DictStubRcd = RECORD
  129.       CASE Char OF
  130.  
  131.       'P': (                     { --- For Untyped Constants --- }
  132.             DTG : LG;            { to type descriptor            }
  133.            val1 : Word;          { value of constant - LO Word   }
  134.            val2 : Word);         { (size varies)     - HI Word   }
  135.  
  136.       'Y': (                     { ----- For UNIT Entries ------ }  {.CP05}
  137.             PP  : Word;          { unknown use; normally zero    }
  138.             SIG : Word;          { Speculate Signature Word      }
  139.             UA  : LL;            { to next Unit in List (SUCC)   }
  140.             UZ  : LL);           { to prior Unit in List (PRED)  }
  141.  
  142.       'O',                       { ---- Label Declaratives ----- }  {.CP05}
  143.       'T',                       { ---- Standard Procedures ---- }
  144.       'U',                       { ---- Standard Functions  ---- }
  145.       'V': (                     { ---- Standard "NEW" F/P  ---- }
  146.             D   : Word);         { semantics not precisely known }
  147.  
  148.       'W': (                     { ------- Standard Ports ------ }  {.CP02}
  149.             M   : Byte);         { 0=Byte Array, 1=Word Array    }
  150.  
  151.       'Q',                       { -------- Named Types -------- }  {.CP03}
  152.       'X': (                     { ----- External Variables ---- }
  153.             QTG : LG);           { to type descriptor            }
  154.  
  155.       'R': (                     { -- Variable, Field, Object -- } {.CP22}
  156.             RH   : Byte;         { allocation method codes:      }
  157.                                  { 0 = Global Variables in DS    }
  158.                                  { 1 = Typed Constants  in DS    }
  159.                                  { 2 = LOCAL Variables & VALUE   }
  160.                                  {     Parameters put on Stack   }
  161.                                  { 6 = ADDRESS Parameters-Stack  }
  162.                                  { 8 = Allocate in Record/Object }
  163.  
  164.             ROfs : Word;         { allocation offset in bytes    }
  165.             ROB  : LL;           { *** see notes below           }
  166.             RLG  : LG);          { to Type Descriptor            }
  167.  
  168.             { Variables & Formal Parameters have LL pointing to
  169.           Containing scope or zero if Global.
  170.  
  171.               Record Fields have LL to next Field; zero if none.
  172.  
  173.           Object Fields/Methods have LL to next field/method
  174.           in order of declaration or zero if none.
  175.  
  176.               Typed Constants have offset in Data Map that
  177.           locates text of Typed Constant Data.              }
  178.  
  179.       'S': (                     { ------ User Subprograms ----- }  {.CP24}
  180.             TCod : BYte;         { type code - Bit encoded ????? }
  181.                                  { xxxxxxx1 = INTERFACE declared }
  182.                                  { xxxxxx1x = INLINE Declarative }
  183.                                  { xxxx1xxx = .OBJ module code   }
  184.                                  { xxx1xxxx = METHOD             }
  185.                                  { x011xxxx = Constructor METHOD }
  186.                                  { x101xxxx = Destructor  METHOD }
  187.  
  188.             BCod : Word;         { Code byte count if INLINE,    }
  189.                                  { else, offset to PROC Map      }
  190.             Scop : LL;           { to containing scope or zero   }
  191.             SHsh : LL;           { to local scope hash table     }
  192.             SVMO : Word;         { VMT offset used by METHOD     }
  193.             Smth : LL);          { to next METHOD for Object     }
  194.  
  195.             { Notes: "Smth" is followed immediately by a Type    }
  196.             {        Descriptor ($06).  INLINE Declarative code  }
  197.             {        Bytes then follow (if any).                 }
  198.  
  199.       END;
  200.  
  201.   { The Record below maps a Formal Parameter List Entry }        {.CP08}
  202.  
  203.   FormalParmRcd = RECORD
  204.        TDG : LG;        { to type descriptor for parameter  }
  205.        ALM : Byte;        { passing model; 2=Value, 6=Address }
  206.      END;
  207.  
  208.   InlineLst = ARRAY[0..1] OF Word;        { model of INLINE code }
  209.  
  210.  
  211.   { The Record below maps the Type Descriptors in Turbo Units  } {.CP07}
  212.  
  213.   TypePtr   = ^TypeRecd;
  214.   TypeRecd  = RECORD
  215.     Typ : Byte;        { Identifies the Variant Part }
  216.        TMod : Byte;        { Type Qualifier              }
  217.     Siz : Word;        { Storage Width in Bytes      }
  218.  
  219.        CASE Byte OF                                                  {.CP05}
  220.     $00,            { For NULL or Un-Typed Variables }
  221.     $0A,            { For COMP,DOUBLE,EXTENDED,SINGLE }
  222.     $0B : ();        { -------- For REAL Type -------- }
  223.  
  224.     $01 : (            { ------ For ARRAY Types ------- }  {.CP04}
  225.         BaseType : LG;    { to TypeRecd for item arrayed   }
  226.         BounDesc : LG;    { to TypeRecd for array bounds   }
  227.               );
  228.  
  229.     $02 : (            { ------ For RECORD Types ------ }  {.CP04}
  230.         RecdHash : LL;    { to Hash Table for Field List   }
  231.         RecdDict : LL;    { to Field List Dictionary Begin }
  232.               );
  233.  
  234.     $03 : (            { ------ For OBJECT Types ------ } {.CP11}
  235.         ObjtHash : LL;    { to Fields & Methods Hash Table }
  236.         ObjtDict : LL;    { to Fields & Methods Dictionary }
  237.         ObjtOwnr : LG;    { to Parent Object Type Descript }
  238.         ObjtVMTs : Word;{ Size of VMT if Virtual Methods }
  239.         ObjtDMap : Word;{ Data Map Offset of VMT Skeletn }
  240.         ObjtVMTO : Word;{ offset in allocated object to  }
  241.                 { VMT pointer; $FFFF if object   }
  242.                 { has no Virtual Methods         }
  243.         ObjtName : LL;    { to Object Dictionary Entry     }
  244.               );
  245.  
  246.     $04,            { ----- For FILE except TEXT ----}  {.CP04}
  247.     $05:  (            { ----- For TEXT file type ----- }
  248.         FileType : LG;    { to TypeRecd for Base File Type }
  249.               );
  250.     $06:  (            { ----- For Procedure Types ---- }
  251.         PFRes : LG;    { to Function Result TD / zero   }
  252.         PNPrm : Word;    { Formal Parameter Count/ zero   }
  253.                 PFPar : ARRAY[1..2] OF FormalParmRcd
  254.               );
  255.     $07 : (            { ------- For SET Types -------- } {.CP03}
  256.         SetBase  : LG;    { to base type descriptor of set }
  257.               );
  258.  
  259.     $08 : (            { ----- For POINTER Types ------ } {.CP03}
  260.         PtrBase  : LG;    { to base type descriptor        }
  261.               );
  262.  
  263.     $09 : (            { ------ For STRING Types ------ } {.CP04}
  264.         StrBase  : LG;    { to SYSTEM.CHAR type descriptor }
  265.         StrBound : LG;    { to array bounds for string typ }
  266.               );
  267.  
  268.     $0C,            { For BYTE,INTEGER,LONGINT,SMALLINT,WORD }{.CP15}
  269.     $0D,            { ------- For BOOLEAN Type ------ }
  270.     $0E,            { ------- For CHAR Type --------- }
  271.     $0F : (            { ---- For Enumerated Types ----- }
  272.         LoBnd : LongInt;{ lower bound of subrange         }
  273.         HiBnd : LongInt;{ upper bound of subrange         }
  274.         Cmpat : LG;    { to upward compatible Type desc  }
  275.               );
  276.  
  277.         { The Enumerated Type Descriptor is immediately
  278.           followed by a SET Type Descriptor ($07) but we
  279.           don't know what this accomplishes.  Its base type
  280.           LG points to the Enumerated Type Descriptor.       }
  281.  
  282.        END;  { TypeRecd }
  283.  
  284.  
  285.   { The Record below is a model Hash Table }                         {.CP08}
  286.  
  287.     HashPtr   = ^HashTable;
  288.     HashTable = RECORD
  289.         Bas : Word;        { Base and Max Subscript of Slt * 2 }
  290.         Slt : ARRAY[0..1]    { Slots in Hash Table               }
  291.                 OF LL;
  292.     END;
  293.  
  294.   { The Record below is an entry in the Unit Code/Data Donor List } {.CP07}
  295.  
  296.     UnitDonorPtr = ^UnitDonorRec;
  297.     UnitDonorRec = RECORD
  298.         UDExxx : Word;
  299.         UDEnam : String[8]
  300.     END;
  301.  
  302.   { The Record below is an entry in the Source File List }            {.CP10}
  303.  
  304.     SrcFilePtr = ^SrcFileEntry;
  305.     SrcFileEntry = RECORD
  306.         SrcFlag : Byte;        { 4=.PAS file, 3=.INC, 5=.OBJ       }
  307.         SrcPad  : Word;        { no apparent use - always zero ?   }
  308.         SrcTime : Word;        { File Time Stamp if SrcFlag=3 or 4 }
  309.         SrcDate : Word;        { File Date Stamp if SrcFlag=3 or 4 }
  310.         SrcName : SrcNam;    { Varying length FileName.Extn      }
  311.     END;
  312.  
  313.   { The Record below is an entry in the Trace Table      }          {.CP12}
  314.  
  315.     TraceRecPtr = ^TraceRec;
  316.     TraceRec    = RECORD
  317.         TrName : LL;     { to Directory Entry of Proc/Method  }
  318.         TrFill : Word;     { to proc source file                }
  319.         TrPfx  : Word;     { bytes of data in front of code     }
  320.         TrBeg  : Word;     { Line Number of BEGIN Stmt          }
  321.         TrLNos : Word;     { Lines of Code to Execute in TRACE  }
  322.         TrExec : ARRAY[1..2] { Model Array of bytes that map each }
  323.              OF Byte;     { line of code to be traced by DEBUG }
  324.     END;
  325.  
  326.   BufPtr = ^Buffer;                                             {.CP06}
  327.   Buffer = RECORD               { General Buffer Mapping }
  328.     CASE Boolean OF
  329.       True :( BufByt : AryB);   { Byte Array over Buffer }
  330.       False:( BufWrd : AryW);   { Word Array over Buffer }
  331.     END;
  332.  
  333.     CMapRefRec =    { CSeg/File/Fix-UP correlations }    {.CP14}
  334.       RECORD
  335.         CmNdxC : Integer;    { index to CSeg Map }
  336.         CmNdxF : LL;        { offset to Source File }
  337.         CmSegL : LL;        { Segment Load Point }
  338.         CmSegS : LL;        { Segment Byte Count }
  339.         CmNdxR : Integer;    { Index to First Fix-up Entry }
  340.         CmCntR : Integer;       { Index to Final Fix-up Entry }
  341.       END;
  342.     CMapRefPtr = ^CMapRefTab;
  343.     CMapRefTab =
  344.       RECORD
  345.         CMRefs : ARRAY[0..199] OF CMapRefRec;
  346.       END;
  347.  
  348.     PMapRefRec =    { PROC/CSeg correlations }        {.CP14}
  349.       RECORD
  350.         PmNdxP : Word;    { index to PROC Map }
  351.         PmNdxC : Word;    { index to CSeg Map }
  352.         PmDirN : LL;    { LL to PROC name or $FFFF }
  353.         PmEntP : LL;    { to PROC Entry in Segment or $FFFF}
  354.         PmSizP : Word;    { PROC Length (Bytes) or 0 }
  355.       END;
  356.  
  357.     PMapRefPtr = ^PMapRefTab;
  358.     PMapRefTab =
  359.       RECORD
  360.         PMRefs : ARRAY[0..199] OF PMapRefRec;
  361.       END;
  362.  
  363. VAR                                                             {.CP05}
  364.  
  365.   BufPtrJob : BufPtr;
  366.   PMapC: CMapRefPtr;    NMapC : Word;    { Built on request }
  367.   PMapP: PMapRefPtr;    NMapP : Word;    { Built on request }
  368.  
  369.  
  370. PROCEDURE InitJobUnit(FilNam:Dos.PathStr);                      {.CP25}
  371. PROCEDURE XrefMaps(U:UnitHeadPtr);
  372. PROCEDURE DropJobUnit;
  373. FUNCTION  PtrAdjust(Arg : Pointer; Adj: Word):Pointer;
  374. FUNCTION  FormLL(Base,Ceil:Pointer):LL;
  375. FUNCTION  HexB(Arg:byte):Str2;
  376. FUNCTION  HexW(Arg:Word):Str4;
  377. FUNCTION  AddrStub(arg : DictHeadPtr):DictStubPtr;
  378. FUNCTION  AddrHash(U : UnitHeadPtr; Hash : LL): HashPtr;
  379. FUNCTION  AddrDict(U : UnitHeadPtr; Hash : LL): DictHeadPtr;
  380. FUNCTION  AddrType(U : UnitHeadPtr; TypeLG : LG):TypePtr;
  381. FUNCTION  AddrProcType(S : DictStubPtr):TypePtr;
  382. FUNCTION  AddrNxtSrc(U : UnitHeadPtr; Arg : SrcFilePtr):SrcFilePtr;
  383. FUNCTION  AddrSrcTabOff(U : UnitHeadPtr; Offset : Word):SrcFilePtr;
  384. FUNCTION  CountPMapSlots(U : UnitHeadPtr):Integer;
  385. FUNCTION  AddrPMapTab(U : UnitHeadPtr):ProcMapPtr;
  386. FUNCTION  CountCMapSlots(U : UnitHeadPtr):Integer;
  387. FUNCTION  AddrCMapTab(U : UnitHeadPtr):CSegMapTabPtr;
  388. FUNCTION  CountDMapSlots(U : UnitHeadPtr):Integer;
  389. FUNCTION  AddrDMapTab(U : UnitHeadPtr):DSegMapTabPtr;
  390. FUNCTION  AddrTraceTab(U : UnitHeadPtr):TraceRecPtr;
  391. FUNCTION  GetTrExecSize(T : TraceRecPtr):Integer;
  392. FUNCTION  AddrNxtTrace(U : UnitHeadPtr; T : TraceRecPtr):TraceRecPtr;
  393. FUNCTION  AddrFixUps(U : UnitHeadPtr):ReloListPtr;
  394. FUNCTION  AddrLGUnit(U : UnitHeadPtr; TypeLG : LG):DictHeadPtr;
  395. { ============================================================= } {.CP27}
  396.  
  397. (**********************)
  398. (**) IMPLEMENTATION (**)
  399. (**********************)
  400.  
  401. TYPE
  402.  
  403.   Fstats = RECORD
  404.     Size : Longint;
  405.     Path : Dos.PathStr;
  406.   END;
  407.  
  408. CONST
  409.  
  410.   TurboId6  : HdrAry = 'TPU6';
  411.   NullOfs   : Word   = $FFFF;
  412.  
  413. VAR
  414.  
  415.   TPFile    : File;
  416.   CMapSiz,
  417.   PMapSiz,
  418.   SizRefBfr,
  419.   SizJobBfr : Word;
  420.   BufPtrRef : BufPtr;
  421.  
  422.   JobPath   : Dos.PathStr;
  423.  
  424.   { Procedure Below Traps Pointer Violations }            {.CP10}
  425.  
  426. PROCEDURE CheckPtrs(U,V:Pointer);
  427. BEGIN
  428.     IF (U = Nil) OR (V = Nil) OR (Seg(U^) <> Seg(V^)) THEN
  429.     BEGIN
  430.         WriteLn('Pointer Violation');
  431.         Halt(1)
  432.     END
  433. END; {CheckPtrs}
  434.  
  435.   { Function Below Computes an LL from two Pointers }           {.CP09}
  436.  
  437. FUNCTION  FormLL(Base,Ceil:Pointer):LL;
  438. BEGIN
  439.     CheckPtrs(Base,Ceil);
  440.     IF Ofs(Base^) > Ofs(Ceil^)
  441.         THEN FormLL := LL(Ofs(Base^)-Ofs(Ceil^))
  442.         ELSE FormLL := LL(Ofs(Ceil^)-Ofs(Base^));
  443. END;
  444.  
  445.   { Function Below Adjusts Pointer Values by Offsets }           {.CP04}
  446.  
  447. FUNCTION  PtrAdjust(Arg : Pointer; Adj: Word):Pointer;
  448. BEGIN     PtrAdjust := Ptr(Seg(Arg^),Ofs(Arg^) + Adj)     END;
  449.  
  450.   { Function Below Finds The Stub Belonging to a Dictionary Header } {.CP05}
  451.  
  452. FUNCTION  AddrStub(Arg : DictHeadPtr):DictStubPtr;
  453. CONST PrefixSize = SizeOf(LL)+SizeOf(Char) + 1;
  454. BEGIN  AddrStub := PtrAdjust(Arg,PrefixSize + Ord(Arg^.DSymb[0]))  END;
  455.  
  456.   { Function Below Gets Pointer to Hash Table }                  {.CP04}
  457.  
  458. FUNCTION  AddrHash(U : UnitHeadPtr; Hash : LL): HashPtr;
  459. BEGIN   AddrHash := HashPtr(PtrAdjust(U,Hash))  END;
  460.  
  461.   { Function Below Gets Pointer to Dictionary Entry using LL }   {.CP04}
  462.  
  463. FUNCTION  AddrDict(U : UnitHeadPtr; Hash : LL): DictHeadPtr;
  464. BEGIN AddrDict := DictHeadPtr(PtrAdjust(U,Hash)) END;
  465.  
  466.   { Function Below Gets Pointer to Type Descriptor if Local to Unit } {.CP12}
  467.  
  468. FUNCTION  AddrType(U : UnitHeadPtr; TypeLG : LG):TypePtr;
  469. VAR D:DictHeadPtr; S:DictStubPtr; R:LL;
  470. BEGIN
  471.     D := AddrDict(U,U^.UDirE);
  472.     S := AddrStub(D);
  473.     R := FormLL(U,S);
  474.     IF R = TypeLG.UntId
  475.         THEN AddrType := TypePtr(PtrAdjust(U,TypeLG.UntLL))
  476.         ELSE AddrType := Nil
  477. END;
  478.  
  479.   { Function Below Gets Pointer to Unit Descriptor for Type via LG } {.CP21}
  480.  
  481. FUNCTION  AddrLGUnit(U : UnitHeadPtr; TypeLG : LG):DictHeadPtr;
  482. VAR D:DictHeadPtr; S:DictStubPtr; R:LL;
  483. BEGIN
  484.     D := AddrDict(U,U^.UDirE);
  485.     S := AddrStub(D);
  486.     R := FormLL(U,S);
  487.     IF (R <> 0) THEN
  488.     IF (TypeLG.UntID <> R) THEN
  489.         REPEAT
  490.             D := AddrDict(U,S^.UA);
  491.             IF D^.DForm <> 'Y' THEN R := 0 ELSE
  492.             BEGIN
  493.                 S := AddrStub(D);
  494.                 R := FormLL(U,S);
  495.             END;
  496.         UNTIL (R = TypeLG.UntID) OR (R = 0);
  497.     IF R <> 0     THEN AddrLGUnit := D
  498.             ELSE AddrLGUnit := Nil;
  499. END;
  500.  
  501.   { Function Below Gets Pointer to Procedure Stub Type Descriptor }{.CP04}
  502.  
  503. FUNCTION  AddrProcType(S : DictStubPtr):TypePtr;
  504. BEGIN AddrProcType := TypePtr(PtrAdjust(@S^.Smth,SizeOf(S^.Smth))) END;
  505.  
  506.   { Function Below Gets Pointer to Next Entry in Source File List } {.CP21}
  507.  
  508. FUNCTION  AddrNxtSrc(U : UnitHeadPtr; Arg : SrcFilePtr):SrcFilePtr;
  509. VAR J : LL;  S : SrcFilePtr;
  510. BEGIN
  511.     J := 0;
  512.     IF Arg = Nil THEN AddrNxtSrc := Nil ELSE
  513.     BEGIN
  514.         J := FormLL(U,Arg);
  515.         IF J < U^.USRCF
  516.         THEN AddrNxtSrc := Nil ELSE
  517.         IF NOT (J < U^.UDBTS)
  518.         THEN AddrNxtSrc := Nil ELSE
  519.         BEGIN
  520.             S := SrcFilePtr(PtrAdjust(Arg,8 + Ord(Arg^.SrcName[0])));
  521.             IF FormLL(U,S) < U^.UDBTS
  522.                 THEN AddrNxtSrc := S
  523.                 ELSE AddrNxtSrc := Nil
  524.         END
  525.     END
  526. END;
  527.  
  528.   { Function Below Gets Pointer to Source File List Entry at Offset }{.CP09}
  529.  
  530. FUNCTION  AddrSrcTabOff(U : UnitHeadPtr; Offset : Word):SrcFilePtr;
  531. BEGIN
  532.     WITH U^ DO
  533.     IF (USRCF+Offset) < UDBTS
  534.     THEN AddrSrcTabOff := SrcFilePtr(PtrAdjust(U,USRCF+Offset))
  535.     ELSE AddrSrcTabOff := Nil
  536. END;
  537.  
  538.   { Function Counts Number of Slots in PROC Map Table }            {.CP06}
  539.  
  540. FUNCTION  CountPMapSlots(U : UnitHeadPtr):Integer;
  541. BEGIN
  542.     CountPMapSlots := (U^.UHCsg-U^.UHPrc) DIV SizeOf(ProcMapRec);
  543. END;
  544.  
  545.   { Function Gets Address of PROC Map Table }                      {.CP08}
  546.  
  547. FUNCTION  AddrPMapTab(U : UnitHeadPtr):ProcMapPtr;
  548. BEGIN
  549.     IF CountPMapSlots(U) > 0
  550.     THEN AddrPMapTab := ProcMapPtr(PtrAdjust(U,U^.UHPrc))
  551.     ELSE AddrPMapTab := Nil
  552. END;
  553.  
  554.   { Function Counts Number of Slots in CSeg Map Table }              {.CP06}
  555.  
  556. FUNCTION  CountCMapSlots(U : UnitHeadPtr):Integer;
  557. BEGIN
  558.     WITH U^ DO CountCMapSlots := (UHDsT-UHCsg) DIV SizeOf(CSegMapRec);
  559. END;
  560.  
  561.   { Function Gets Address of CSeg Map Table }                        {.CP08}
  562.  
  563. FUNCTION  AddrCMapTab(U : UnitHeadPtr):CSegMapTabPtr;
  564. BEGIN
  565.     IF CountCmapSlots(U) > 0
  566.     THEN AddrCMapTab := CSegMapTabPtr(PtrAdjust(U,U^.UHCsg))
  567.     ELSE AddrCMapTab := Nil
  568. END;
  569.  
  570.   { Function Counts Number of DSeg Map Slots }                    {.CP06}
  571.  
  572. FUNCTION  CountDMapSlots(U : UnitHeadPtr):Integer;
  573. BEGIN
  574.     WITH U^ DO CountDMapSlots := (UHDsV - UHDsT) DIV SizeOf(DSegMapRec)
  575. END;
  576.  
  577.   { Function Gets Address of DSeg Map Table }                     {.CP08}
  578.  
  579. FUNCTION  AddrDMapTab(U : UnitHeadPtr):DSegMapTabPtr;
  580. BEGIN
  581.     IF CountDMapSlots(U) > 0
  582.     THEN AddrDMapTab := DSegMapTabPtr(PtrAdjust(U,U^.UHDsT))
  583.     ELSE AddrDMapTab := Nil
  584. END;
  585.  
  586.   { Function Below Gets Pointer to 1st Trace Table Entry or Nil }  {.CP08}
  587.  
  588. FUNCTION  AddrTraceTab(U : UnitHeadPtr):TraceRecPtr;
  589. BEGIN
  590.     IF U^.UDBTS = U^.UndNC
  591.     THEN AddrTraceTab := Nil
  592.     ELSE AddrTraceTab := TraceRecPtr(PtrAdjust(U,U^.UDBTS))
  593. END; {AddrTraceTab}
  594.  
  595.    { Function Below Gets Byte Count in TrExec Array }      {.CP20}
  596.  
  597. FUNCTION GetTrExecSize(T : TraceRecPtr):Integer;
  598. VAR i,k : Integer;
  599. BEGIN
  600.     IF T = Nil THEN GetTrExecSize := 0 ELSE
  601.     BEGIN
  602.         k := T^.TrLNos;
  603.         i := 1;
  604.         WHILE i <= k DO BEGIN
  605.             IF T^.TrExec[i] = $80 THEN
  606.             BEGIN
  607.                 Inc(k);
  608.                 Inc(i)
  609.             END;
  610.             Inc(i)
  611.         END;
  612.         GetTrExecSize := k;
  613.     END;
  614. END;
  615.  
  616.   { Function Below Gets Pointer to next Trace Table Entry or Nil }  {.CP14}
  617.  
  618. FUNCTION  AddrNxtTrace(U : UnitHeadPtr; T : TraceRecPtr):TraceRecPtr;
  619. VAR k : Integer;
  620. BEGIN
  621.     IF T = Nil THEN AddrNxtTrace := Nil ELSE
  622.     BEGIN
  623.         k := GetTrExecSize(T);
  624.         T := TraceRecPtr(PtrAdjust(@T^.TrExec[1],LL(k)));
  625.         IF FormLL(U,T) >= U^.UndNC
  626.             THEN AddrNxtTrace := Nil
  627.             ELSE AddrNxtTrace := T
  628.     END
  629. END; {AddrNxtTrace}
  630.  
  631.   { Function Below Gets Pointer to 1st Fixup Table Entry or Nil }  {.CP13}
  632.  
  633. FUNCTION  AddrFixUps(U : UnitHeadPtr):ReloListPtr;
  634. VAR j : Word;
  635. BEGIN
  636.     IF U^.ULPtch = 0 THEN AddrFixUps := Nil ELSE
  637.     WITH U^ DO BEGIN
  638.         j := (UndNC  + $F) AND $FFF0;
  639.         j := (ULCod  + $F) AND $FFF0 + j;
  640.         j := (ULTCon + $F) AND $FFF0 + j;
  641.         AddrFixUps := Ptr(Seg(U^),Ofs(U^) + j)
  642.     END
  643. END; {AddrFixUps}
  644.  
  645.   { Function Below Converts a byte to Printable Hex }               {.CP05}
  646.  
  647. FUNCTION HexB(arg:byte): Str2;
  648. CONST HexTab : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  649. BEGIN HexB := HexTab[arg SHR 4] + HexTab[arg AND $F] END;
  650.  
  651.   { Function Below Converts a Word to Printable Hex in Dump Mode }  {.CP04}
  652.  
  653. FUNCTION HexW(arg:Word): Str4;
  654. BEGIN HexW := HexB(HI(arg)) + HexB(LO(arg)) END;
  655.  
  656. PROCEDURE CloseMapRefTab;                    {.CP06}
  657. BEGIN
  658.     IF PMapC <> Nil THEN FreeMem(PMapC,CMapSiz);
  659.     IF PMapP <> Nil THEN FreeMem(PMapP,PMapSiz);
  660.     PMapC := Nil; CMapSiz := 0; NMapC := 0;
  661.     PMapP := Nil; PMapSiz := 0; NMapP := 0;
  662. END;
  663.  
  664.                                 {.CP11} {
  665.     The Following Procedure may be called to collect and
  666.     collate all information about PROCS and CSEGS into a
  667.     pair of dynamic arrays for use in Disassembly.  What
  668.     is determined is PROC Name, load address and size,
  669.     CSEG load address, size, fix-up lists and names of
  670.     files that furnish the CSEGS.  Storage used is only
  671.     10-bytes per PROC and 12-bytes per CSeg.
  672. }
  673.  
  674. PROCEDURE XrefMaps(U:UnitHeadPtr);                {.CP03}
  675.  
  676.     PROCEDURE ScanHash(HLL : LL);
  677.  
  678.         PROCEDURE ScanProc(D : DictHeadPtr; DLL : LL);    {.CP11}
  679.         VAR S : DictStubPtr; i : Integer;
  680.         BEGIN
  681.             S := AddrStub(D);
  682.             IF (S^.TCod AND $02) = 0 THEN
  683.             BEGIN
  684.                 i := S^.BCod DIV SizeOf(ProcMapRec);
  685.                 PMapP^.PmRefs[i].PmDirN := DLL;
  686.                 IF S^.SHsh <> 0 THEN ScanHash(S^.SHsh);
  687.             END;
  688.         END;
  689.  
  690.         PROCEDURE ScanType(D : DictHeadPtr);        {.CP09}
  691.         VAR    T : TypePtr; S : DictStubPtr;
  692.         BEGIN
  693.             S := AddrStub(D);
  694.             T := AddrType(U,S^.QTG);
  695.             IF T <> Nil THEN {Type Defined Locally}
  696.             IF T^.Typ = $03  {Object may have methods}
  697.             THEN ScanHash(T^.ObjtHash);
  698.         END;
  699.  
  700.  
  701.         PROCEDURE ScanChain(DLL : LL);            {.CP09}
  702.         VAR D : DictHeadPtr;
  703.         BEGIN
  704.             WHILE DLL <> 0 DO BEGIN
  705.                 D := AddrDict(U,DLL);
  706.                 IF D^.DForm = 'S' THEN ScanProc(D,DLL) ELSE
  707.                 IF D^.DForm = 'Q' THEN ScanType(D);
  708.                 DLL := D^.HLink;
  709.             END;
  710.         END;
  711.  
  712.     VAR HLim, I, j : LL; H : HashPtr;            {.CP10}
  713.     BEGIN
  714.         H := AddrHash(U,HLL);
  715.         HLim := H^.Bas DIV SizeOf(LL);
  716.         WITH H^ DO FOR I := 0 TO HLim DO BEGIN
  717.             j := Slt[i];
  718.             IF j <> 0
  719.             THEN ScanChain(Slt[i]);
  720.         END;
  721.     END;    {ScanHash}
  722.  
  723.     PROCEDURE SortPMap(PmCnt:Word);    {Slow & simple}        {.CP21}
  724.     VAR i,j,k : Word; W :  PMapRefRec;
  725.     BEGIN
  726.         I := 0;
  727.         WITH PMapP^ DO REPEAT
  728.             J := I + 1;
  729.             K := I;
  730.             WHILE J < PmCnt DO BEGIN
  731.                 IF PMRefs[J].PmEntP < PMRefs[K].PmEntP
  732.                     THEN K := J;
  733.                 Inc(J);
  734.             END;
  735.             IF K <> I THEN
  736.             BEGIN
  737.                 W := PMRefs[I];
  738.                 PMRefs[I] := PMRefs[K];
  739.                 PMRefs[K] := W;
  740.             END;
  741.             Inc(I);
  742.         UNTIL I >= PmCnt;
  743.     END;    {SortPMap}
  744.  
  745.     PROCEDURE NoteIncs(PmCnt : Word);            {.CP20}
  746.     LABEL NextTp;
  747.     VAR Tp : TraceRecPtr; I : Word;
  748.     BEGIN
  749.         Tp := AddrTraceTab(U);
  750.         WITH PMapP^, PMapC^ DO
  751.         WHILE Tp <> Nil DO WITH Tp^ DO BEGIN
  752.             I := 0;
  753.             WHILE I < PmCnt DO WITH PMRefs[I] DO BEGIN
  754.                 IF PmDirN = TrName THEN
  755.                 BEGIN
  756.                     CMRefs[PmNdxC].CmNdxF := TrFill;
  757.                     GOTO NextTp;
  758.                 END;
  759.                 Inc(I);
  760.             END;
  761.            NextTp:
  762.             Tp := AddrNxtTrace(U,Tp);
  763.         END;
  764.     END;    {NoteIncs}
  765.  
  766.     PROCEDURE SizeProcs(PmCnt : Word);            {.CP16}
  767.     VAR  Limit,i : LL;
  768.     BEGIN
  769.         Limit := (U^.UndNC + $F) AND $FFF0 + U^.ULCod;
  770.         i := 0;
  771.         WHILE i < PmCnt-1 DO WITH PMapP^.PmRefs[i], PMapC^ DO BEGIN
  772.             IF PmEntP <> $FFFF THEN
  773.             IF PmNdxC = PMapP^.PmRefs[i+1].PmNdxC
  774.             THEN PmSizP := PMapP^.PmRefs[i+1].PmEntP - PmEntP
  775.             ELSE WITH CmRefs[PmNdxC] DO
  776.                 PmSizP := CmSegL + CmSegS - PmEntP;
  777.             Inc(i);
  778.         END;
  779.         WITH PMapP^.PmRefs[PmCnt-1] DO
  780.             IF PmEntP <> $FFFF THEN PmSizP := Limit - PmEntP;
  781.     END;    {SizeProcs}
  782.  
  783. CONST    RSiz = SizeOf(ReloListEntry);                {.CP08}
  784. VAR     R : ReloListPtr; C : CSegMapTabPtr; Sh, Sp : SrcFilePtr;
  785.     TP : TraceRecPtr; P : ProcMapPtr; PE : ProcMapRecPtr;
  786.     Pn,Px,Cn,Cx,i : Integer; Cb,Rx,Sf,Sn,So : LL;
  787. BEGIN
  788.     IF (PMapC <> Nil) OR (PMapP <> Nil) THEN CloseMapRefTab;
  789.     IF U <> Nil THEN
  790.     BEGIN
  791.         Cn := CountCMapSlots(U);                {.CP42}
  792.         IF Cn > 0 THEN
  793.         BEGIN
  794.         C := AddrCMapTab(U);
  795.         R := AddrFixUps(U);
  796.         Rx:= 0;
  797.         Cb := (U^.UndNC + $F) AND $FFF0; {CodeBase}
  798.         CMapSiz := Cn * SizeOf(CMapRefRec);
  799.         GetMem(PMapC,CMapSiz);
  800.         FOR Cx := 0 TO Cn-1 DO
  801.         WITH PMapC^.CMRefs[Cx], C^.CSegMap[Cx] DO
  802.         BEGIN
  803.             CmNdxC := Cx; {index of CSegMap}
  804.             CmNdxF := 0;  {offset to Main Source File Entry}
  805.             CmSegL := Cb; {LL to Segment Load Point}
  806.             CmSegS := CSegCnt;
  807.             CmNdxR := Rx; {index of ReloListEntry}
  808.             i      := CSegRel DIV RSiz;
  809.             Rx     := Rx + i;    {Next Fixup index}
  810.             CmCntR := Rx - 1;
  811.             Cb     := Cb + CSegCnt;    {Next Seg Origin}
  812.         END;    {CmNdxF can be refined for .OBJ,.INC files}
  813.         Sh := AddrSrcTabOff(U,0); Sp := Sh; Sf := 0; Sn := 0;
  814.         WHILE Sp <> Nil DO BEGIN
  815.             Inc(Sf);
  816.             IF Sp^.SrcFlag <> $05 THEN Inc(Sn);
  817.             Sp := AddrNxtSrc(U,Sp);
  818.         END; {Sn = Count of NON.OBJ files, Sf = Count of ALL files}
  819.         So := Sf - Sn; {.OBJ file count} Sp := Sh;
  820.  
  821.         IF So > 0 THEN { we have .OBJ files to handle }
  822.         BEGIN
  823.             FOR i := 1 TO Sn DO Sp := AddrNxtSrc(U,Sp);
  824.             Cx := Cn - So;          {1st CSeg from .OBJ}
  825.             FOR i := Cx TO Cn-1 DO
  826.             WITH PMapC^.CMRefs[i] DO
  827.             BEGIN
  828.                 CmNdxF := FormLL(Sh,Sp);
  829.                 Sp := AddrNxtSrc(U,Sp);
  830.             END;
  831.         END;
  832.         END;
  833.         Pn := CountPMapSlots(U);                {.CP31}
  834.         IF Pn > 0 THEN
  835.         BEGIN
  836.         P := AddrPMapTab(U);
  837.         i := SizeOf(CSegMapRec);
  838.         PMapSiz := Pn * SizeOf(PMapRefRec);
  839.         GetMem(PMapP,PMapSiz);
  840.         FOR Px := 0 TO Pn-1 DO
  841.         WITH PMapP^.PMRefs[Px], P^.ProcMap[Px], PMapC^ DO
  842.         BEGIN
  843.             PmNdxP := Px;
  844.             PmDirN := $FFFF;    { fill in later }
  845.             PmEntP := CSegJmp;
  846.             PmSizP := 0;        { fill in later }
  847.             IF CSegOfs <> $FFFF THEN
  848.             BEGIN
  849.                 PmNdxC := CSegOfs Div i;
  850.                 IF CSegJmp <> $FFFF
  851.                 THEN PmEntP := CSegJmp + CmRefs[PmNdxC].CmSegL;
  852.             END
  853.             ELSE    PmNdxC := $FFFF;  {Null Unit Init Proc}
  854.         END;
  855.         ScanHash(U^.UHash2);    {Pick up PROC Names}
  856.         SortPMap(Pn);        {Sort by Address}
  857.         NoteIncs(Pn);        {Note .INC files in CMRefs}
  858.         SizeProcs(Pn);        {Add Size info to PMRefs}
  859.         END;
  860.     END;
  861.     NMapP := Pn;
  862.     NMapC := Cn;
  863. END;
  864.                                                                  {.CP15}
  865. PROCEDURE FindFile(FName : String; VAR Finding : FStats);
  866. CONST AttrMask = Dos.Archive + Dos.ReadOnly + Dos.SysFile;
  867. VAR   S : Dos.SearchRec; P : Dos.DirStr; N : Dos.NameStr; X : Dos.ExtStr;
  868. BEGIN
  869.     Finding.Size := -1;
  870.     FSplit(FName,P,N,X);
  871.     IF (X = '') OR (X = '.') THEN X := '.TPU';
  872.     Finding.Path := FSearch(N + X,GetEnv('PATH'));
  873.     IF Finding.Path <> '' THEN
  874.     BEGIN
  875.         FindFirst(Finding.Path,AttrMask,S);
  876.         IF DosError = 0 THEN Finding.Size := S.Size
  877.     END
  878. END;
  879.  
  880. PROCEDURE OpenUnit(Path : String);                               {.CP07}
  881. BEGIN
  882.    {I-}
  883.         Assign(TPFile , Path);
  884.         Reset(TPFile,1);
  885.    {$I+}
  886. END;
  887.  
  888. PROCEDURE CloseUnit;                                             {.CP05}
  889. BEGIN
  890.     {$I-} Close(TPFile); {$I+}
  891.     IF IOResult <> 0 THEN;
  892. END;
  893.  
  894. PROCEDURE InitJobUnit(FilNam:Dos.PathStr);                      {.CP14}
  895. VAR W : FStats;
  896. BEGIN
  897.     DropJobUnit;
  898.     FindFile(FilNam,W);
  899.     IF (W.Size > 0) AND (W.Size < 65536) THEN
  900.     BEGIN
  901.         SizJobBfr := W.Size;
  902.         OpenUnit(W.Path);
  903.         GetMem(BufPtrJob,SizJobBfr);
  904.         BlockRead(TPFile,BufPtrJob^.BufByt,SizJobBfr);
  905.         CloseUnit;
  906.     END
  907. END;
  908.  
  909. PROCEDURE DropJobUnit;                                         {.CP11}
  910. BEGIN
  911.     IF BufPtrJob <> Nil THEN
  912.     BEGIN
  913.         FreeMem(BufPtrJob,SizJobBfr);
  914.         CloseUnit;
  915.     END;
  916.     BufPtrJob := Nil;
  917.     SizJobBfr := 0;
  918.     CloseMapRefTab;
  919. END;
  920.  
  921. BEGIN    { UNIT INITIALIZATION CODE }                        {.CP12}
  922.  
  923.     SizRefBfr := 0;
  924.     SizJobBfr := 0;
  925.     JobPath   := '';
  926.     BufPtrRef := Nil;
  927.     BufPtrJob := Nil;
  928.     PMapC:= Nil; PMapP:= Nil; CloseMapRefTab; { Order Critical here }
  929.  
  930. END.