{$D+,L+,O-,S+,R-}

{ This Unit provides the tools needed for high-level analysis }
{ of desired units by the main program (TWU1).  It is object  }
{ oriented in its implementation but not in its interface.    }
{ The intended user of this unit has relatively simple needs  }
{ and no additional capabilities are provided.  In particular }
{ the details of implementation including data structures are }
{ hidden from any potential user.  The object methodology is  }
{ not very spiritual.  Neither inheritance nor virtual method }
{ techniques are employed, but static objects are utilized to }
{ assist with data management on the heap providing a highly  }
{ structured environment for implementation.		      }

Unit TWU1UAM;

(*****************)
(**) INTERFACE (**)	Uses TWU1EQU, TWU1RPT, Dos;
(*****************)

CONST

  _UnitEye  = 'TPU9';		{ Identifies Units For TP60, TPW10    }
  _Win_Lib  = 'TPW.TPL';	{ Turbo Pascal Unit Library - WINDOWS }
  _Dos_Lib  = 'TURBO.TPL';	{ Turbo Pascal Unit Library - DOS     }
   Masker   = $FFFFFFF0;	{ Paragraph AND Mask		      }

  _Lib_Nam  : _FileSpec = _Win_Lib;	{ Default to Windows Library  }

				{ Call Model Flag Bits     }
  Sstb_cmASM 	     = $80;	{ Call Model: ASSEMBLER    }
  Sstb_cmDestructor  = $50;	{ Call Model: DESTRUCTOR   }
  Sstb_cmConstructor = $30;	{ Call Model: CONSTRUCTOR  }
  Sstb_cmMethod      = $10;	{ Call Model: METHOD- any  }
  Sstb_cmObject	     = $08;	{ $L OBJECT Mod (OBJ/OBW)  }
  Sstb_cmInterrupt   = $04;	{ INTERRUPT Routine        }
  Sstb_cmINLINE	     = $02;	{ INLINE Declarative Macro }
  Sstb_cmFAR	     = $01;	{ Call Model: FAR	   }

VAR	Base_Code, 		{ Logical Load Address for CODE Segments }
	Base_Data,		{ Logical Load Address for CONS Segments }
	Base_FixC,		{ Logical Load Address for CODE Fix-Ups	 }
	Base_FixD: LongInt;	{ Logical Load Address for CONS Fix-Ups  }

TYPE
	_UnitName = String[8];	{ Max Size of a Unit Name      }
	_LexName  = String[63];	{ Max Size of Pascal Names     }
	SrcNam    = _FileSpec;

	HdrAry    = ARRAY[0..3] OF Char;

	LL  = Word;		{ Local Scope Locators (offsets) }

  LG  = RECORD		{ --Global Scope Locators to Other Units-- }
	UntLL: LL;	{ To Entry in Unit Named by Type "Y" Entry }
        UntId: LL;	{ To Stub of Type "Y" Name Entry 	   }
  END;  {LG}

  { Mapping for Unit Header and Locator Table }			{.CP28}

