home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPU6.ZIP / TPU6AMS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-16  |  21.9 KB  |  596 lines
  1. {$D+,O+,S+,R-,L+}
  2. Unit TPU6AMS;
  3.  
  4. (*****************)
  5. (**) INTERFACE (**)             USES TPU6EQU, Dos;
  6. (*****************)
  7.  
  8. TYPE
  9.  
  10.   RngB   = 0..65534;
  11.   RngW   = 0..32766;
  12.   AryB   = ARRAY[rngb] OF Byte;
  13.   AryW   = ARRAY[rngw] OF Word;
  14.   SrcNam = _FileSpec;
  15.  
  16.   HdrAry = ARRAY[0..3] OF Char;
  17.  
  18.   LL  = Word;               { Local Scope Pointers (offsets) }
  19.  
  20.   LG  = RECORD              { Global Scope Pointers to Other Units }
  21.              UntLL : LL;    { Local to containing unit }
  22.              UntId : LL;    { Local to  external  unit }
  23.         END;
  24.  
  25.   { The following Record is the Header and Locator for a Unit File } {.CP28}
  26.  
  27.   UnitPtr = ^UnitHeader;
  28.   UnitHeader = RECORD
  29.     UHEYE : HdrAry;        { +00 : = 'TPU9'                     }
  30.     UHxxx : HdrAry;        { +04 : = $00000000                  }
  31.     UHUDH : LL;        { +08 : to Dictionary Head-This Unit }
  32.     UHIHT : LL;        { +0A : to Interface Hash Header     }
  33.     UHPMT : LL;        { +0C : to PROC Map                  }
  34.     UHCMT : LL;        { +0E : to CSeg Map                  }
  35.     UHTMT : LL;        { +10 : to DSeg Map-Typed CONST's    }
  36.     UHDMT : LL;        { +12 : to DSeg Map-GLOBAL Variables }
  37.     UHxxy : LL;        { +14 : purpose unknown              }
  38.     UHLDU : LL;        { +16 : to Donor Unit List           }
  39.     UHLSF : LL;        { +18 : to Source File List          }
  40.     UHDBT : LL;             { +1A : DEBUG Trace Table            }
  41.     UHENC : LL;          { +1C : to end non-code part of Unit }
  42.     UHZCS : Word;        { +1E : CSEG Size-Aggregate          }
  43.     UHZDT : Word;        { +20 : DSEG Size-Typed CONSTS Only  }
  44.     UHZFA : Word;        { +22 : Fix-Up Size (CSegs)          }
  45.     UHZFT : Word;        { +24 : Fix-Up Size (Typed CONST's)  }
  46.     UHZFV : Word;           { +26 : DSEG Size for Global VARs    }
  47.     UHDHT : LL;        { +28 : to Global Hash Header        }
  48.         UHSOV : Word;           { +2A : Overlay Controls             }
  49.     UHPad : ARRAY[0..9]
  50.         OF Word;    { +2C : Reserved for Future Expansion ? }
  51.  
  52.   END; { UnitHeader }
  53.  
  54.   { The Records below provide access to the PROC Map }        {.CP12}
  55.  
  56.     PMapRecPtr  = ^PMapRec;
  57.     PMapRec = RECORD
  58.                 ProcWd1,
  59.                 ProcWd2 : Word; { function of these words unknown       }
  60.         CSegOfs : Word;    { offset within CSeg Map; $FFFF if null }
  61.         CSegJmp : Word;    { offset to entry point;  $FFFF if null }
  62.     END {PMapRec};
  63.  
  64.     PMapPtr = ^PMapTab;
  65.     PMapTab =  ARRAY[0..1] OF PMapRec; { model of PROC Map }
  66.  
  67.   { The Records below provide access to the CODE Map }        {.CP12}
  68.  
  69.     CMapRecPtr = ^CMapRec;
  70.     CMapRec = RECORD
  71.         CSegWd0 : Word;    { purpose is unknown              }
  72.         CSegCnt : Word;    { byte count of module code       }
  73.         CSegRel : Word;    { byte count of module Relo List  }
  74.         CSegTrc : Word;    { Trace table offset or $FFFF     }
  75.     END; {CMapRec}
  76.  
  77.     CMapTabPtr = ^CMapTab;
  78.     CMapTab = ARRAY[0..1] OF CMapRec; { model of CSeg Map }
  79.  
  80.   { The Records below provide access to the CONST DSeg Map }    {.cp12}
  81.  
  82.     DMapRecPtr = ^DMapRec;
  83.     DMapRec = RECORD
  84.         DSegWd0 : Word;    { purpose is unknown              }
  85.         DSegCnt : Word;    { byte count of data block        }
  86.         DSegRel : Word;    { byte count of data Relo List    }
  87.         DSegOwn : LL;      { To owner scope                  }
  88.     END; {DMapRec}
  89.  
  90.     DMapTabPtr = ^DMapTab;
  91.     DMapTab = ARRAY[0..1] OF DMapRec;    { model of DSeg Map }
  92.  
  93.   { The Record below is one entry in the Fix-Up List }            {.CP13}
  94.  
  95.     FixUpRecPtr = ^FixUpRec;
  96.     FixUpRec = RECORD
  97.         FixDnr : Byte;    { Donor Unit Offset }
  98.         FixFlg : Byte;    { Entry Format Flag }
  99.         FixWd1 : Word;    { Offset to Map Table  }
  100.         FixWd2 : Word;    { Effective Address Adjuster  }
  101.         FixOfs : Word;    { offset to patch point in code/data block }
  102.     END; {FixUpRec}
  103.  
  104.     FixUpPtr  = ^FixUpList;
  105.     FixUpList = ARRAY[0..1] OF FixUpRec; { model of Fix-Up List }
  106.  
  107.   { The Record below maps the Dictionary Header in Turbo Units } {.CP08}
  108.  
  109.     DNamePtr = ^ DNameRec;
  110.     DNameRec = RECORD
  111.         HLink : LL;         { Hash Chain Link; Resolves Collisions }
  112.         DForm : Char;       { Symbol Type; See StubRecord for types}
  113.         DSymb : _LexName;   { Worst-Case Symbol Size (UPPER-CASE)  }
  114.     END; {DNameRec}
  115.  
  116.   { The Record Below maps the Dictionary Stubs in Turbo Units  } {.CP10}
  117.  
  118.   DStubPtr = ^ DStubRcd;
  119.   DStubRcd = RECORD
  120.       CASE Char OF
  121.  
  122.       'P': (                     { --- For Untyped Constants --- }
  123.            sPTD : LG;            { to type descriptor            }
  124.            sPV1 : Word;          { value of constant - LO Word   }
  125.            sPV2 : Word);         { (size varies)     - HI Word   }
  126.  
  127.       'Y': (                     { ----- For UNIT Entries ------ }  {.CP05}
  128.            sYW1 : Word;          { unknown use; normally zero    }
  129.            sYCS : Word;          { Speculate Signature Word      }
  130.            sYNU : LL;            { to next Unit in List (SUCC)   }
  131.            sYPU : LL);           { to prior Unit in List (PRED)  }
  132.  
  133.       'O',                       { ---- Label Declaratives ----- }  {.CP05}
  134.       'T',                       { ---- Standard Procedures ---- }
  135.       'U',                       { ---- Standard Functions  ---- }
  136.       'V': (                     { ---- Standard "NEW" F/P  ---- }
  137.            sVxx : Word);         { semantics not precisely known }
  138.  
  139.       'W': (                     { ------- Standard Ports ------ }  {.CP02}
  140.            sWxx : Byte);         { 0=Byte Array, 1=Word Array    }
  141.  
  142.       'Q',                       { -------- Named Types -------- }  {.CP03}
  143.       'X': (                     { ----- External Variables ---- }
  144.            sQTD : LG);           { to type descriptor            }
  145.  
  146.       'S': (                     { ------ User Subprograms ----- }  {.CP20}
  147.             sSTp : BYte;         { 76543210  - Bit encoded       }
  148.                                  { .......1 = FAR Call Model     }
  149.                                  { ......1. = INLINE Declarative }
  150.                                  { .....1.. = INTERRUPT Routine  }
  151.                                  { ....1... = .OBJ module code   }
  152.                                  { ...1.... = METHOD (Any)       }
  153.                                  { .011.... = Constructor METHOD }
  154.                                  { .101.... = Destructor  METHOD }
  155.                                  { 1....... = ASSEMBLER attribute}
  156.             sSxx : Byte;         { function unknown at present   }
  157.             sSPM : Word;         { Code byte count if INLINE,    }
  158.                                  { else, offset to PROC Map      }
  159.             sSPS : LL;           { to containing scope or zero   }
  160.             sSHT : LL;           { to local scope hash table     }
  161.             sSVM : Word);        { VMT Offset-VIRTUAL Method PTR }
  162.  
  163.             { Notes: "sSVM" is followed immediately by a Type    }
  164.             {        Descriptor ($06).  INLINE Declarative code  }
  165.             {        Bytes then follow (if any).                 }
  166.  
  167.       'R': (                     { -- Variable, Field, Object  -- } {.CP35}
  168.             sRAM : Byte;         {   allocation method codes:      }
  169.                                  { $00 = Global Variables in DS    }
  170.                                  { $01 = Typed Constants  in DS    }
  171.                                  { $02 = VAR-BP based-Nested Scope }
  172.                                  { $03 = Absolute[Segment:Offset]  }
  173.                                  { $06 = SELF Parameter-ADDR Stack }
  174.                                  { $08 = Allocate in Record/Object }
  175.                                  { $10 = Absolute Equivalence      }
  176.                                  { $22 = VALUE Parameter-BP based  }
  177.                                  { $26 = VAR   Parameter-BP based  }
  178.  
  179.             sRVF : Longint;      { See VarStub Below               }
  180.             sRTD : LG);          { to Type Descriptor              }
  181.  
  182.       END;
  183.  
  184.   VarStubPtr = ^VarStub;
  185.   VarStub    = RECORD
  186.             Case  Byte Of  { sRAM Byte in Type "R" Stub }
  187.             $02,$06,
  188.             $22,$26:     (ROfs : Word;  { allocation offset (BP)  }
  189.                           ROB  : Word); { To Parent Scope/Zero    }
  190.  
  191.             $00,$01:     (TOfs : Word;  { allocation offset in map}
  192.                           TOB  : LL);   { offset in VAR/CONST Map }
  193.  
  194.             $03:         (AOfs : Word;  { Absolute Byte Offset    }
  195.                           ASeg : Word); { Absolute Segment Adr    }
  196.  
  197.             $08:         (Bofs : Word;  { Offset-Record Relative  }
  198.                           RChn : LL);   { To Next Field/Method    }
  199.  
  200.             $10:         (QLG  : LG);   { to Stub of Allocator    }
  201.   End;
  202.  
  203.   { The Record below maps a Formal Parameter List Entry }        {.CP08}
  204.  
  205.   FormalParmRcd = RECORD
  206.        fPTD : LG;        { to type descriptor for parameter  }
  207.        fPAM : Byte;        { passing model; 2=Value, 6=Address }
  208.      END;
  209.  
  210.   InlineLst = ARRAY[0..1] OF Word;        { model of INLINE code }
  211.  
  212.  
  213.   { The Record below maps the Type Descriptors in Turbo Units  } {.CP08}
  214.  
  215.   TypePtr   = ^TypeRecd;
  216.   TypeRecd  = RECORD
  217.        tpTC : Byte;        { Identifies the Variant Part }
  218.        tpTQ : Byte;        { Type Qualifier              }
  219.        tpSW : Word;        { Storage Width in Bytes      }
  220.        tpML : Word;             { Next Method if tpTC=$06     }
  221.  
  222.        CASE Byte OF                                                 {.CP04}
  223.     $00,            { For NULL or Un-Typed Variables }
  224.     $0A,            { For COMP,DOUBLE,EXTENDED,SINGLE }
  225.     $0B : ();        { -------- For REAL Type -------- }
  226.  
  227.     $01 : (            { ------ For ARRAY Types ------- }  {.CP04}
  228.         BaseType : LG;    { to TypeRecd for item arrayed   }
  229.         BounDesc : LG;    { to TypeRecd for array bounds   }
  230.               );
  231.  
  232.     $02 : (            { ------ For RECORD Types ------ }  {.CP04}
  233.         RecdHash : LL;    { to Hash Table for Field List   }
  234.         RecdDict : LL;    { to Field List Dictionary Begin }
  235.               );
  236.  
  237.     $03 : (            { ------ For OBJECT Types ------ }  {.CP15}
  238.         ObjtHash : LL;    { to Fields & Methods Hash Table }
  239.         ObjtDict : LL;    { to Fields & Methods Dictionary }
  240.         ObjtOwnr : LG;    { to Parent Object Type Descript }
  241.         ObjtVMTs : Word;{ Size of VMT if Virtual Methods }
  242.         ObjtDMap : Word;{ Data Map Offset of VMT Template}
  243.         ObjtVMTO : Word;{ object instance offset to VMT  }
  244.                 { pointer; $FFFF if object has   }
  245.                 { no Virtual Methods (no VMT)    }
  246.         ObjtName : LL;    { to Object Dictionary Header    }
  247.                 ObjtRes0,       { Usually $FFFF - Role Unknown   }
  248.                 ObjtRes1,       { Usually zero  - Role Unknown   }
  249.                 ObjtRes2,       { Usually zero  - Role Unknown   }
  250.                 ObjtRes3 : Word { Usually zero  - Role Unknown   }
  251.               );
  252.  
  253.     $04,            { ----- For FILE except TEXT ----}  {.CP04}
  254.     $05:  (            { ----- For TEXT file type ----- }
  255.         FileType : LG;    { to TypeRecd for Base File Type }
  256.               );
  257.     $06:  (            { ----- For Procedure Types ---- }  {CP05}
  258.         PFRes : LG;    { to Function Result TD / zero   }
  259.         PNPrm : Word;    { Formal Parameter Count/ zero   }
  260.                 PFPar : ARRAY[1..2] OF FormalParmRcd { model only}
  261.               );
  262.     $07 : (            { ------- For SET Types -------- } {.CP03}
  263.         SetBase  : LG;    { to base type descriptor of set }
  264.               );
  265.     $08 : (            { ----- For POINTER Types ------ } {.CP03}
  266.         PtrBase  : LG;    { to base type descriptor        }
  267.               );
  268.     $09 : (            { ------ For STRING Types ------ } {.CP04}
  269.         StrBase  : LG;    { to SYSTEM.CHAR type descriptor }
  270.         StrBound : LG;    { to array bounds for string typ }
  271.               );
  272.     $0C,         { For BYTE,INTEGER,LONGINT,SMALLINT,WORD }{.CP15}
  273.     $0D,            { ------- For BOOLEAN Type ------ }
  274.     $0E,            { ------- For CHAR Type --------- }
  275.     $0F : (            { ---- For Enumerated Types ----- }
  276.         LoBnd : LongInt;{ lower bound of subrange         }
  277.         HiBnd : LongInt;{ upper bound of subrange         }
  278.         Cmpat : LG;    { to upward compatible Type desc  }
  279.               );
  280.  
  281.         { The Enumeration Type Descriptor is immediately  }
  282.         { followed by a SET Type Descriptor ($07) but we  }
  283.         { don't know what this achieves.  Its base type   }
  284.         { LG points to the Enumerated Type Descriptor.    }
  285.  
  286.        END;  { TypeRecd }
  287.  
  288.  
  289.   { The Record below is a model Hash Table }                         {.CP07}
  290.  
  291.     HashPtr   = ^HashTable;
  292.     HashTable = RECORD
  293.         Bas : Word;                { Base and Max Offset in Slt }
  294.         Slt : ARRAY[0..1] Of LL;   { Slots in Hash Table        }
  295.     END;
  296.  
  297.   { The Record below is an entry in the Unit Code/Data Donor List } {.CP07}
  298.  
  299.     UDonorPtr = ^UDonorRec;
  300.     UDonorRec = RECORD
  301.         UDExxx : Word;
  302.         UDEnam : String[8]
  303.     END;
  304.  
  305.   { The Record below is an entry in the Source File List }            {.CP10}
  306.  
  307.     SrcFilePtr = ^SrcFileRec;
  308.     SrcFileRec = RECORD
  309.         SrcFlag : Byte;        { 4=.PAS file, 3=.INC, 5=.OBJ       }
  310.         SrcPad  : Word;        { no apparent use - always zero ?   }
  311.         SrcTime : Word;        { File Time Stamp if SrcFlag=3 or 4 }
  312.         SrcDate : Word;        { File Date Stamp if SrcFlag=3 or 4 }
  313.         SrcName : SrcNam;    { Varying length FileName.Extn      }
  314.     END;
  315.  
  316.   { The Record below is an entry in the Trace Table      }          {.CP12}
  317.  
  318.     TraceRecPtr = ^TraceRec;
  319.     TraceRec    = RECORD
  320.         TrName : LL;     { to Directory Entry of Proc/Method  }
  321.         TrFill : Word;     { to proc source file                }
  322.         TrPfx  : Word;     { bytes of data in front of code     }
  323.         TrBeg  : Word;     { Line Number of BEGIN Stmt          }
  324.         TrLNos : Word;     { Lines of Code to Execute in TRACE  }
  325.         TrExec : ARRAY[1..2] { Model Array of bytes that map each }
  326.              OF Byte;     { line of code to be traced by DEBUG }
  327.     END;
  328.  
  329.   BufPtr = ^Buffer;                                             {.CP06}
  330.   Buffer = RECORD               { General Buffer Mapping }
  331.     CASE Boolean OF
  332.       True :( BufByt : AryB);   { Byte Array over Buffer }
  333.       False:( BufWrd : AryW);   { Word Array over Buffer }
  334.     END;
  335.  
  336. FUNCTION  PtrAdjust(Arg: Pointer; Adj: Word): Pointer;        {.CP22}
  337. FUNCTION  FormLL(Base,Ceil: Pointer): LL;
  338. FUNCTION  IsSystemUnit(U: UnitPtr): Boolean;
  339. FUNCTION  AddrStub(arg: DNamePtr): DStubPtr;
  340. FUNCTION  AddrHash(U: UnitPtr; Hash: LL): HashPtr;
  341. FUNCTION  AddrDict(U: UnitPtr; Hash: LL): DNamePtr;
  342. FUNCTION  AddrType(U: UnitPtr; TypeLG: LG): TypePtr;
  343. FUNCTION  AddrProcType(S: DStubPtr): TypePtr;
  344. FUNCTION  AddrNxtSrc(U: UnitPtr; Arg: SrcFilePtr): SrcFilePtr;
  345. FUNCTION  AddrSrcTabOff(U: UnitPtr; Offset: Word): SrcFilePtr;
  346. FUNCTION  CountPMapSlots(U: UnitPtr): Integer;
  347. FUNCTION  AddrPMapTab(U: UnitPtr): PMapPtr;
  348. FUNCTION  CountCMapSlots(U: UnitPtr): Integer;
  349. FUNCTION  AddrCMapTab(U: UnitPtr): CMapTabPtr;
  350. FUNCTION  CountDMapSlots(U: UnitPtr): Integer;
  351. FUNCTION  AddrDMapTab(U: UnitPtr): DMapTabPtr;
  352. FUNCTION  AddrTraceTab(U: UnitPtr): TraceRecPtr;
  353. FUNCTION  GetTrExecSize(T: TraceRecPtr): Integer;
  354. FUNCTION  AddrNxtTrace(U: UnitPtr; T: TraceRecPtr): TraceRecPtr;
  355. FUNCTION  AddrFixUps(U: UnitPtr): FixUpPtr;
  356. FUNCTION  AddrLGUnit(U: UnitPtr; TypeLG: LG): DNamePtr;
  357. FUNCTION  Public(Arg: Char) : Char;
  358.  
  359. (**********************)                                        {.CP03}
  360. (**) IMPLEMENTATION (**)
  361. (**********************)
  362.  
  363.   { Function Below Converts PRIVATE Names to PUBLIC }           {.CP04}
  364.  
  365. FUNCTION Public(Arg: Char): Char;
  366. BEGIN Public := Chr(Ord(Arg) AND $7F) END;
  367.  
  368.   { Procedure Below Traps Pointer Violations }            {.CP10}
  369.  
  370. PROCEDURE CheckPtrs(U, V: Pointer);
  371. BEGIN
  372.     IF (U = Nil) OR (V = Nil) OR (Seg(U^) <> Seg(V^)) THEN
  373.     BEGIN
  374.         WriteLn('Pointer Violation in CheckPtrs');
  375.         Halt(1)
  376.     END
  377. END; {CheckPtrs}
  378.  
  379.   { Function Below Computes an LL from two Pointers }           {.CP09}
  380.  
  381. FUNCTION  FormLL(Base, Ceil: Pointer): LL;
  382. BEGIN
  383.     CheckPtrs(Base,Ceil);
  384.     IF Ofs(Base^) > Ofs(Ceil^)
  385.         THEN FormLL := LL(Ofs(Base^)-Ofs(Ceil^))
  386.         ELSE FormLL := LL(Ofs(Ceil^)-Ofs(Base^));
  387. END;
  388.  
  389.   { Function Below Adjusts Pointer Values by Offsets }           {.CP04}
  390.  
  391. FUNCTION  PtrAdjust(Arg: Pointer; Adj: Word): Pointer;
  392. BEGIN     PtrAdjust := Ptr(Seg(Arg^),Ofs(Arg^) + Adj)     END;
  393.  
  394.   { Function Below Checks to See if Unit Name is "SYSTEM" }
  395.  
  396. FUNCTION  IsSystemUnit(U: UnitPtr): Boolean;
  397. BEGIN
  398.    IsSystemUnit := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH))^.DSymb = 'SYSTEM'
  399. END;
  400.  
  401.   { Function Below Finds The Stub Belonging to a Dictionary Header } {.CP05}
  402.  
  403. FUNCTION  AddrStub(Arg: DNamePtr): DStubPtr;
  404. CONST PrefixSize = SizeOf(LL)+SizeOf(Char) + 1;
  405. BEGIN  AddrStub := PtrAdjust(Arg,PrefixSize + Ord(Arg^.DSymb[0]))  END;
  406.  
  407.   { Function Below Gets Pointer to Hash Table }                  {.CP04}
  408.  
  409. FUNCTION  AddrHash(U: UnitPtr; Hash: LL): HashPtr;
  410. BEGIN   AddrHash := HashPtr(PtrAdjust(U,Hash))  END;
  411.  
  412.   { Function Below Gets Pointer to Dictionary Entry using LL }   {.CP04}
  413.  
  414. FUNCTION  AddrDict(U: UnitPtr; Hash: LL): DNamePtr;
  415. BEGIN AddrDict := DNamePtr(PtrAdjust(U,Hash)) END;
  416.  
  417.   { Function Below Gets Pointer to Type Descriptor if Local to Unit } {.CP12}
  418.  
  419. FUNCTION  AddrType(U: UnitPtr; TypeLG: LG): TypePtr;
  420. VAR D:DNamePtr; S: DStubPtr; R: LL;
  421. BEGIN
  422.     D := AddrDict(U,U^.UHUDH);      {point to our unit DE}
  423.     S := AddrStub(D);               {point to its stub   }
  424.     R := FormLL(U,S);               {get offset to stub  }
  425.     IF R = TypeLG.UntId             {if offset matches   }
  426.     THEN AddrType := TypePtr(PtrAdjust(U,TypeLG.UntLL))
  427.     ELSE AddrType := Nil
  428. END;
  429.  
  430.   { Function Below Gets Pointer to Unit Descriptor for Type via LG } {.CP21}
  431.  
  432. FUNCTION  AddrLGUnit(U: UnitPtr; TypeLG: LG): DNamePtr;
  433. VAR D: DNamePtr; S: DStubPtr; R: LL;
  434. BEGIN
  435.     D := AddrDict(U,U^.UHUDH);      {point to our unit hdr}
  436.     S := AddrStub(D);               {point to our stub    }
  437.     R := FormLL(U,S);               {get offset to stub   }
  438.     IF (R <> 0) THEN
  439.     IF (TypeLG.UntID <> R) THEN     {if offsets don't match }
  440.     REPEAT
  441.        D := AddrDict(U,S^.sYNU);            {chain to next DE}
  442.        IF D^.DForm <> 'Y' THEN R := 0 ELSE  {if next is unit }
  443.        BEGIN
  444.          S := AddrStub(D);                  {its stub address}
  445.          R := FormLL(U,S);                  {and stub offset }
  446.        END;
  447.     UNTIL (R = TypeLG.UntID) OR (R = 0);    {match of end list  }
  448.     IF R <> 0 THEN AddrLGUnit := D          {we had a match     }
  449.               ELSE AddrLGUnit := Nil;       {we couldn't find it}
  450. END;
  451.  
  452.   { Function Below Gets Pointer to Procedure Stub Type Descriptor }{.CP04}
  453.  
  454. FUNCTION  AddrProcType(S: DStubPtr): TypePtr;
  455. BEGIN AddrProcType := TypePtr(PtrAdjust(@S^.sSVM,SizeOf(S^.sSVM))) END;
  456.  
  457.   { Function Below Gets Pointer to Next Entry in Source File List } {.CP21}
  458.  
  459. FUNCTION  AddrNxtSrc(U: UnitPtr; Arg: SrcFilePtr): SrcFilePtr;
  460. VAR J: LL;  S: SrcFilePtr;
  461. BEGIN
  462.     J := 0;
  463.     IF Arg = Nil THEN AddrNxtSrc := Nil ELSE
  464.     BEGIN
  465.        J := FormLL(U,Arg);
  466.        IF J < U^.UHLSF
  467.        THEN AddrNxtSrc := Nil ELSE
  468.        IF NOT (J < U^.UHDBT)
  469.        THEN AddrNxtSrc := Nil ELSE
  470.        BEGIN
  471.           S := SrcFilePtr(PtrAdjust(Arg,8 + Ord(Arg^.SrcName[0])));
  472.           IF FormLL(U,S) < U^.UHDBT
  473.           THEN AddrNxtSrc := S
  474.           ELSE AddrNxtSrc := Nil
  475.        END
  476.     END
  477. END;
  478.  
  479.   { Function Below Gets Pointer to Source File List Entry at Offset }{.CP09}
  480.  
  481. FUNCTION  AddrSrcTabOff(U: UnitPtr; Offset: Word): SrcFilePtr;
  482. BEGIN
  483.     WITH U^ DO
  484.     IF (UHLSF+Offset) < UHDBT
  485.     THEN AddrSrcTabOff := SrcFilePtr(PtrAdjust(U,UHLSF+Offset))
  486.     ELSE AddrSrcTabOff := Nil
  487. END;
  488.  
  489.   { Function Counts Number of Slots in PROC Map Table }            {.CP06}
  490.  
  491. FUNCTION  CountPMapSlots(U: UnitPtr): Integer;
  492. BEGIN
  493.     CountPMapSlots := (U^.UHCMT-U^.UHPMT) DIV SizeOf(PMapRec);
  494. END;
  495.  
  496.   { Function Gets Address of PROC Map Table }                      {.CP08}
  497.  
  498. FUNCTION  AddrPMapTab(U: UnitPtr): PMapPtr;
  499. BEGIN
  500.     IF CountPMapSlots(U) > 0
  501.     THEN AddrPMapTab := PMapPtr(PtrAdjust(U,U^.UHPMT))
  502.     ELSE AddrPMapTab := Nil
  503. END;
  504.  
  505.   { Function Counts Number of Slots in CSeg Map Table }         {.CP06}
  506.  
  507. FUNCTION  CountCMapSlots(U: UnitPtr): Integer;
  508. BEGIN
  509.     WITH U^ DO CountCMapSlots := (UHTMT-UHCMT) DIV SizeOf(CMapRec);
  510. END;
  511.  
  512.   { Function Gets Address of CSeg Map Table }                   {.CP08}
  513.  
  514. FUNCTION  AddrCMapTab(U: UnitPtr): CMapTabPtr;
  515. BEGIN
  516.     IF CountCmapSlots(U) > 0
  517.     THEN AddrCMapTab := CMapTabPtr(PtrAdjust(U,U^.UHCMT))
  518.     ELSE AddrCMapTab := Nil
  519. END;
  520.  
  521.   { Function Counts Number of DSeg Map Slots }                  {.CP06}
  522.  
  523. FUNCTION  CountDMapSlots(U: UnitPtr): Integer;
  524. BEGIN
  525.     WITH U^ DO CountDMapSlots := (UHDMT - UHTMT) DIV SizeOf(DMapRec)
  526. END;
  527.  
  528.   { Function Gets Address of DSeg Map Table }                   {.CP08}
  529.  
  530. FUNCTION  AddrDMapTab(U: UnitPtr): DMapTabPtr;
  531. BEGIN
  532.     IF CountDMapSlots(U) > 0
  533.     THEN AddrDMapTab := DMapTabPtr(PtrAdjust(U,U^.UHTMT))
  534.     ELSE AddrDMapTab := Nil
  535. END;
  536.  
  537.   { Function Below Gets Pointer to 1st Trace Table Entry or Nil }  {.CP08}
  538.  
  539. FUNCTION  AddrTraceTab(U: UnitPtr): TraceRecPtr;
  540. BEGIN
  541.     IF U^.UHDBT = U^.UHENC
  542.     THEN AddrTraceTab := Nil
  543.     ELSE AddrTraceTab := TraceRecPtr(PtrAdjust(U,U^.UHDBT))
  544. END; {AddrTraceTab}
  545.  
  546.    { Function Below Gets Byte Count in TrExec Array }      {.CP20}
  547.  
  548. FUNCTION GetTrExecSize(T: TraceRecPtr): Integer;
  549. VAR i,k : Integer;
  550. BEGIN
  551.    IF T = Nil THEN GetTrExecSize := 0 ELSE
  552.    BEGIN
  553.       k := T^.TrLNos;                   {number of lines in array}
  554.       i := 1;                           {prime scan line number  }
  555.       WHILE i <= k DO BEGIN             {still have lines to test}
  556.          IF T^.TrExec[i] = $80 THEN     {if "escape byte" present}
  557.      BEGIN
  558.        Inc(k);                      {bump array limit        }
  559.        Inc(i)                       {bump to byte count slot }
  560.      END;
  561.      Inc(i)                         {check next slot         }
  562.       END;
  563.       GetTrExecSize := k;               {final byte count        }
  564.    END;
  565. END;
  566.  
  567.   { Function Below Gets Pointer to next Trace Table Entry or Nil }  {.CP14}
  568.  
  569. FUNCTION  AddrNxtTrace(U: UnitPtr; T: TraceRecPtr): TraceRecPtr;
  570. VAR k : Integer;
  571. BEGIN
  572.     IF T = Nil THEN AddrNxtTrace := Nil ELSE
  573.     BEGIN
  574.         k := GetTrExecSize(T);
  575.         T := TraceRecPtr(PtrAdjust(@T^.TrExec[1],LL(k)));
  576.         IF FormLL(U,T) >= U^.UHENC
  577.             THEN AddrNxtTrace := Nil
  578.             ELSE AddrNxtTrace := T
  579.     END
  580. END; {AddrNxtTrace}
  581.  
  582.   { Function Below Gets Pointer to 1st Fixup Table Entry or Nil }  {.CP13}
  583.  
  584. FUNCTION  AddrFixUps(U: UnitPtr): FixUpPtr;
  585. VAR j : Word;
  586. BEGIN
  587.     IF U^.UHZFA = 0 THEN AddrFixUps := Nil ELSE
  588.     WITH U^ DO BEGIN
  589.         j := (UHENC  + $F) AND $FFF0;
  590.         j := (UHZCS  + $F) AND $FFF0 + j;
  591.         j := (UHZDT  + $F) AND $FFF0 + j;
  592.         AddrFixUps := Ptr(Seg(U^),Ofs(U^) + j)
  593.     END
  594. END; {AddrFixUps}
  595.  
  596. END.