UnitPtr = ^UnitHeader;
UnitHeader = RECORD
	UHEYE : HdrAry;		{ +00 : = 'TPU9'                     }
	UHxxx : HdrAry;		{ +04 : = $00000000                  }
	UHUDH : LL;		{ +08 : to DName Entry for This Unit }
	UHIHT : LL;		{ +0A : to Interface Hash Header     }
	UHPMT : LL;		{ +0C : to PROC Map                  }
	UHCMT : LL;		{ +0E : to CSeg Map                  }
	UHTMT : LL;		{ +10 : to DSeg Map-Typed CONST's    }
	UHDMT : LL;		{ +12 : to DSeg Map-GLOBAL Variables }
	UHDLL : LL;		{ +14 : to DLL Module List           }
	UHLDU : LL;		{ +16 : to Donor Unit List           }
	UHLSF : LL;		{ +18 : to Source File List          }
	UHDBT : LL;		{ +1A : DEBUG Trace Table            }
	UHZDA : Word;		{ +1C : Size of DICTIONARY Area      }
	UHZCS : Word;		{ +1E : CSEG Size-Aggregate          }
	UHZDT : Word;		{ +20 : DSEG Size-Typed CONSTS Only  }
	UHZFA : Word;		{ +22 : Fix-Up Size (CSegs)          }
	UHZFT : Word;		{ +24 : Fix-Up Size (Typed CONST's)  }
	UHZFV : Word;		{ +26 : DSEG Size for Global VARs    }
	UHDHT : LL;		{ +28 : to Global Hash Header        }
	UHSOV : Word;		{ +2A : Flags ??	             }
	UHPad : ARRAY[0..9]
		OF Word;	{ +2C : Reserved for Future Expansion ? }

END; { UnitHeader }

  { Mapping for PROC Map }					{.CP12}

  PMapRecPtr  = ^PMapRec;
  PMapRec = RECORD
	ProcWd1,   	{ purpose is unknown			}
	ProcWd2 : Word; { contains proc attribute flags?        }
	CSegOfs : Word;	{ offset within CSeg Map; $FFFF if null }
	CSegJmp : Word;	{ offset to entry point;  $FFFF if null }
  END {PMapRec};

  PMapPtr = ^PMapTab;
  PMapTab =  ARRAY[0..1] OF PMapRec; { model of PROC Map }

  { Mapping for CSeg Map }					{.CP12}

  CMapRecPtr = ^CMapRec;
  CMapRec = RECORD
	CSegWd0,	{ purpose is unknown              }
	CSegCnt,	{ byte count of module code       }
	CSegRel,	{ byte count of module Relo List  }
	CSegTrc : Word;	{ Trace table offset or $FFFF     }
  END; {CMapRec}

  CMapTabPtr = ^CMapTab;
  CMapTab = ARRAY[0..1] OF CMapRec; { model of CSeg Map }

  { Mapping for CONST/VAR DSeg Maps }				{.cp12}

  DMapRecPtr = ^DMapRec;
  DMapRec = RECORD
	DSegWd0 : Word;	{ purpose is unknown		}
	DSegCnt : Word;	{ byte count of DSeg block	}
	DSegRel : Word;	{ byte count of DSeg Relo List	}
	DSegOwn : LL;	{ To owner scope (VMT/DMT)	}
  END; {DMapRec}

  DMapTabPtr = ^DMapTab;
  DMapTab = ARRAY[0..1] OF DMapRec;	{ model of DSeg Map }

  { One Entry in CODE/DATA Fix-Up List }			{.CP29}

  FixUpRecPtr = ^FixUpRec;
  FixUpRec = RECORD
	Case Word Of
	0:   	{ -- Smart Linker Fix-Ups (Windows/Dos) -- }
	   (
	   FixDnr : Byte;	{ Donor Unit Offset		}
	   FixFlg : Byte;	{ Entry Format Flag		}
	   FixWd1 : Word;	{ Offset to Map Table		}
	   FixWd2 : Word;	{ Effective Address Adjuster	}
	   FixOfs : Word;	{ offset to patch in text block }
	   );
	$FFFF:	{ -- Loader Fix-Ups For Windows 8087 Emulator -- }
	   (
	   EmuTag : Word;	{ $FFFF flags Emulator Fix-Up	}
	   EmuTyp : Word;  	{ Specific Emulator Fix-Up Type	}
		  { 2 = SS Override - (INT 3Ch : "ESC" = 18-1F)	}
		  { 3 = CS Override - (INT 3Ch : "ESC" = 58-5F)	}
		  { 4 = ES Override - (INT 3Ch : "ESC" = D8-DF)	}
		  { 5 = NO Override - (INT 34-3Bh : D8-DF)	}
		  { 6 = Emulate FWAIT Op ($909B) - (INT 3Dh)	}
	   EmuEmt : Word;  { Probably always zero	 	}
	   EmuOfs : Word;  { Offset to start of Emulated Op 	}
	   );
  END; {FixUpRec}

  FixUpPtr  = ^FixUpList;
  FixUpList = ARRAY[0..1] OF FixUpRec;	{ model of Fix-Up List }

  { Dictionary Name Entry Mapping in Turbo Units }		{.CP08}

  DNamePtr = ^ DNameRec;
  DNameRec = RECORD
	HLink : LL;	    { Hash Chain Link; Resolves Collisions }
	DForm : Char;	    { Symbol Type; See StubRecord for types}
	DSymb : _LexName;   { Worst-Case Symbol Size (UPPER-CASE)  }
  END; {DNameRec}

  { Variant Type For TYPE "R" Dictionary Entry Stubs }		{.CP20}

  VarStubPtr = ^VarStub;
  VarStub    = RECORD
	Case  Byte Of		{ sRAM Byte in Type "R" Stub }
	     $02,$06,
	     $22,$26:	(ROfs : Word;  { allocation offset (BP)  }
			 ROB  : Word); { To Parent Scope/Zero    }

	     $00,$01:	(TOfs : Word;  { allocation offset in map}
			 TOB  : LL);   { offset in VAR/CONST Map }

		 $03:	(AOfs : Word;  { Absolute Byte Offset    }
			 ASeg : Word); { Absolute Segment Adr    }

		 $08:	(Bofs : Word;  { Offset-Record Relative  }
			 RChn : LL);   { To Next Field/Method    }

		 $10:	(QLG  : LG);   { to Stub of Allocator    }
  End;

  { Dictionary Stub Mapping }					{.CP10}

  DStubPtr = ^ DStubRcd;
  DStubRcd = RECORD
    CASE Char OF

      'R': (			{ -- Variable, Field, Object  --  } {.CP35}
	    sRAM : Byte;        {   allocation method codes:      }
				{ $00 = Global Variables in DS    }
				{ $01 = Typed Constants  in DS    }
				{ $02 = VAR-BP based-Nested Scope }
				{ $03 = Absolute[Segment:Offset]  }
				{ $06 = SELF Parameter-ADDR Stack }
				{ $08 = Allocate in Record/Object }
				{ $10 = Absolute Equivalence      }
				{ $22 = VALUE Parameter-BP based  }
				{ $26 = VAR   Parameter-BP based  }

	    sRVF : VarStub;	{ Don't have UNION - see Above!   }
	    sRTD : LG);		{ to Type Descriptor              }

      'S': (			{ ------ User Subprograms ----- }  {.CP20}
	    sSTp : BYte;	{ 76543210  - BIT Encoded Flags }
				{ .......1 = FAR Call Model     }
				{ ......1. = INLINE Declarative }
				{ .....1.. = INTERRUPT Routine  }
				{ ....1... = .OBJ module code   }
				{ ...1.... = METHOD (Any)       }
				{ .011.... = Constructor METHOD }
				{ .101.... = Destructor  METHOD }
				{ 1....... = ASSEMBLER attribute}
	    sSxx : Byte;	{ More Attribute Flags?		}
	    sSPM : Word;	{ Code byte count if INLINE,	}
				{ else, offset to PROC Map	}
	    sSPS : LL;		{ to containing scope or zero	}
	    sSHT : LL;		{ to local scope hash table	}
	    sSVM : Word);	{ VMT Offset-VIRTUAL Method PTR	}

	    { Note:  "sSVM" is followed immediately by a Type    }
	    {        Descriptor ($06).  INLINE Declarative code  }
	    {        Bytes then follow (if any).                 }

      'Q',			{ -------- Named Types -------- }  {.CP03}
      'X':(			{ ----- External Variables ---- }
	   sQTD : LG);		{ to type descriptor            }


      'P':(			{ --- For Untyped Constants --- }
	   sPTD : LG;		{ to type descriptor            }
	   sPV1 : Word;		{ value of constant - LO Word   }
	   sPV2 : Word);	{ (size varies)     - HI Word   }

      'Y':(			{ ----- For UNIT Entries ------ }  {.CP05}
	   sYW1 : Word;		{ unknown use; normally zero	}
	   sYCS : Word;		{ Unit Version Number		}
	   sYNU : LL;		{ to next Unit in List (SUCC)	}
	   sYPU : LL);		{ to prior Unit in List (PRED)	}

      'O',			{ ---- Label Declaratives ----- }  {.CP05}
      'T',			{ ---- Standard Procedures ---- }
      'U',			{ ---- Standard Functions  ---- }
      'V':(			{ ---- Standard "NEW" F/P  ---- }
	   sVxx : Word);	{ semantics not precisely known }

      'W':(			{ ------- Standard Ports ------ }  {.CP02}
	   sWxx : Byte);	{ 0=Byte Array, 1=Word Array    }
      END;

  { One Formal Parameter List Entry }				{.CP06}

  FormalParmRcd = RECORD
	   fPTD : LG;		{ to type descriptor for parameter  }
	   fPAM : Byte;		{ passing model; 2=Value, 6=Address }
     END;

  InlineLst = ARRAY[0..1] OF Word;		{ model of INLINE code }


  { Type Descriptor mapping for Turbo Units follows }		{.CP08}

  TypePtr   = ^TypeRecd;
  TypeRecd  = RECORD
       tpTC : Byte;		{ Identifies the Variant Part }
       tpTQ : Byte;		{ Type Qualifier              }
       tpSW : Word;		{ Storage Width in Bytes      }
       tpML : Word;		{ Next Method if tpTC=$06     }

       CASE Byte OF						{.CP04}
	$00,			{ For NULL / Un-Typed Variables }
	$0A,			{ COMP,DOUBLE,EXTENDED,SINGLE 	}
	$0B: ();		{ ------- For REAL Type ------- }

	$01: (			{ ------ For ARRAY Types ------ }{.CP04}
		BaseType: LG;	{ to TypeRecd for item arrayed  }
		BounDesc: LG;	{ to TypeRecd for array bounds  }
             );

	$02: (			{ ------ For RECORD Types ------ }{.CP04}
		RecdHash: LL;	{ to Hash Table for Field List   }
		RecdDict: LL;	{ to Field List Dictionary Begin }
             );

	$03: (			{ ------ For OBJECT Types ------ }{.CP15}
		ObjtHash: LL;	{ to Fields & Methods Hash Table }
		ObjtDict: LL;	{ to Fields & Methods Dictionary }
		ObjtOwnr: LG;	{ to Parent Object Type Descript }
		ObjtVMTs: Word;	{ Size of VMT if Virtual Methods }
		ObjtDMap: Word;	{ Data Map Offset of VMT Template}
		ObjtVMTO: Word;	{ object instance offset to VMT  }
				{ pointer; $FFFF if object has   }
				{ no Virtual Methods (no VMT)    }
		ObjtName: LL;	{ to Object Dictionary Header    }
		ObjtDMTp,	{ $FFFF or DMap Offset of DMT    }
		ObjtRes1,	{ Usually zero  - Role Unknown   }
		ObjtRes2,	{ Usually zero  - Role Unknown   }
		ObjtRes3: Word	{ Usually zero  - Role Unknown   }
             );

	$04,			{ ----- For FILE except TEXT ----} {.CP04}
	$05: (			{ ----- For TEXT file type ----- }
		FileType: LG;	{ to TypeRecd for Base File Type }
             );
	$06: (			{ ----- For Procedure Types ---- } {CP05}
		PFRes: LG;	{ to Function Result TD / zero   }
		PNPrm: Word;	{ Formal Parameter Count/ zero   }
                PFPar: ARRAY[1..2] OF FormalParmRcd { model only }
             );
	$07: (			{ ------- For SET Types -------- } {.CP03}
		SetBase: LG;	{ to base type descriptor of set }
             );
	$08: (			{ ----- For POINTER Types ------ } {.CP03}
		PtrBase: LG;	{ to base type descriptor        }
             );
	$09: (			{ ------ For STRING Types ------ } {.CP04}
		StrBase:  LG;	{ to SYSTEM.CHAR type descriptor }
		StrBound: LG;	{ to array bounds for string typ }
             );
	$0C,		{ For BYTE,INTEGER,LONGINT,SMALLINT,WORD } {.CP15}
	$0D,			{ ------ For BOOLEAN Type ------ }
	$0E,			{ ------- For CHAR Type -------- }
	$0F: (			{ ---- For Enumerated Types ---- }
		LoBnd: LongInt;	{ lower bound of subrange	 }
		HiBnd: LongInt;	{ upper bound of subrange	 }
		Cmpat: LG;	{ to upward compatible Type desc }
	     );

		{ The Enumeration Type Descriptor is immediately }
		{ followed by a SET Type Descriptor ($07) but we }
		{ don't know what this achieves.  Its base type  }
		{ LG points to the Enumerated Type Descriptor.	 }

       END;  { TypeRecd }

  { The Record below is a model Hash Table }			{.CP07}

  HashPtr   = ^HashTable;
  HashTable = RECORD
	Bas: Word;                { Base and Max Offset in Slt }
	Slt: ARRAY[0..63] Of LL;  { Slots in Hash Table        }
  END;

  { The Record below maps a DLL List Entry - TPW Only}		{.CP07}

  DLLPtr = ^DLLList;
  DLLList = Record
	DLLWrk: Array[0..3] of Byte;	{ Work Area ? }
	DLLMod: String[8];		{ Module Name }
  End;

  { One Entry in the Unit Code/Data Donor List }		{.CP07}

  UDonorPtr = ^UDonorRec;
  UDonorRec = RECORD
	UDExxx: Word;
	UDEnam: String[8]	{ Name of Donor Unit }
  END;

  { One Entry in the Source File List }				{.CP11}

  SrcFilePtr = ^SrcFileRec;
  SrcFileRec = RECORD
	SrcFlag: Byte;		{ 4=.PAS, 3=.INC, 5=.OBJ, 6=.RES    }
	SrcPad:  Word;		{ no apparent use - always zero ?   }
	SrcTime: Word;		{ File Time Stamp if SrcFlag=3 or 4 }
	SrcDate: Word;		{ File Date Stamp if SrcFlag=3 or 4 }
	SrcName: SrcNam;	{ Varying length FileName.Extn      }
				{ (includes full path if TPWindows  }
  END;

  { One Entry in the Trace Table }				{.CP12}

  TraceRecPtr = ^TraceRec;
  TraceRec    = RECORD
	TrName: LL;		{ to Directory Entry of Proc/Method  }
	TrFill: Word;		{ to proc source file                }
	TrPfx:  Word;		{ bytes of data in front of code     }
	TrBeg:  Word;		{ Line Number of BEGIN Stmt          }
	TrLNos: Word;		{ Lines of Code to Execute in TRACE  }
	TrExec: ARRAY[1..2]	{ Model Array of bytes that map each }
		OF Byte;	{ line of code to be traced by DEBUG }
  END;

FUNCTION  AddrCMapTab(U: UnitPtr): CMapTabPtr;			{.CP26}
Function  AddrCodeArea(U: UnitPtr): Pointer;
FUNCTION  AddrCodeFixUps(U: UnitPtr): FixUpPtr;
Function  AddrDataArea(U: UnitPtr): Pointer;
FUNCTION  AddrDataFixUps(U: UnitPtr): FixUpPtr;
FUNCTION  AddrDict(U: UnitPtr; Hash: LL): DNamePtr;
FUNCTION  AddrDLLTabOff(U: UnitPtr; Offset: Word): DLLPtr;
FUNCTION  AddrDMapTab(U: UnitPtr): DMapTabPtr;
FUNCTION  AddrHash(U: UnitPtr; Hash: LL): HashPtr;
FUNCTION  AddrLGUnit(U: UnitPtr; TypeLG: LG): DNamePtr;
FUNCTION  AddrNxtDLL(U: UnitPtr; Arg: DLLPtr): DLLPtr;
FUNCTION  AddrNxtTrace(U: UnitPtr; T: TraceRecPtr): TraceRecPtr;
FUNCTION  AddrPMapTab(U: UnitPtr): PMapPtr;
FUNCTION  AddrProcType(S: DStubPtr): TypePtr;
FUNCTION  AddrNxtSrc(U: UnitPtr; Arg: SrcFilePtr): SrcFilePtr;
FUNCTION  AddrSrcTabOff(U: UnitPtr; Offset: Word): SrcFilePtr;
FUNCTION  AddrStub(arg: DNamePtr): DStubPtr;
FUNCTION  AddrTraceTab(U: UnitPtr): TraceRecPtr;
FUNCTION  AddrType(U: UnitPtr; TypeLG: LG): TypePtr;
FUNCTION  CountCMapSlots(U: UnitPtr): Integer;
FUNCTION  CountDMapSlots(U: UnitPtr): Integer;
FUNCTION  CountPMapSlots(U: UnitPtr): Integer;
FUNCTION  FormLL(Base,Ceil: Pointer): LL;
FUNCTION  GetTrExecSize(T: TraceRecPtr): Integer;
FUNCTION  IsSystemUnit(U: UnitPtr): Boolean;

  { Function Below Removes PRIVATE Bit from Name Class }	{.CP06}

FUNCTION Public(Arg: Char): Char;
			{ BEGIN Public := Chr(Ord(Arg) AND $7F) END; }
INLINE(	$58/		{ POP	AX 	}
        $24/$7F);	{ AND	AL,$7F	}

{ -------------------------------------------------------- }	{.CP04}
{ PurgeAllUnits	- Removes all Units and Analyses from Heap }

  Procedure PurgeAllUnits;

{ --------------------------------------------------------------- }{.CP05}
{ AnalyzeUnit	- Loads and analyzes a Unit; references to Units  }
{		  it USES are resolved to clarify LG references   }

  Function  AnalyzeUnit(Name: _UnitName; Path: String): UnitPtr;

{ --------------------------------------------------------------- }{.CP13}
{ ResolveLG	- Checks all Directly referenced Units to locate  }
{		  the Unit and the Dictionary Entry for the owner }
{		  of the Descriptor referenced by an LG provided  }
{		  AnalyzeUnit has been called before-hand	  }

Type
  RespLG = Record		{ Returned by ResolveLG    }
	UPtr: UnitPtr;		{ Pointer to Named Unit    }
	Ownr: LL;		{ LL to Owner of LG'd Item }
  End;

  Procedure ResolveLG(N: _UnitName; L : LG; VAR R: RespLG);

{ ---------------------------------------------------------- }	{.CP23}
{ FetchSurveyRec  - is called to fetch the next SurveyRec    }
{		    to support formatted Dictionary printing }
{		    of the primary Unit			     }

Type CoverId = (cvName,		{ Dictionary Entry Headers }
		cvHash,		{ Hash Tables              }
		cvType,		{ Type Descriptors         }
		cvINLN,		{ INLINE Code Bytes        }
		cvNULL);	{ terminating status       }

  SurveyRecPtr = ^ SurveyRec;	{ Output of Survey }

  SurveyRec = RECORD
	LocLL  : LL;		{ LL to location of data structure      }
	LocOwn : LL;		{ LL to Dictionary Header of Owner or 0 }
	LocTyp : CoverId;	{ Class of Structure (see above)        }
	LocNxt : LL;		{ LL to location of following structure }
	LocLvl : Word;		{ Nesting Level of entry                }
  End;

  Procedure FetchSurveyRec (VAR S : SurveyRec);	{ Gets Dictionary Survey }
                          			{ Results Sequentially   }

{ ---------------------------------------------------------------- } {.CP53}
{ SortProcRefs	- is called to sort the reference information for  }
{		  PROC Maps into either CSEG or PROC map order to  }
{		  print.  BOTH sequences are used by TPU6.  Only a }
{		  Primary Unit gets these references built for it. }
{								   }
{ FetchMapRef	- is called to fetch a MapRefRec (see below) using }
{		  the map offset.  Only the primary Unit has such  }
{		  references constructed for it.		   }

Type
     MapFlags = (mfNULL,	{ Undefined / Unused Entry       }
		 mfINTF,	{ INTERFACE CONST/VAR Map Entry  }
		 mfIMPL,	{ IMPLEMENTATION CONST/VAR Map   }
		 mfNEST,	{ NESTED Scope Typed CONST DSeg  }
		 mfXTRN,	{ EXTERNAL CONST/VAR DSeg        }
		 mfTVMT,	{ VMT Template in CONST Map      }
		 mfTDMT,	{ DMT Template in CONST Map	 }
		 mfPROC,	{ PROC Map Entry                 }
		 mfPRUI,        { PROC Map Entry - Unit Init     }
		 mfPDLL,	{ PROC Map Entry - DLL Proc	 }
		 mfCSEG);	{ CSEG Map Entry                 }

     MapClass = (rPROC,		{ PROC Map 			 }
		 rCSEG,		{ CSeg Map 			 }
		 rVARS,		{ VARS Map - Global VAR DSeg Map }
		 rCONS);	{ CONS Map - Typed Constants Map }

  MapRefRecPtr = ^ MapRefRec;	{ Output of VAR/CONST Map Survey }
  MapRefRec = RECORD
	MapTyp: MapFlags;	{ Defining Scope Category (see above)   }
	MapOfs: Word;		{ Offset within Map Table               }
	MapOwn: LL;		{ DNAME of Parent Scope / PROC          }
	MapSrc: Word;		{ Offset in Source File / DLL List      }
	MapLod: Word;		{ Load Point Segment Offset-CODE/CONST  }
	MapSiz: Word;		{ Size of Segment / PROC (Bytes)        }

     CASE MapFlags OF
	mfCSEG: (		{--CSEG/CONST Map Table Only--}
		 MapFxI: Word;	{ Offset to Initial Fix-Up    }
		 MapFxJ: Word;	{ Segment Fix-Up Byte Count   }
		);
	mfPROC: (		{-----PROC Map Table Only-----}
		 MapEPT: Word;	{ Entry Point Offset for PROC }
		 MapCSM: Word;	{ Offset in CSEG Map for PROC }
		);
	mfPDLL: (		{-----PROC DLL Entry Only-----}
		 MapNdx: Word;	{ Index to DLL Entry Point    }
		 MapDLL: Word;	{ Not Used at this time       }
		);
  END;

  SortMode =	(CSegOrder,	{ Sort Proc Map into CSeg Order }
		 PMapOrder);	{ Sort Proc Map into Proc Order }

  Procedure SortProcRefs (Mode: SortMode);  { PROC Map Ref Sorts   }

  Procedure FetchMapRef  (VAR S : MapRefRec;  { Gets map references  }
			    C   : MapClass;   { for the primary unit }
			  Offset: Word);


(**********************)					{.CP03}
(**) IMPLEMENTATION (**)
(**********************)
{$IFDEF TESTDBG}
Uses	Crt;			{ Used Only For Debugging }
{$ENDIF}

Type
        UnitMode  = (Entire,Partial);
	TUnitPtr  = ^ TUnit;
	RMapPtr   = ^ RMap;
	MapTabPtr = ^ MapTab;
	CvrPtr    = ^ CvrTab;
	CvrRecPtr = ^ CvrRec;

     CvrRec = RECORD
        LocLL  : LL;       { LL to location of data structure      }
	LocOwn : LL;       { LL to Dictionary Header of Owner or 0 }
	LocTyp : CoverId;  { Type of Structure                     }
        LocLvl : Word;     { Entry Nesting Level in Dictionary     }
     END;

     CvrTab = ARRAY[1..2]  OF CvrRec;  	 { Model of Queue 	}
     MapTab = ARRAY[0..99] OF MapRefRec; { Model of Cross-Refs  }

     RMapVec   = Array[MapClass] of RMapPtr;

     LdrRec = Record
        LdrSiz : Word;
        LdrUpt : Pointer;
     End;
     LdrVec = Array[1..5] Of LdrRec;	{ Used by Segmented Loader }

{ ----------------------------------------------------- }	{.CP38}
{ The TUnit Object is used to organize all information  }
{ known about a Unit.  It functions as an index node to }
{ allow reasonably fast access to a Unit by either name }
{ or by address.  It provides links RMap objects which  }
{ anchor "map" analyses.  It contains the controls that }
{ manage the dictionary "cover" built for each Unit.    }
{ ----------------------------------------------------- }

     TUnit = Object
       Link: 	   TUnitPtr;	{ To Next TUnit in List	}
       UImg: 	   UnitPtr;	{ To Unit Image on Heap	}
       UCod:	   ^Byte;	{ To UNIT CODE Segments	}
       UDta:	   ^Byte;	{ To Unit CONS Segments }
       UFXC:	   FixUpRecPtr; { To Unit CODE Fix-Ups  }
       UFXD:	   FixUpRecPtr;	{ To Unit DATA Fix-Ups  }
       USiz: 	   Word;	{ Allocated Image Size	}
       UCSz,			{ Allocated Code  Size  }
       UDSz,			{ Allocated Data  Size  }
       UFCz,			{ Allocated FXC   Size  }
       UFDz:	   Word;	{ Allocated FXD   Size  }
       Name: 	   _UnitName;	{ Name for Fast Search	}
       CvrRMaps:   RMapVec;	{ To Map Analyses	}
       CvrQue:     CvrPtr;	{ To Completed Survey	}
       CvrSize:    LongInt;	{ Allocation Size Bytes }
       CvrLimit,		{ Queue Max Subscript   }
       CvrQueTail,		{ Cover Queue Tail	}
       CvrQueHead,		{ Cover Queue Head	}
       CvrQueMax:  Word;	{ Cover Queue Ceiling	}
       Destructor  Done;
       Constructor Init(Id: _UnitName; Vector: LdrVec);
       Procedure   DisposeQueue;
       Procedure   CalcCovers;
       Procedure   IndexMaps;
       FUNCTION    QueuePos(Locn: LL): Word;
       PROCEDURE   EnQueue(Arg: CvrRec);
       FUNCTION    Queued(Key: LL) : Boolean;
     End;  { TUnit }

{ ----------------------------------------------------- }	{.CP17}
{ The RMap Object is used to organize the information   }
{ pertaining to Unit Map references.  One such object   }
{ is spawned for each Map type (CSeg,PROC,DSeg,CONST)   }
{ and this object stores allocator information about    }
{ the vector in which the references are stored.        }
{ ----------------------------------------------------- }

   RMap = Object
	RMapTabPtr: MapTabPtr;		{ To Map References }
	RMapTabSiz: Word;		{ Reference Counter }
	Destructor  Done;
	Constructor Init(Width: Word);
	Procedure   SortPmap(Mode: SortMode);
	Procedure   FetchRef(VAR S: MapRefRec; Offset: Word);
	Procedure   StoreRef(    S: MapRefRec; Offset: Word);
   End;

Const RefLen = SizeOf(MapRefRec); MapLen = SizeOf(DMapRec);
      LstRoot: TUnitPtr   = Nil;
      NullMap: MapRefRec  = (MapTyp: mfNULL; MapOfs: 0;
			     MapOwn: $FFFF;  MapSrc: 0;
			     MapLod: 0;      MapSiz: 0;
			     MapEPT: 0;      MapCSM: 0);

VAR   CvrWork : CvrRec;

{$IFDEF TESTDBG}
VAR  ExitSave: Pointer; Audit: Text;

  Procedure MyExit; FAR;
  Begin
     ExitProc := ExitSave;
     If TextRec(Audit).Mode <> fmClosed Then Close(Audit);
  End;

{$ENDIF}

     {   Begin Methods for   R M a p   }			{.CP18}

Constructor RMap.Init(Width: Word);
Var I: Word; S: MapRefRec;
Begin
	RMapTabPtr := Nil; RMapTabSiz := Width DIV SizeOf(DMapRec);
	IF RMapTabSiz > 0 Then
	Begin
	   GetMem(RMapTabPtr,RMapTabSiz * RefLen);
	   S := NullMap;
	   If RMapTabPtr = Nil Then RMapTabSiz := 0
	   Else
              For I := 0 To RMapTabSiz-1 Do Begin
                 RMapTabPtr^[i] := S;
                 Inc(S.MapOfs,SizeOf(DMapRec));
              End;
        End;
End;

Destructor RMap.Done;						{.CP05}
Begin
	IF RMapTabSiz > 0 Then FreeMem(RMapTabPtr,RMapTabSiz * RefLen);
	RMapTabPtr := Nil; RMapTabSiz := 0;
End;

   Function CSegSort(Var pA, pB): Boolean; Far;
   Var A : MapRefRec Absolute Pa; B : MapRefRec Absolute Pb;
   Begin
	CSegSort := False;
	If (A.MapTyp <> mfPDLL) AND (B.MapTyp <> mfPDLL) Then
	Begin
	   If A.MapCSM < B.MapCSM Then CSegSort := True
	   Else  If A.MapCSM = B.MapCSM
		 Then If A.MapEPT < B.MapEPT Then CSegSort := True
	End
	Else CSegSort := Ord(A.MapTyp) < Ord(B.MapTyp)
   End; {CSegSort}

   Function PMapSort(Var pA, pB): Boolean; Far;
   Var A : MapRefRec Absolute Pa; B : MapRefRec Absolute Pb;
   Begin PMapSort := A.MapOfs < B.MapOfs End;

Procedure RMap.SortPmap(Mode: SortMode);			{.CP25}
Var CompareProc: _Compare;
Begin {SortPMap}						{.CP49}
   If (RMapTabSiz > 1) AND (RMapTabPtr <> Nil) Then
   Begin
        Case Mode Of
             CSegOrder: CompareProc := CSegSort;
             PMapOrder: CompareProc := PMapSort;
        End; {Case}
	QuickSort( RMapTabPtr,
		   RMapTabSiz,
		   SizeOf(MapRefRec),
                   CompareProc);
   End;
End; {SortPMap}

Procedure RMap.FetchRef(VAR S : MapRefRec; Offset : Word);	{.CP10}
Var I : Word;
Begin
	If (Offset MOD MapLen) = 0
	Then I := Offset Div MapLen
	Else I := RMapTabSiz;
	If NOT (I < RMapTabSiz)
	Then S := NullMap
	Else S := RMapTabPtr^[I];
End;

Procedure   RMap.StoreRef(S : MapRefRec; Offset : Word);	{.CP09}
Var I : Word;
Begin
	If (Offset MOD MapLen) = 0
	Then I := Offset Div MapLen
	Else I := RMapTabSiz;
	If (I < RMapTabSiz)
	Then RMapTabPtr^[I] := S
End;

     {   Begin  Methods For   T U n i t   }			{.CP18}

Constructor TUnit.Init( Id: _UnitName;  Vector: LdrVec);
Begin
   Link := Nil;		Name := Id;		CvrQue     := Nil;
   CvrQueTail := 0;     CvrQueHead := 0;        CvrQueMax := 0;
   CvrSize    := 0;     CvrLimit   := 0;	
   CvrRMaps[rPROC] := Nil;	CvrRMaps[rCSEG] := Nil;
   CvrRMaps[rVARS] := Nil;	CvrRMaps[rCONS] := Nil;
   UImg := Vector[1].LdrUpt; USiz := Vector[1].LdrSiz;		
   UCod := Vector[2].LdrUpt; UCSz := Vector[2].LdrSiz;
   UDta	:= Vector[3].LdrUpt; UDSz := Vector[3].LdrSiz;
   UFxC := Vector[4].LdrUpt; UFCz := Vector[4].LdrSiz;
   UFxD := Vector[5].LdrUpt; UFDz := Vector[5].LdrSiz;
End;  {TUnit.Init}

Procedure TUnit.DisposeQueue;					{.CP05}
Begin
   If CvrQue <> Nil Then FreeMem(CvrQue,CvrSize);
   CvrQue := Nil; CvrSize := 0; CvrLimit := 0;
End;

Destructor  TUnit.Done;						{.CP09}
Begin
   DisposeQueue;
   If CvrRMaps[rPROC] <> Nil Then CvrRMaps[rPROC]^.Done;
   If CvrRMaps[rCSEG] <> Nil Then CvrRMaps[rCSEG]^.Done;
   If CvrRMaps[rVARS] <> Nil Then CvrRMaps[rVARS]^.Done;
   If CvrRMaps[rCONS] <> Nil Then CvrRMaps[rCONS]^.Done;
   If UImg <> Nil Then FreeMem(UImg,USiz); UImg := Nil; USiz := 0;
   If UCod <> Nil Then FreeMem(UCod,UCsz); UCod := Nil; UCsz := 0;
   If UDta <> Nil Then FreeMem(UDta,UDsz); UDta := Nil; UDsz := 0;
   If UFxC <> Nil Then FreeMem(UFxC,UFCz); UFxC := Nil; UFCz := 0;
   If UFxD <> Nil Then FreeMem(UFxD,UFDz); UFxD := Nil; UFDz := 0;

End;

Function SearchCover(Key: LL; P: CvrPtr; Tail: Word): Word;	{.CP21}
VAR Lo, Mid, Hi : Word;
BEGIN
   Lo := 1; Hi := Tail;
   REPEAT
      ASM
		XOR BX,BX	{ make a Zero        }
                MOV AX,Lo       { fetch Lo           }
                ADD AX,Hi       { Add Hi             }
                RCR BH,1        { save carry         }
                SHR AX,1        { divide sum by 2    }
                OR  AH,BH       { restore carry      }
                MOV Mid,AX      { save (Lo+Hi) DIV 2 }
      End;
      IF Key > P^[Mid].LocLL
      THEN Lo := Mid + 1
      ELSE Hi := Mid - 1
   UNTIL (Key = P^[Mid].LocLL) OR (Lo > Hi);
   IF Key > P^[Mid].LocLL THEN Inc(Mid);
   SearchCover := Mid
End; {SearchCover}

FUNCTION TUnit.QueuePos(Locn : LL):Word;			{.CP07}
VAR Lo, Mid, Hi : Word;
BEGIN
   IF CvrQueTail < 1
   THEN QueuePos := 1
   ELSE QueuePos := SearchCover(Locn,CvrQue,CvrQueTail);
END; {QueuePos}

Procedure RaiseCover(Dest: Pointer; BytCnt, Slice: Word );	{.CP15}
ASSEMBLER;
ASM            { ASM used for speed only - can be done with FOR Loop }
	PUSH DS		{ Save DS for Turbo }
	LES  SI,Dest	{ ES = Seg(Dest^), SI = Ofs(Dest^) }
	MOV  CX,BytCnt	{ CX = Byte Count to Shift }
	DEC  SI		{ SI = Ofs(Dest^) - 1 }
	MOV  DI,Slice	{ DI = SizeOf(CvrRec) }
	ADD  DI,SI	{ DI = Ofs(Dest^) + SizeOf(CvrRec) - 1 }
	MOV  AX,ES      { AX = Seg(Dest^) }
	MOV  DS,AX      { DS = Seg(Dest^) }
	STD		{ Set Direction Right-To-Left }
	REPNZ MOVSB	{ Raise the queue }
	POP  DS		{ Restore DS for Turbo }
End; {RaiseCover}

PROCEDURE TUnit.EnQueue(Arg : CvrRec);				{.CP31}

VAR Key : LL; Wide : LongInt; P, RP: ^CvrRec;
BEGIN
If CvrQue <> Nil Then
If CvrQueTail < CvrLimit Then
Begin
   Key := QueuePos(Arg.LocLL);
   RP := @CvrQue^[Key];                 { merely a speed-up }
   IF Arg.LocLL < UImg^.UHPMT THEN
   IF Key > CvrQueTail THEN
   BEGIN
      Inc(CvrQueTail);
      CvrQue^[CvrQueTail] := Arg
   END ELSE
   IF Arg.LocLL <> RP^.LocLL THEN 	{ Raise higher entries to }
   BEGIN			  	{ make room for insertion }
      Inc(CvrQueTail);
      P := @CvrQue^[CvrQueTail];	{ merely a speed-up }
      Wide := PtrDelta(P,RP);
      RaiseCover(P,			{ Destination }
      		 Wide,			{ Byte Count  }
		 SizeOf(CvrRec));	{ Entry Width }
      RP^ := Arg
   END;
   If RP^.LocLvl > Arg.LocLvl Then RP^.LocOwn := Arg.LocOwn Else
   If RP^.LocLvl = Arg.LocLvl Then
   If RP^.LocLL  > Arg.LocLL  Then RP^.LocOwn := Arg.LocOwn;
   IF CvrQueTail > CvrQueMax THEN CvrQueMax := CvrQueTail;
End;
END; {EnQueue}

FUNCTION TUnit.Queued(Key : LL):Boolean;			{.CP12}
VAR Loc : Word;
BEGIN
   Queued := False;
   If CvrQue <> Nil Then
   If CvrQueTail > 0   Then
   Begin
      Loc := QueuePos(Key);
      IF Loc <= CvrQueTail
      THEN Queued := Key = CvrQue^[Loc].LocLL
   End;
END; {Queued}

Procedure TUnit.CalcCovers;					{.CP04}
Const LvlLim = 256;
Var Level: Word; QueLoad : Boolean; ECount: Longint;
    USymbol: _LexName; A: CvrRec; LvlSav : Array[1..LvlLim] of LL;

{$IFDEF TESTDBG}						{.CP19}
Procedure CoverFault(Loc:LL);
Begin
      WriteLn;
      WriteLn('Fault -- Unit: ',Name,', Loc: ',HexW(Loc));
      WriteLn('Last Name: ',USymbol);
      WriteLn('Level: ',Level,', ECount: ',ECount);
      Loc := LL(ReadKey);
End;

Procedure CoverAudit(A: String; B: Word);
Begin
	If NOT QueLoad Then
	WriteLn(Audit,'Unit: ',name,', Loc: ',HexW(B),
		', Lvl: ',HexW(Level),', Entry: ',HexW(ECount),
		', Proc: ',A);
End;
{$ENDIF}
   PROCEDURE CoverWrapUp;

      PROCEDURE CoverWrapPost(Loc,s:LL);                         {.CP10}
      VAR J : LL;
      BEGIN
         j := QueuePos(s);
         If CvrQue <> Nil Then
	 WITH CvrQue^[j] DO
	 IF LocLL = s THEN
	 IF (LocOwn > Loc) OR (LocOwn = 0)
	 THEN LocOwn := Loc;
      END; {CoverWrapPost}

      PROCEDURE CoverWrapType(Loc: LL);				{.CP31}
      VAR D : DNamePtr; S : DStubPtr; T : TypePtr; i,j,k : LL;
         RP : VarStubPtr; DF : Char;
      BEGIN
{$IFDEF TESTDBG}
        If (Loc < UImg^.UHIHT) OR (Loc > UImg^.UHPMT)
        Then CoverFault(Loc);
{$ENDIF}
         D := AddrDict(UImg,Loc);		{ Q entry  }
	 S := AddrStub(D);			{ its stub }
         RP := @S^.sRVF;
	 T := AddrType(UImg,S^.sQTD);
	 IF T <> Nil THEN			{ TD in this unit }
	 BEGIN
            DF := Public(D^.DForm);
	    CoverWrapPost(Loc,S^.sQTD.UntLL);
	    IF (T^.tpTC = 2) OR (T^.tpTC = 3) THEN
	    BEGIN
	       i := T^.RecdDict;
	       IF i <> Loc THEN
	       WHILE i <> 0 DO BEGIN
	          CoverWrapPost(Loc,i);
		  D := AddrDict(UImg,i);
		  S := AddrStub(D);
		  IF DF = 'R' THEN i := RP^.ROB ELSE
		  IF DF = 'S' THEN i := S^.sSHT
		  ELSE i := 0;
	       END  {While I}
	    END
	 END  {IF T <> Nil}
      END;	{CoverWrapType}

   VAR i : Word;						{.CP09}
   BEGIN {CoverWrapUp}
      If CvrQue <> Nil Then
      For i := 1 TO CvrQueTail DO
      WITH CvrQue^[i] DO
      IF LocTyp = cvName THEN
      IF Public(AddrDict(UImg,LocLL)^.DForm) = 'Q'
      THEN CoverWrapType(LocLL)
   END;	{CoverWrapUp}

   PROCEDURE CoverHash(Loc, Own: LL); FORWARD;			{.CP15}

   Procedure CoverInline(Loc,Own: LL);
   Begin
{$IFDEF TESTDBG}
      CoverAudit('CoverInLine',Loc);
{$ENDIF}
      If NOT QueLoad
      Then Inc(ECount) Else
      Begin
         A.LocLL   := Loc;    A.LocOwn := Own;
         A.LocTyp  := cvINLN; A.LocLvl := Level;
         Enqueue(A);
      End;
   End; {CoverInline}

   PROCEDURE CoverType(Loc, Own: LL);				{.CP23}
   VAR T, TT : TypePtr;
   	Procedure CoverTypeTry(ALG: LG; Loc, Own: LL);
        Begin
           If AddrType(UImg,ALG) <> Nil THEN
           IF ALG.UntLL <> Loc THEN
           CoverType(ALG.UntLL,Own);
        End;
   BEGIN {CoverType}
{$IFDEF TESTDBG}
      If (Loc < UImg^.UHIHT) OR (Loc > UImg^.UHPMT)
      Then CoverFault(Loc);
      CoverAudit('CoverType',Loc);
{$ENDIF}
      If NOT QueLoad
      Then Inc(ECount) Else
      Begin
         A.LocLL   := Loc;    A.LocOwn := Own;
         A.LocTyp  := cvType; A.LocLvl := Level;
         Enqueue(A);
      End;
      T := TypePtr(PtrAdjust(UImg,Loc));
      IF T <> Nil THEN
      WITH T^ DO						{.CP36}
      CASE tpTC OF
         $01: BEGIN
         	 CoverTypeTry(BaseType,Loc,Own);
                 CoverTypeTry(BounDesc,Loc,Own);
	      END; {CASE $01}
	 $02: IF RecdHash <> 0 THEN CoverHash(RecdHash,Own);
	 $03: IF ObjtHash <> 0 THEN CoverHash(ObjtHash,ObjtName);
	 $04,
         $05: CoverTypeTry(FileType,Loc,Own);
	 $06: CoverTypeTry(T^.PFRes,Loc,Own);
	 $07: CoverTypeTry(SetBase,Loc,Own);
	 $08: CoverTypeTry(PtrBase,Loc,Own);
	 $09: BEGIN
         	 CoverTypeTry(StrBase,Loc,Own);
                 CoverTypeTry(StrBound,Loc,Own);
	      END; {CASE $09}
	 $0C, $0D,
	 $0E: CoverTypeTry(Cmpat,Loc,Own);
	 $0F: IF AddrType(UImg,Cmpat) <> Nil THEN
              IF Cmpat.UntLL <> Loc Then
	      Begin
              	 CoverType(Cmpat.UntLL,Own);
		 { now cover the SET descriptor that follows }
		 TT := TypePtr(PtrAdjust(@Cmpat,SizeOf(T^.Cmpat)));
                 If FormLL(UImg,TT) <> Loc Then
      		 If NOT QueLoad
      		 Then Inc(ECount) Else
      		 Begin
         	    A.LocLL   := Loc;    A.LocOwn := Own;
         	    A.LocTyp  := cvType; A.LocLvl := Level;
         	    Enqueue(A);
      		 End;
	      END; {CASE $0F}
      END;  {CASE tpTC}
   END;  {CoverType}

   PROCEDURE CoverName(Loc, Own: LL);				{.CP21}
   VAR C: Char; D: DNamePtr; S: DStubPtr;  T: TypePtr;
   BEGIN {CoverName}
      Repeat
{$IFDEF TESTDBG}
         If (Loc < UImg^.UHIHT) OR (Loc > UImg^.UHPMT)
	 Then CoverFault(Loc);
         CoverAudit('CoverName',Loc);
{$ENDIF}
         D := AddrDict(UImg,Loc);
         USymbol := D^.DSymb;
         If NOT QueLoad
         Then Inc(ECount) Else
         Begin
            A.LocLL   := Loc;    A.LocOwn := Own;
            A.LocTyp  := cvName; A.LocLvl := Level;
            Enqueue(A);
         End;
         S := AddrStub(D);
         C := Public(D^.DForm);
         WITH S^ DO
         CASE C OF						{.CP20}
         'P': IF AddrType(UImg,sPTD) <> Nil
                 THEN CoverType(sPTD.UntLL,0);
	 'Q': IF AddrType(UImg,sQTD) <> Nil
                 THEN CoverType(sQTD.UntLL,Loc);
	 'X': IF AddrType(UImg,sQTD) <> Nil
                 THEN CoverType(sQTD.UntLL,0);
	 'R': IF AddrType(UImg,sRTD) <> Nil
                 THEN CoverType(sRTD.UntLL,0);
	 'S': BEGIN
	         IF sSHT <> 0 THEN CoverHash(sSHT,Loc);
		 T := AddrProcType(S);
		 CoverType(FormLL(T,UImg),Loc);
		 IF (sSTp AND $02) <> 0 THEN
		 CoverInLine(FormLL(UImg,@T^.PFPar[T^.PNPrm+1]),Loc);
	      END; {CASE 'S'}
         END; {CASE C}
         Loc := D^.HLink;
      Until Loc = 0;
   END; {CoverName}

   PROCEDURE CoverHash(Loc, Own: LL);				{.CP31}
   VAR HLim, I : LL; H : HashPtr; Cycle: Boolean;
   BEGIN {CoverHash}
      Cycle := False; I := Level;
      While (I > 0) AND NOT Cycle DO Begin
         Cycle := LvlSav[I] = Loc;
         Dec(I);
      End;
      If Not Cycle Then
      Begin
      	If NOT QueLoad
      	Then Inc(ECount) Else
      	Begin
           A.LocLL := Loc;      A.LocOwn := Own;
           A.LocTyp  := cvHash; A.LocLvl := Level;
           Enqueue(A);
      	End;
        If Level < LvlLim Then Inc(Level);
        LvlSav[Level] := Loc;
{$IFDEF TESTDBG}
        If (Loc < UImg^.UHIHT) OR (Loc >= UImg^.UHPMT)
        Then CoverFault(Loc);
        CoverAudit('CoverHash',Loc);
{$ENDIF}
        H := AddrHash(UImg,Loc);
        HLim := (H^.Bas DIV SizeOf(LL));
        FOR I := 0 TO HLim DO
          IF H^.Slt[I] <> 0 THEN CoverName(H^.Slt[I],Own);
        Dec(Level);
      End;
   END; {CoverHash}

Begin {CalcCovers}						{.CP32}
{$IFDEF TESTDBG}
   ReWrite(Audit);
{$ENDIF}
   Level := 0; ECount := 0; QueLoad := False;
   USymbol := '';
   If UImg <> Nil Then
   CoverHash(UImg^.UHDHT,0);               { Debug Rtn Hash Table  }
   DisposeQueue;
   If ECount > 0 Then
   Begin
      CvrLimit := ECount + 2;
      CvrSize  := CvrLimit * SizeOf(CvrRec);
      GetMem(CvrQue,CvrSize);
      If CvrQue <> Nil Then
      Begin
         QueLoad := True;
         A.LocLL  := UImg^.UHIHT;	A.LocOwn := 0;
         A.LocTyp := cvHash; 		A.LocLvl := 0;
         Enqueue(A);
         CoverHash(UImg^.UHDHT,0);
         CoverWrapUp;
      End Else
      Begin
         CvrSize := 0;
         CvrLimit := 0;
      End;
   End;
{$IFDEF TESTDBG}
   Close(Audit);
{$ENDIF}
End;  {CalcCovers}

                                                                {.PA} {
  The following method uses the output of method "CalcCovers" to browse the
  symbol dictionary and discover relations involving the CSeg Map, the PROC
  Map, the Global VAR DSeg Map and the Typed CONST DSeg Map.  The relations
  can involve Fix-Up data, the Trace Table, the Source File List, and the
  various code and data segments contained in the latter part of the unit
  file.  These relations are saved in the heap for later retrieval by the
  print routines.
}

Procedure TUnit.IndexMaps;					{.CP02}
Var NObj: Word;

   { This Procedure computes the size of each }			{.CP39}
   { PROC and adds the result to the Xref map }

   Procedure SizeProcs;
   Var I, J, K : Word; Pc, Pp : MapTabPtr; Rp, Rc : RMapPtr;    
   Begin
      I := 0; K := 0;
      Rp := CvrRMaps[rPROC];		{ Get RMap Proc Pointer }
      If Rp <> Nil Then
      Begin
         Pp := Rp^.RMapTabPtr;		{ Get Proc Ref Pointer }
         J  := Rp^.RMapTabSiz;		{ Get Slot Count       }
      End Else
      Begin Pp := Nil; J := 0 End;
      While (Pp^[K].MapTyp <> mfPDLL) AND (K < J) Do Inc(K);
      If K < J Then J := K;
      Rc := CvrRMaps[rCSEG];			{ Get RMap Cod Pointer }
      If Rc <> Nil
      Then Pc := Rc^.RMapTabPtr			{ Get CSeg Ref Pointer }
      Else Pc := Nil;
      If (J>0) AND (Pc <> Nil) Then
      While I < J-1 Do With Pp^[I] Do Begin
         If Pp^[I].MapCSM <> $FFFF Then
           If Pp^[I].MapCSM = Pp^[I+1].MapCSM
           Then Pp^[I].MapSiz := Pp^[I+1].MapEPT - Pp^[I].MapEPT
           Else Begin
             K := Pp^[I].MapCSM DIV SizeOf(CMapRec);
             Pp^[I].MapSiz := Pc^[K].MapLod + Pc^[K].MapSiz - Pp^[I].MapEPT;
           End;
         Inc(I);
      End;
      If (Pp <> Nil) AND (J>0) Then
      With Pp^[J-1] Do
      If MapCSM <> $FFFF Then
      Begin
         K := MapCSM DIV SizeOf(CMapRec);
         MapSiz := Pc^[K].MapLod + Pc^[K].MapSiz - MapEPT;
      End;
   End; {SizeProcs}

   { This Procedure Initializes the CSeg Xref Map }		{.CP26}
   { and sets CSeg Load Points and Fix-Up Offsets }

   Procedure PrimeCSegs;
   Var Cx, Cn, I, N : Word; D : DMapTabPtr; LBaseC, LBaseD, LBaseF: Word;
       C : CMapTabPtr; P : PMapPtr; Rmt, Rmv : MapTabPtr;
   Begin
      Rmt := CvrRMaps[rCSEG]^.RMapTabPtr;
      N   := CvrRMaps[rCSEG]^.RMapTabSiz;
      Cn  := CountCMapSlots(UImg);
      C   := AddrCMapTab(UImg);
      LBaseC := 0; LBaseD := 0; LBaseF := 0;

      If (C <> Nil) AND (Cn > 0) Then
      For Cx := 0 To Cn-1 Do    { First, we add Info from CSeg  }
      With C^[Cx], Rmt^[Cx] Do  { Map to our CSeg MapRefTab and }
      Begin                     { Calc Fix-Up Offsets           }
         MapTyp := mfCSEG;
         MapSrc := 0;
         MapLod := LBaseC;	{ Save Offset to Load Point	}
         MapSiz := CSegCnt;	{ Save Segment Byte Count	}
         MapFxI := LBaseF;	{ Save Offset to Fix-Ups	}
         MapFxJ := CSegRel;	{ Save Fix-Ups Byte Count	}
         Inc(LBaseC,CSegCnt);
         Inc(LBaseF,CSegRel);
      End;

      { Similarly for Typed Constant Data Segments }		{.CP52}

      Rmv := CvrRMaps[rCONS]^.RMapTabPtr;
      N   := CvrRMaps[rCONS]^.RMapTabSiz;
      D   := AddrDMapTab(UImg);

      LBaseF := 0;
      If D <> Nil Then
      For Cx := 0 To N-1 Do     { First, we add Info from DSeg  }
      With D^[Cx], Rmv^[Cx] Do  { Map to our DSeg MapRefTab and }
      Begin                     { Calc Fix-Up Offsets           }
         MapSrc := 0;
         MapSiz := DSegCnt;
         MapLod := LBaseD;
         MapFxI := LBaseF;
         MapFxJ := DSegRel;
         Inc(LBaseD,DSegCnt);
         Inc(LBaseF,DSegRel);
         If DSegOwn <> 0 Then
         Begin MapOwn := DSegOwn; MapTyp := mfTVMT End;
      End;

      { Now, we do a similar job for the PROC Map }

      Rmv := CvrRMaps[rPROC]^.RMapTabPtr;
      N   := CvrRMaps[rPROC]^.RMapTabSiz;
      P   := AddrPMapTab(UImg);

      If P <> Nil Then
      For Cx := 0 To N-1 Do
      With P^[Cx], Rmv^[Cx] Do
      Begin
         MapCSM := CSegOfs;
         MapEPT := CSegJmp;
         MapSrc := 0;
         If Odd(ProcWd2 SHR 2) Then	{ We Have a DLL Entry }
         Begin
	    MapTyp := mfPDLL;
            MapNdx := CSegJmp;
            MapSrc := CSegOfs;
            MapDLL := ProcWd2;
         End Else
         If MapCSM <> $FFFF Then
         Begin
            MapTyp := mfPROC;
            I := MapCSM DIV SizeOf(CMapRec);
            MapEPT := MapEPT + Rmt^[I].MapLod;  { Relocate Entry Point }
         End;
         If Cx = 0 Then MapTyp := mfPRUI; { flag unit init code }
      End;

   End; { PrimeCSegs }

   { This Proc updates the CSeg Xref Table with data from the }	{.CP58}
   { Trace and PROC Tables that allow us to determine which   }
   { source file furnished the CSeg for the map entry.        }

   Procedure FinalCSegs;
   Var Nc, I, Np, Sf, Sn: Word;
       Ps, Ph: SrcFilePtr; Pt: TraceRecPtr; PRc, PRp: MapTabPtr;
   Begin
      Ps := AddrSrcTabOff(UImg,0); Ph := Ps;	{ Source File List }
      Sf := 0; Sn := 0;  			{ Total Src, non-Obj Files }
      While Ps <> Nil Do Begin
         Inc(Sf);                               { Inc Total Source Files }
         If Ps^.SrcFlag <> $05 Then Inc(Sn);    { Inc Non-Obj File Count }
         Ps := AddrNxtSrc(UImg,Ps);             { point to next src ntry }
      End;
      NObj := Sf - Sn; { Total *.OBJ Files }      Ps := Ph; { Restore Ps }

      If (NObj > 0) AND (CvrRMaps[rCSEG] <> Nil) Then { have *.OBJ's in lst }
      Begin
         PRc:= CvrRMaps[rCSEG]^.RMapTabPtr;
         Nc := CvrRMaps[rCSEG]^.RMapTabSiz;
         For I := 1 to Sn Do Ps := AddrNxtSrc(UImg,Ps);
         For I := (Nc-NObj) To Nc-1 Do
         With PRc^[I] Do Begin
            MapSrc := FormLL(Ph,Ps);
            Ps := AddrNxtSrc(UImg,Ps);
         End;           { *.OBJ Handler }

      { If Pascal Include Files are present, Only the Trace Table Knows }
      { and this is noted only if these files contain PROCs.  This can  }
      { be used to get the source file (actual) in these cases.  Scan   }
      { the trace table and compare its PROC pointer with PROC Name LL  }
      { in our PROC Ref table.  If match, then trace entry has source   }
      { info that applies to this proc (which is part of some CSeg) and }
      { the PROC Ref entry has the CSeg Map Offset which we use to make }
      { the linkage to our CSeg Ref table to save source file offset.   }

         Pt := AddrTraceTab(UImg);
         If CvrRMaps[rPROC] <> Nil Then If Nc > 0 Then
         Begin
            PRp := CvrRMaps[rPROC]^.RMapTabPtr;
            Np  := CvrRMaps[rPROC]^.RMapTabSiz;
            While Pt <> Nil Do With Pt^ Do Begin      {For ALL Trace Entries}
               I := 0;
               While I < Np Do With PRp^[I] Do Begin  {For ALL PROC Entries }
                  If MapTyp <> mfPDLL Then
                  If MapOwn = Trname Then             {Proc has Trace Entry }
                  Begin
                     PRc^[MapCSM DIV SizeOf(CMapRec)].MapSrc := Trfill;
                     I := Np;   {quit loop and try next trace entry}
                  End;
                  Inc(I);
               End;
               Pt := AddrNxtTrace(UImg,Pt);
            End;
         End;
      End;
   End;  {FinalCSegs}

   { This Procedure updates the CONST Xref Table with data from   }{.CP54}
   { various sources to get offsets to Fix-Up data and to try to  }
   { locate the file in the Source File List that contributed     }
   { this entry.  Any entry NOT defined in the Pascal Source will }
   { have mfNULL as its MapTyp.  We will change such entries to   }
   { mfXTRN and try to decide who spawned them.  This problem is  }
   { strictly undecidable.  We can guess that a Fix-Up in some    }
   { CSeg that references our entry is from the *.OBJ spawned the }
   { block, but that is the closest we can get to the truth.      }

   Procedure FinalCONST;
   Var I, N : Word; HaveXtrn : Boolean; Rmt : MapTabPtr;
   	LBaseD, LBaseF: Word; Pt : TypePtr;
   Begin
      If CvrRMaps[rCONS] <> Nil Then
      Begin
         Rmt := CvrRMaps[rCONS]^.RMapTabPtr;
      	 N   := CvrRMaps[rCONS]^.RMapTabSiz;
      	 HaveXtrn := False;
         LBaseD := 0; LBaseF := 0;

      	 If (N > 0) AND (Rmt <> Nil) Then
      	 Begin
            For I := 0 To N-1 Do With Rmt^[I] Do
            Case MapTyp of

	       mfNULL:
               		If NObj > 0 Then
               		Begin
                  	   MapTyp := mfXTRN;
              		   HaveXtrn := True;
               		End;

               mfTVMT:
               		Begin
                           Pt := TypePtr(PtrAdjust(UImg,MapOwn));
                           If Pt <> Nil Then
                           If Pt^.ObjtDMTp = MapOfs
                           Then MapTyp := mfTDMT;
                	End;
            End; {Case}         { Fix-Up Offsets are now set }
            { Source File problem deferred until later }
      	 End;
      End;

      If CvrRMaps[rVARS] <> Nil Then
      Begin
      	Rmt := CvrRMaps[rVARS]^.RMapTabPtr;  { Classify VARS Too }
      	N   := CvrRMaps[rVARS]^.RMapTabSiz;
      	If (N > 0) AND (Rmt <> Nil) AND (NObj > 0)
	Then For I := 0 To N-1 Do With Rmt^[I] Do
             If MapTyp = mfNULL Then MapTyp := mfXTRN
      End;
   End;  {FinalCONST}

Var I, J, DHT, IHT : Word; C : Char;				{.CP29}
    Pn : DNamePtr; Ps : DStubPtr; Pv : VarStubPtr; Pm: RMapPtr;
    Pp : PMapRecPtr; Tc, Tv, Td : DMapRecPtr; V : CvrRec; Q, Qc : MapRefRec;
                     Ndx : MapClass; SystemUnit, InINTF : Boolean;
Begin {IndexMaps}

   For Ndx := rPROC To rCONS Do
       If CvrRMaps[Ndx] <> Nil Then CvrRMaps[Ndx]^.Done;

   CvrRMaps[rCONS] := New(RMapPtr,Init(UImg^.UHDMT-UImg^.UHTMT));
   CvrRMaps[rVARS] := New(RMapPtr,Init(UImg^.UHDLL-UImg^.UHDMT));
   CvrRMaps[rPROC] := New(RMapPtr,Init(UImg^.UHCMT-UImg^.UHPMT));
   CvrRMaps[rCSEG] := New(RMapPtr,Init(UImg^.UHTMT-UImg^.UHCMT));

   DHT        :=  UImg^.UHDHT; IHT := UImg^.UHIHT;
   SystemUnit :=  IsSystemUnit(UImg);

 (*  If CvrRMaps[rCSEG]^.RMapTabSiz > 0 { Initialize CSeg Map Refs }
   Then *) PrimeCSegs;

   For I := 1 To CvrQueTail Do Begin    { Get CONST/VAR Mapping }
      V := CvrQue^[I];
      If V.LocTyp = cvName Then
      Begin
         Tc := Ptr(Seg(UImg^),Ofs(UImg^)+UImg^.UHTMT); { CONS Map }
         Tv := Ptr(Seg(UImg^),Ofs(UImg^)+UImg^.UHDMT); { DSeg Map }
         Pn := Ptr(Seg(UImg^),Ofs(UImg^)+V.LocLL);
         Ps := AddrStub(Pn);  C := Public(Pn^.DForm);

         If C = 'R' Then    { a data instance of some kind }	{.CP37}
         Begin
            If Ps^.sRAM < $02 Then { a global variable or typed const }
            Begin
               Pv := @Ps^.sRVF;
               J := Pv^.TOB;
               InINTF := (IHT = DHT) OR SystemUnit OR (DHT > V.LocLL);

               If Ps^.sRAM = $00 Then
               Begin				{ it's a Global Variable }
                  Pm := CvrRMaps[rVARS];
                  Pm^.FetchRef(Q,Pv^.TOB);
                  Td := Ptr(Seg(Tv^),Ofs(Tv^)+J);
                  Q.MapSiz := Td^.DSegCnt;
                  If InINTF Then Q.MapTyp := mfINTF
                            Else Q.MapTyp := mfIMPL;
                  Pm^.StoreRef(Q,Pv^.TOB);
               End Else
               Begin				{ it's a Typed Constant  }
                  Pm := CvrRMaps[rCONS];
                  Pm^.FetchRef(Q,Pv^.TOB);
                  Td := Ptr(Seg(Tc^),Ofs(Tc^)+J);
                  If Td^.DSegOwn <> 0 Then Begin
                     Q.MapTyp := mfTVMT;
                     Q.MapOwn := Td^.DSegOwn;   { Owner is OBJECT Name  }
                  End Else
                  If V.LocLvl = 1
		  Then If InINTF Then Q.MapTyp := mfINTF
		  		 Else Q.MapTyp := mfIMPL
                  Else Begin
                     Q.MapTyp := mfNEST;
                     Q.MapOwn := V.LocOwn;      { Owner is PROC scope   }
                  End;
                  Pm^.StoreRef(Q,Pv^.TOB);
               End;   { Typed Constant    }
            End;      { Variable/Constant }
         End          { Type 'R' Stub     }

         Else                             { Check for PROC Map } {.CP20}
         If C = 'S' Then                  { It's a PROC ...... }
         If (Ps^.sSTP AND $02) = 0 Then   { ... AND NOT INLINE }
         Begin
            Pm := CvrRMaps[rPROC];        { Get Method Pointer }
            Pm^.FetchRef(Q,Ps^.sSPM);
            Q.MapOwn := V.LocLL;         { Get PROC Name Offset }
            Pm^.StoreRef(Q,Ps^.sSPM);
         End;  { Type 'S' Stub }
      End;     { DName Entry   }
   End;        { FOR           }

   If CvrRMaps[rCSEG]^.RMapTabSiz > 0 Then FinalCSegs; { Finish CSeg Refs }

   CvrRMaps[rPROC]^.SortPMap(CSegOrder);  	{ Sort PROCS in Load Order }
   SizeProcs;				  	{ Get Proc Size(Bytes)  }
   CvrRMaps[rPROC]^.SortPMap(PMapOrder);  	{ Sort PROCS in PMap Order }
   If CvrRMaps[rCONS] <> Nil Then FinalCONST;	{ Finish CONST Refs }

End; {IndexMaps}

      (*   E N D    M E T H O D S   *)

Function FindCover(U : UnitPtr) : TUnitPtr;			{.CP11}
Var S : TUnitPtr;
Begin
   FindCover := Nil; S := LstRoot;
   While S <> Nil Do
     If S^.UImg <> U Then S := S^.Link Else
     Begin
        FindCover := S;
        S := Nil
     End;
End; {FindCover}

  { Procedure Below Traps Pointer Violations }			{.CP07}

PROCEDURE CheckPtrs(U, V: Pointer);
BEGIN
	IF (U = Nil) OR (V = Nil) OR (Seg(U^) <> Seg(V^))
	THEN RunError(215);
END; {CheckPtrs}

  { Function Below Computes an LL from two Pointers }		{.CP09}

FUNCTION  FormLL(Base, Ceil: Pointer): LL;
BEGIN
	CheckPtrs(Base,Ceil);
	IF Ofs(Base^) > Ofs(Ceil^)
		THEN FormLL := LL(Ofs(Base^)-Ofs(Ceil^))
		ELSE FormLL := LL(Ofs(Ceil^)-Ofs(Base^));
END;

  { Function Below Checks to See if Unit Name is "SYSTEM" }	{.CP06}

FUNCTION  IsSystemUnit(U: UnitPtr): Boolean;
BEGIN
   IsSystemUnit := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH))^.DSymb = 'SYSTEM'
END;

  { Function Finds The Stub Belonging to a Dictionary Header }	{.CP08}

FUNCTION  AddrStub(Arg: DNamePtr): DStubPtr;
CONST PrefixSize = SizeOf(LL)+SizeOf(Char) + 1;
BEGIN
  If Arg = Nil Then AddrStub := Nil Else
  AddrStub := PtrAdjust(Arg,PrefixSize + Ord(Arg^.DSymb[0]))
END;

  { Function Below Gets Pointer to Hash Table }                  {.CP07}

FUNCTION  AddrHash(U: UnitPtr; Hash: LL): HashPtr;
BEGIN
   If U = Nil Then AddrHash := Nil Else
   AddrHash := HashPtr(PtrAdjust(U,Hash))
END;

  { Function Below Gets Pointer to Dictionary Entry using LL }   {.CP04}

FUNCTION  AddrDict(U: UnitPtr; Hash: LL): DNamePtr;
BEGIN
   If U = Nil Then AddrDict := Nil Else
   AddrDict := DNamePtr(PtrAdjust(U,Hash))
END;

  { Function Below Gets Pointer to Type Descriptor if Local to Unit } {.CP15}

FUNCTION  AddrType(U: UnitPtr; TypeLG: LG): TypePtr;
VAR D:DNamePtr; S: DStubPtr; R: LL;
BEGIN
   AddrType := Nil;
   If U <> Nil Then
   Begin
	D := AddrDict(U,U^.UHUDH);      {point to our unit DE}
	S := AddrStub(D);               {point to its stub   }
	R := FormLL(U,S);               {get offset to stub  }
	IF R = TypeLG.UntId             {if offset matches   }
	THEN AddrType := TypePtr(PtrAdjust(U,TypeLG.UntLL));
   End;
END;

{ Function Below Gets Pointer to Unit Descriptor for Type via LG } {.CP21}

FUNCTION  AddrLGUnit(U: UnitPtr; TypeLG: LG): DNamePtr;
VAR D: DNamePtr; S: DStubPtr; R: LL;
BEGIN
	D := AddrDict(U,U^.UHUDH);      {point to our unit hdr}
	S := AddrStub(D);               {point to our stub    }
	R := FormLL(U,S);               {get offset to stub   }
	IF (R <> 0) THEN
	IF (TypeLG.UntID <> R) THEN     {if offsets don't match }
	REPEAT
	   D := AddrDict(U,S^.sYNU);            {chain to next DE}
	   IF D^.DForm <> 'Y' THEN R := 0 ELSE  {if next is unit }
	   BEGIN
	     S := AddrStub(D);                  {its stub address}
	     R := FormLL(U,S);                  {and stub offset }
	   END;
	UNTIL (R = TypeLG.UntID) OR (R = 0);    {match of end list  }
	IF R <> 0 THEN AddrLGUnit := D          {we had a match     }
	          ELSE AddrLGUnit := Nil;       {we couldn't find it}
END;

  { Function Below Gets Pointer to Procedure Stub Type Descriptor }{.CP07}

FUNCTION  AddrProcType(S: DStubPtr): TypePtr;
BEGIN
   If S = Nil Then AddrProcType := Nil Else
   AddrProcType := TypePtr(PtrAdjust(@S^.sSVM,SizeOf(S^.sSVM)))
END;

  { Function Below Gets Pointer to Next Entry in Source File List } {.CP21}

FUNCTION  AddrNxtSrc(U: UnitPtr; Arg: SrcFilePtr): SrcFilePtr;
VAR J: LL;  S: SrcFilePtr;
BEGIN
	J := 0;
	IF (U = Nil) OR (Arg = Nil) THEN AddrNxtSrc := Nil ELSE
	BEGIN
	   J := FormLL(U,Arg);
	   IF J < U^.UHLSF
	   THEN AddrNxtSrc := Nil ELSE
	   IF NOT (J < U^.UHDBT)
	   THEN AddrNxtSrc := Nil ELSE
	   BEGIN
	      S := SrcFilePtr(PtrAdjust(Arg,8 + Ord(Arg^.SrcName[0])));
	      IF FormLL(U,S) < U^.UHDBT
	      THEN AddrNxtSrc := S
	      ELSE AddrNxtSrc := Nil
	   END
	END
END;

  { Function Below Gets Pointer to Source File List Entry at Offset }{.CP09}

FUNCTION  AddrSrcTabOff(U: UnitPtr; Offset: Word): SrcFilePtr;
BEGIN
   AddrSrcTabOff := Nil;
   If U <> Nil Then WITH U^ DO
   IF (UHLSF+Offset) < UHDBT
   THEN AddrSrcTabOff := SrcFilePtr(PtrAdjust(U,UHLSF+Offset));
END;

  { Function Below Gets Pointer to Next Entry in DLL List }	{.CP21}

FUNCTION  AddrNxtDLL(U: UnitPtr; Arg: DLLPtr): DLLPtr;
VAR J: LL;  S: DLLPtr;
BEGIN
	J := 0;
	IF (U = Nil) OR (Arg = Nil) THEN AddrNxtDLL := Nil ELSE
	BEGIN
	   J := FormLL(U,Arg);
	   IF J < U^.UHDLL
	   THEN AddrNxtDLL := Nil ELSE
	   IF NOT (J < U^.UHLDU)
	   THEN AddrNxtDLL := Nil ELSE
	   BEGIN
	      S := DLLPtr(PtrAdjust(Arg,5 + Ord(Arg^.DLLMod[0])));
	      IF FormLL(U,S) < U^.UHLDU
	      THEN AddrNxtDLL := S
	      ELSE AddrNxtDLL := Nil
	   END
	END
END;

  { Function Below Gets Pointer to DLL List Entry at Offset }	{.CP09}

FUNCTION  AddrDLLTabOff(U: UnitPtr; Offset: Word): DLLPtr;
BEGIN
   AddrDLLTabOff := Nil;
   If U <> Nil Then WITH U^ DO
   IF (UHDLL+Offset) < UHLDU
   THEN AddrDLLTabOff := DLLPtr(PtrAdjust(U,UHDLL+Offset));
END;

  { Function Counts Number of Slots in PROC Map Table }		{.CP06}

FUNCTION  CountPMapSlots(U: UnitPtr): Integer;
BEGIN
	CountPMapSlots := (U^.UHCMT-U^.UHPMT) DIV SizeOf(PMapRec);
END;

  { Function Gets Address of PROC Map Table }			{.CP08}

FUNCTION  AddrPMapTab(U: UnitPtr): PMapPtr;
BEGIN
	IF CountPMapSlots(U) > 0
	THEN AddrPMapTab := PMapPtr(PtrAdjust(U,U^.UHPMT))
	ELSE AddrPMapTab := Nil
END;

  { Function Counts Number of Slots in CSeg Map Table }		{.CP06}

FUNCTION  CountCMapSlots(U: UnitPtr): Integer;
BEGIN
	WITH U^ DO CountCMapSlots := (UHTMT-UHCMT) DIV SizeOf(CMapRec);
END;

  { Function Gets Address of CSeg Map Table }			{.CP08}

FUNCTION  AddrCMapTab(U: UnitPtr): CMapTabPtr;
BEGIN
	IF CountCmapSlots(U) > 0
	THEN AddrCMapTab := CMapTabPtr(PtrAdjust(U,U^.UHCMT))
	ELSE AddrCMapTab := Nil
END;

  { Function Counts Number of DSeg Map Slots }			{.CP06}

FUNCTION  CountDMapSlots(U: UnitPtr): Integer;
BEGIN
	WITH U^ DO CountDMapSlots := (UHDMT - UHTMT) DIV SizeOf(DMapRec)
END;

  { Function Gets Address of DSeg Map Table }			{.CP08}

FUNCTION  AddrDMapTab(U: UnitPtr): DMapTabPtr;
BEGIN
	IF CountDMapSlots(U) > 0
	THEN AddrDMapTab := DMapTabPtr(PtrAdjust(U,U^.UHTMT))
	ELSE AddrDMapTab := Nil
END;

  { Function Below Gets Pointer to 1st Trace Table Entry or Nil }  {.CP08}

FUNCTION  AddrTraceTab(U: UnitPtr): TraceRecPtr;
BEGIN
	IF U^.UHDBT = U^.UHZDA
	THEN AddrTraceTab := Nil
	ELSE AddrTraceTab := TraceRecPtr(PtrAdjust(U,U^.UHDBT))
END; {AddrTraceTab}

   { Function Below Gets Byte Count in TrExec Array }		{.CP20}

FUNCTION GetTrExecSize(T: TraceRecPtr): Integer;
VAR i,k : Integer;
BEGIN
   IF T = Nil THEN GetTrExecSize := 0 ELSE
   BEGIN
      k := T^.TrLNos;                   {number of lines in array}
      i := 1;                           {prime scan line number  }
      WHILE i <= k DO BEGIN             {still have lines to test}
         IF T^.TrExec[i] = $80 THEN     {if "escape byte" present}
	 BEGIN
	   Inc(k);                      {bump array limit        }
	   Inc(i)                       {bump to byte count slot }
	 END;
	 Inc(i)                         {check next slot         }
      END;
      GetTrExecSize := k;               {final byte count        }
   END;
END;

  { Function Below Gets Pointer to next Trace Table Entry or Nil }  {.CP14}

FUNCTION  AddrNxtTrace(U: UnitPtr; T: TraceRecPtr): TraceRecPtr;
VAR k : Integer;
BEGIN
	IF T = Nil THEN AddrNxtTrace := Nil ELSE
	BEGIN
		k := GetTrExecSize(T);
		T := TraceRecPtr(PtrAdjust(@T^.TrExec[1],LL(k)));
		IF FormLL(U,T) >= U^.UHZDA
			THEN AddrNxtTrace := Nil
			ELSE AddrNxtTrace := T
	END
END; {AddrNxtTrace}

  { Function Below Gets Pointer to 1st Fixup Table Entry or Nil }  {.CP17}

Type FixClass = (CodeFix, DataFix);

FUNCTION  AddrFixUps(U: UnitPtr; C: FixClass): FixUpPtr;
VAR j : Word; S: TUnitPtr;
BEGIN
	S := FindCover(U);
        If S <> Nil Then
	Begin
           Case C Of
             CodeFix: AddrFixUps := FixUpPtr(S^.UFXC);
             DataFix: AddrFixUps := FixUpPtr(S^.UFXD);
             Else     AddrFixUps := Nil;
           End
	End  Else     AddrFixUps := Nil;
END; {AddrFixUps}

Function AddrCodeFixUps(U: UnitPtr): FixUpPtr;			{.CP02}
Begin    AddrCodeFixUps := AddrFixUps(U,CodeFix); End;

Function AddrDataFixUps(U: UnitPtr): FixUpPtr;			{.CP02}
Begin    AddrDataFixUps := AddrFixUps(U,DataFix); End;

Function AddrCodeArea(U: UnitPtr): Pointer;			{.CP06}
Var S: TUnitPtr;
Begin
    S := FindCover(U);
    If S <> Nil Then AddrCodeArea := S^.UCod Else AddrCodeArea := Nil
End;

Function AddrDataArea(U: UnitPtr): Pointer;			{.CP06}
Var S: TUnitPtr;
Begin
    S := FindCover(U);
    If S <> Nil Then AddrDataArea := S^.UDta Else AddrDataArea := Nil
End;

PROCEDURE SortProcRefs(Mode: SortMode);				{.CP06}
Begin
   If LstRoot <> Nil Then
   If LstRoot^.CvrRMaps[rPROC] <> Nil
   Then LstRoot^.CvrRMaps[rPROC]^.SortPmap(Mode);
End;

PROCEDURE FetchMapRef  (VAR S : MapRefRec;			{.CP10}
			  C   : MapClass;
			Offset: Word);
Var Q : TUnitPtr;
Begin
   Q := LstRoot; S := NullMap;
   If Q <> Nil Then
   If Q^.CvrRMaps[C] <> Nil
   Then Q^.CvrRMaps[C]^.FetchRef(S,Offset);
End;

PROCEDURE FetchSurveyRec (VAR S : SurveyRec);			{.CP18}
Var Q : CvrRec;
Begin
   S.LocTyp := cvNULL; S.LocLL  := 0; S.LocOwn := 0; S.LocNxt := 0;
   If LstRoot <> Nil Then With LstRoot^ Do
   If UImg <> Nil    Then If CvrQue <> Nil Then
   Begin
      If CvrQueHead < CvrQueTail Then
      Begin
         Inc(CvrQueHead);
         Q := CvrQue^[CvrQueHead];
         S.LocTyp := Q.LocTyp; S.LocLL  := Q.LocLL;
         S.LocOwn := Q.LocOwn; S.LocNxt := UImg^.UHPMT
      End;
      If CvrQueHead < CvrQueTail
      Then S.LocNxt := CvrQue^[CvrQueHead+1].LocLL;
   End;
End; {FetchSurveyRec}

Procedure PurgeAllUnits;					{.CP12}
Var P, Q: TUnitPtr;
Begin
   P := Nil; Q := LstRoot;
   While Q <> Nil Do
   Begin
      P := Q^.Link;
      Q^.Done;
      Q := P;
   End;
   LstRoot := Nil;
End; {PurgeAllUnits}

Function FindUnit(N: _UnitName) : UnitPtr;			{.CP12}
Var P : TUnitPtr; U : UnitPtr;
Begin
   U := Nil; P := LstRoot;
   While P <> Nil Do
      If P^.Name <> N Then P := P^.Link Else
      Begin
         U := P^.UImg;
         P := Nil
      End;
   FindUnit := U;
End;

PROCEDURE SurveyUnit(U : UnitPtr);				{.CP11}
Var S : TUnitPtr;
BEGIN  {SurveyUnit}
   S := FindCover(U);		{ Locate Proper TUnit     }
   If S <> Nil Then
   Begin
	S^.CalcCovers;		{ Analyze Dictionary      }
	If S = LstRoot Then	{ If Initial Unit Then    }
	   S^.IndexMaps;	{ Cross-Index All Maps    }
   End;
END;   {SurveyUnit}

PROCEDURE ResolveLG(N: _UnitName; L: LG; VAR R: RespLG);	{.CP19}
Var S : RespLG; U : UnitPtr; T : TUnitPtr; Q: CvrPtr;
    W : Word;
Begin
   S.Uptr := Nil; S.Ownr := $FFFF; U := FindUnit(N);
   If U <> Nil Then
   Begin
      T := FindCover(U);
      W := T^.QueuePos(L.UntLL);
      Q := T^.CvrQue;
      If NOT (W > T^.CvrQueTail) Then
      If L.UntLL = Q^[W].LocLL Then
      Begin
         S.Uptr := U;
	 S.Ownr := Q^[W].LocOwn;
      End;
   End;
   R := S;
End;  { ResolveLG }

Var LoaderPath: _FileXpnd;

Procedure UnitLoader(	Path : Dos.PathStr;			{.CP12}
			Name : _UnitName;
			Optn : UnitMode;
		    VAR Core : Word;
		    VAR Locn : UnitPtr);
VAR  SaveMode,UnitVersion : Word;	U : UnitPtr;
     FileId   : _FileSpec;
     FileDir  : Dos.DirStr;	FileName : Dos.NameStr;
     FileExtn : Dos.ExtStr;	FilePath : Dos.PathStr;
     WorkArea : Array[0..3] Of _Paragraph;
     UnitFile : File;		EnvirPth : String;
     Z : LdrVec;

     Function UnitSize( U : UnitPtr) : LongInt;			{.CP25}
     VAR EyeBall : String[4]; I : Byte; Total : LongInt;
     Begin
        For I := 1 To 5 Do Begin
	  Z[I].LdrUpt := Nil; Z[I].LdrSiz := 0;
        End;
        Total := 0;
        EyeBall[0] := Chr(SizeOf(EyeBall)-1);
        Move(U^,EyeBall[1],SizeOf(EyeBall)-1);
        If EyeBall = _UnitEye Then
	Begin
	   Z[1].LdrSiz := (U^.UHZDA+$F) AND $FFF0; { ENTIRE Dictionary Size }
           Z[2].LdrSiz := (U^.UHZCS+$F) AND $FFF0; { Size: All CSegs 	    }
           Z[3].LdrSiz := (U^.UHZDT+$F) AND $FFF0; { Size: All Typed CONSTS }
           Z[4].LdrSiz := (U^.UHZFA+$F) AND $FFF0; { Size: All CSeg Fix-Ups }
           Z[5].LdrSiz := (U^.UHZFT+$F) AND $FFF0; { Size: All CONS Fix-Ups }
           For I := 1 To 5 Do Inc(Total,Z[I].LdrSiz);	{ Calc Unit Size }
           If Optn = Partial Then
	   Begin
	      Z[1].LdrSiz := (U^.UHPMT+$F) AND $FFF0 ;	{ Dictionary Size   }
              For I := 2 To 5 Do Z[I].LdrSiz := 0; 	{ Skip rest of unit }
           End;
        End;
        UnitSize := Total;		{ Return Total Actual Size of Unit }
     End; {UnitSize}

     Function FileExists( N : _FileSpec) : Boolean;		{.CP12}
     Begin
        FilePath := FSearch(N,EnvirPth);
        If FilePath <> '' Then
        Begin
           FilePath := FExpand(FilePath);
           FSplit(FilePath,FileDir,FileName,FileExtn);
           FileId := N;
           FileExists := True
        End
        Else FileExists := False;
     End; {FileExists}

     Procedure OpenUnitFile(P : Dos.PathStr; N : _FileSpec);	{.CP08}
     Begin
        Assign(UnitFile,P+N);
        SaveMode := FileMode;
        FileMode := 0;
        Reset(UnitFile,SizeOf(_Paragraph));
        FileMode := SaveMode;
     End;

     Procedure InstallUnit(Z: LdrVec; N : _UnitName);		{.CP18}
     Var Sk, Sr : Word; T, V : TUnitPtr;
     Begin
        T := New(TUnitPtr,Init(N,Z));			{ build placeholder }
        If T <> Nil Then
        Begin
           If LstRoot = Nil
           Then LstRoot := T Else			{ add to chain	    }
           Begin
              V := LstRoot;
              While V^.Link <> Nil Do V := V^.Link;
              V^.Link := T;
           End;
           LoaderPath := FileDir+FileId;
           Core := Sk;             { Say How Much of Unit Loaded }
           Locn := T^.UImg;        { Point to Unit Load Address  }
        End;
     End; {InstallUnit}

Procedure CheckLibrary(N: _UnitName);				{.CP17}
Var I: Word; Su, Sf, Fp, Tp: LongInt;
    U: UnitPtr; Ps: DStubPtr; Pn: DNamePtr; U1: Pointer;

    Function FetchUnitSegment(Posn: LongInt; BytCnt: Word): Pointer;
    Var Pf : Pointer;
    Begin
        Pf := Nil;
        If (Sf > 0) AND (BytCnt > 0) Then
        Begin
    	   Seek(UnitFile,Posn);
           GetMem(Pf,BytCnt);
           If Pf <> Nil
	   Then BLockRead(UnitFile,Pf^,BytCnt SHR 4);
        End;
        FetchUnitSegment := Pf;
    End;
Begin {CheckLibrary}						{.CP43}
    OpenUnitFile(FileDir,FileId);	{ Open the File 	}
    Sf := FileSize(UnitFile);		{ Get File Size (rcds)	}
    Fp := 0;				{ File Pointer = 0	}
    While Fp < Sf Do Begin		{ Browse the Library	}

    	Seek(UnitFile,Fp);              	{ Locate Unit	}
        BlockRead(UnitFile,WorkArea,4);		{ Read Header	}
        U := @WorkArea;				{ Point to it	}
        Su := UnitSize(U);		{ Get Unit Size - Bytes }
        If Su > 0 Then				{ If Unit <> Nil}
	Begin
            Z[1].LdrUpt := FetchUnitSegment(Fp,Z[1].LdrSiz);
            If Z[1].LdrUpt <> Nil Then
            Begin
	       Tp := Z[1].LdrSiz SHR 4 + Fp;
               U  := UnitPtr(Z[1].LdrUpt);

               Pn := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH));
               Ps := AddrStub(Pn);

               { Check name for match, if nested check for version match }

               If (N <> Pn^.DSymb) OR
            	  ((Optn = Partial) AND (Ps^.sYCS <> UnitVersion)) Then
               Begin
                  FreeMem(U,Z[1].LdrSiz);	{ Wrong Unit / Version }
                  Inc(Fp,Su SHR 4);
               End Else
               Begin				{ load remaining segments }
                  For I := 2 To 5 Do Begin
                     U := FetchUnitSegment(Tp,Z[I].LdrSiz);
                     If U <> Nil Then Tp := Z[I].LdrSiz SHR 4 + Tp;
                     If U <> Nil Then Z[I].LdrUpt := U;
                  End;
                  InstallUnit(Z,N);
                  Fp := Sf		{ terminates browse process }
               End;
            End
        End Else Fp := Sf;		{ skip out if invalid unit  }
    End;
    Close(UnitFile);
End; {CheckLibrary}

VAR  I : Word;							{.CP12}
Begin {UnitLoader}
   UnitVersion := Core;
   Core := 0;
   Locn := Nil;
   LoaderPath := '';
   If Path = ''
     Then EnvirPth := GetEnv('PATH')
     Else EnvirPth := Path;
   If FileExists(Name+'.TPU')	Then CheckLibrary(Name) Else
   If FileExists(_Lib_Nam)	Then CheckLibrary(Name);
End;  {UnitLoader}

Function AnalyzeUnit(Name: _UnitName; Path: String): UnitPtr;	{.CP36}

Var U, Z: UnitPtr; N: DNamePtr; S: DStubPtr; USize: Word;
Begin
   UnitLoader(Path,Name,Entire,USize,U);	{ Load Entire  Unit }
   AnalyzeUnit := U;				{ Save Unit Pointer }
   If U <> Nil Then
   Begin
      PutTxt('Unit ('+Name+')');
      SetCol(17);
      PutTxt(' loaded from '+LoaderPath);
      SetCol(1);
      SurveyUnit(U);				{ Analyze Unit }
      Base_Code   := (U^.UHZDA + $F) AND Masker;
      Base_Data   := (U^.UHZCS + $F) AND Masker + Base_Code;
      Base_FixC   := (U^.UHZDT + $F) AND Masker + Base_Data;
      Base_FixD   := (U^.UHZFA + $F) AND Masker + Base_FixC;
      N := DNamePtr(PtrAdjust(U,U^.UHUDH));	{ Point to its name }
      S := AddrStub(N);				{ Point to its stub }
      While S^.sYNU <> 0 Do			{ if successor unit }
      Begin
         N := DNamePtr(PtrAdjust(U,S^.sYNU));	    { Point to Name }
         S := AddrStub(N);			    { Point to Stub }
         USize := S^.sYCS;			    { Load Version  }
         UnitLoader(Path,N^.DSymb,Partial,USize,Z); { Load Partial  }
         If Z <> Nil Then
	 Begin
	    PutTxt('Unit ('+N^.DSymb+')');
	    SetCol(17);
	    PutTxt(' loaded from '+LoaderPath);
            SetCol(1);
	    SurveyUnit(Z);	    	{ Get its Cover }
         End;
      End;				{ Until all Units Handled }
   End;
End; {AnalyzeUnit}

{$IFDEF TESTDBG}						{.CP07}
Begin
   ExitSave := ExitProc;
   ExitProc := @MyExit;
   Assign(Audit,'Audit.Lst');
{$ENDIF}
END.