home *** CD-ROM | disk | FTP | other *** search
- {$D+,L+,S+,R-,E-,N-}
- Unit tpu6ref;
-
- { This Unit performs the analysis functions required to interpret and to
- provide a print-out of the UNIT which reveals its meaning. Included is
- the support to identify and delineate the structures found in the main
- symbol dictionary as well as a collection of information about relations
- which may exist between generated code, constant and BSS data. These are
- obviously extremely interesting to the "Smart-Linker".
-
- The dictionary is unraveled by a non-recursive algorithm which follows
- dictionary pointers until all targets have been identified. This data
- is relevant to the generated code, constant and BSS data as well. This
- unit utilizes Objects in its implementation but they aren't visible to the
- calling program. All structures maintained by this unit are private and
- allocated on the heap. Great care is exercised to minimize utilization
- of heap storage. The initial dictionary survey allocates sufficient heap
- storage to complete its task. It then truncates the allocation to exactly
- the amount of storage that must be retained. The caller can instruct this
- unit to de-allocate its stored data at any time. Any number of units can
- be analyzed (limited only by heap space) since the data for each unit is
- managed by a master Object intended for just that purpose.
-
- The dictionary analysis may be retrieved sequentially. The Map analyses
- may be retrieved randomly. The PROC Map analysis may be sorted into two
- distinct sequences for specialized retrieval problems.
-
- These functions are encapsulated in this unit to dissociate them from the
- very low-level functions of the other units and from the main program.
-
- The program is drifting toward this more modular functional organization
- to ease maintenance and to better support the concept of re-usability.
-
- The PRIMARY emphasis here is on safety - not speed - although at least
- one of the routines was speeded-up via inline assembler.
-
- }
-
- (*****************) {.CP47}
- (**) Interface (**) Uses TPU6AMS;
- (*****************)
-
- 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 SurveyUnit (U : UnitPtr); { Performs Analysis }
-
- PROCEDURE FetchNextSurvey (U : UnitPtr; { Gets Dictionary Survey }
- VAR S : SurveyRec); { Results Sequentially }
-
- PROCEDURE PurgeUnitSurvey (U : UnitPtr); { Purges Analysis From Heap }
-
- 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 }
- mfPROC, { PROC Map Entry }
- mfCSEG); { CSEG Map Entry }
-
- 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 : LL; { Offset in Source File Table }
- MapLod : LL; { Load Point for CODE/CONST Segment }
- MapSiz : Word; { Size of Segment / PROC (Bytes) }
-
- CASE MapFlags OF
- mfCSEG: ( {--CSEG/CONST Map Table Only--}
- MapFxI : LL; { Segment Fix-Up (Initial) }
- MapFxJ : LL; { Segment Fix-Up (Final) }
- );
- mfPROC: ( {-----PROC Map Table Only-----}
- MapEPT : LL; { Entry Point for PROC }
- MapCSM : LL; { Offset in CSEG Map for PROC }
- );
- END;
-
- SortMode = (CSegOrder, { Sort Proc Map into CSeg Order }
- PMapOrder); { Sort Proc Map into Proc Order }
-
- PROCEDURE SortProcRefs ( U : UnitPtr; { Sorts PROC Map as Needed }
- Mode : SortMode);
-
- PROCEDURE FetchVARsRef (VAR S : MapRefRec; { Gets GLOBAL Var Analysis }
- U : UnitPtr; { Using Natural Map Offsets }
- Offset: Word);
-
- PROCEDURE FetchCONsRef (VAR S : MapRefRec; { Gets Typed CONST Analysis }
- U : UnitPtr; { Using Natural Map Offsets }
- Offset: Word);
-
- PROCEDURE FetchCSegRef (VAR S : MapRefRec; { Gets CSeg Map Analysis }
- U : UnitPtr; { Using Natural Map Offsets }
- Offset: Word);
-
- PROCEDURE FetchProcRef (VAR S : MapRefRec; { Gets PROC Map Analysis }
- U : UnitPtr; { Using Natural Map Offsets }
- Offset: Word);
-
- (**********************) {.CP32}
- (**) Implementation (**)
- (**********************)
-
- Type
- 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;
-
- CvrTabPtr = ^ CvrTab;
- CvrTab = ARRAY[1..2] OF CvrRec; { Model of Stack/Queue }
-
- MapTabPtr = ^ MapTab;
- MapTab = ARRAY[0..4] OF MapRefRec; { Model of Cross-Refs }
-
- RMapPtr = ^ RMap;
- RMap = Object
- RMapTabPtr : MapTabPtr; { To Map References }
- RMapTabSiz : LongInt; { 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;
-
- TMapPtr = ^ TMap;
- TMap = Object
- TMapConPtr : RMapPtr; { To DSEG Map Survey (CONST) }
- TMapVarPtr : RMapPtr; { To DSEG Map Survey (VAR) }
- TMapProPtr : RMapPtr; { To PROC Map Survey }
- TMapCodPtr : RMapPtr; { To CSEG Map Survey }
- Destructor Done;
- Constructor Init(U : UnitPtr);
- End; { TMap }
-
- CoverPtr = ^ Cover; {.CP37}
- Cover = Object
- CvrNxtPtr : CoverPtr; { To Next Cover in Chain }
- CvrUnitPt : UnitPtr; { To Unit Being Surveyed }
- CvrMapPtr : TMapPtr; { To Map Analysis Object }
- CvrStkPtr : CvrTabPtr; { To Cover Stack }
- CvrQuePtr : CvrTabPtr; { To Completed Survey }
- CvrSize : Longint; { Allocation Sizes }
- CvrStkTop, { Cover Stack Top }
- CvrStkBot, { Cover Stack Bottom }
- CvrStkMax, { Cover Stack Ceiling }
- CvrQueHead, { Cover Queue Head }
- CvrQueTail, { Cover Queue Tail }
- CvrQueMax : Word; { Cover Queue Ceiling }
- Destructor Done;
- Constructor Init(U : UnitPtr; Next : CoverPtr);
- Procedure DisposeStack;
- Procedure DisposeQueue;
- Procedure PackQueue;
- Procedure CalcCovers;
- Procedure IndexMaps;
- FUNCTION QueuePos(Locn : LL) : Word;
- PROCEDURE EnQueue(Arg : CvrRec);
- FUNCTION Queued(Key : LL) : Boolean;
- PROCEDURE Push(ArgLoc,ArgOwn : LL; ArgTyp : CoverId; ArgLvl:Word);
- PROCEDURE Pop(VAR Arg : CvrRec);
- End; { Cover }
-
- Const RecLen = SizeOf(MapRefRec); MapLen = SizeOf(DMapRec);
- CvrRoot : CoverPtr = Nil; CvrLocus : CoverPtr = Nil;
- NullMap : MapRefRec = (MapTyp: mfNULL; MapOfs: 0;
- MapOwn: $FFFF; MapSrc: 0;
- MapLod: 0; MapSiz: 0;
- MapEPT: 0; MapCSM: 0);
-
- VAR CvrWork : CvrRec;
-
-
- { Begin Methods for R M a p } {.CP17}
-
- 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 * SizeOf(MapRefRec));
- S := NullMap;
- 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 * RecLen)
- End;
-
- Procedure RMap.SortPmap(Mode: SortMode); {.CP21}
- Var Rmt: MapTabPtr; I, J, K : Word; W: MapRefRec;
- Begin
- Rmt := RMapTabPtr; I := 0;
- If Rmt <> Nil Then
- Repeat { Slow but simple sort }
- J := I + 1; K := I;
- While J < RMapTabSiz Do Begin
- Case Mode Of
- CSegOrder:
- If Rmt^[J].MapCSM < Rmt^[K].MapCSM
- Then K := J
- Else
- If Rmt^[J].MapCSM = Rmt^[K].MapCSM
- Then
- If Rmt^[J].MapEPT < Rmt^[K].MapEPT
- Then K := J;
-
- PMapOrder:
- If Rmt^[J].MapOfs < Rmt^[K].MapOfs Then K := J;
- End; {Case}
- Inc(J);
- End; {While}
- If K <> I Then { We need to do a swap }
- Begin
- W := Rmt^[I]; Rmt^[I] := Rmt^[K]; Rmt^[K] := W
- End;
- Inc(I);
- Until I >= RMapTabSiz;
- 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 M A P } {.CP09}
-
- Destructor TMap.Done;
- Begin
- TMapConPtr^.Done;
- TMapVarPtr^.Done;
- TMapProPtr^.Done;
- TMapCodPtr^.Done;
- End;
-
- Constructor TMap.Init(U : UnitPtr); {.CP09}
- Begin
- TMapConPtr := New(RMapPtr,Init(U^.UHDMT-U^.UHTMT));
- TMapVarPtr := New(RMapPtr,Init(U^.UHxxy-U^.UHDMT));
- TMapProPtr := New(RMapPtr,Init(U^.UHCMT-U^.UHPMT));
- TMapCodPtr := New(RMapPtr,Init(U^.UHTMT-U^.UHCMT));
- End;
-
- { Begin Methods For C O V E R } {.CP14}
-
- Constructor Cover.Init(U : UnitPtr; Next : CoverPtr);
- Begin
- CvrStkTop := 0; CvrStkBot := 0; CvrStkMax := 0;
- CvrQueTail := 0; CvrQueHead := 0; CvrQueMax := 0;
- CvrNxtPtr := Next; CvrUnitPt := U;
- CvrStkPtr := Nil; CvrQuePtr := Nil;
- CvrSize := (U^.UHPMT-U^.UHIHT) + SizeOf(CvrRec) - 1;
- CvrSize := CvrSize-(CvrSize MOD SizeOf(CvrRec));
- GetMem(CvrQuePtr,CvrSize);
- GetMem(CvrStkPtr,CvrSize);
- CvrMapPtr := Nil;
- End; {Cover.Init}
-
- Procedure Cover.DisposeStack; {.CP05}
- Begin
- If CvrStkPtr <> Nil Then FreeMem(CvrStkPtr,CvrSize);
- CvrStkPtr := Nil
- End;
-
- Procedure Cover.DisposeQueue; {.CP05}
- Begin
- If CvrQuePtr <> Nil Then FreeMem(CvrQuePtr,CvrSize);
- CvrQuePtr := Nil
- End;
-
- Procedure Cover.PackQueue; { Releases un-used part of queue } {.CP15}
- Var T, K : Word; P : Pointer;
- Begin
- If CvrQuePtr <> Nil Then
- Begin
- T := CvrQueTail * SizeOf(CvrRec);
- If T < CvrSize Then
- Begin
- K := (CvrSize - T) AND $FFF8;
- P := PtrNormal(@CvrQuePtr^[CvrQueTail+1]);
- FreeMem(P,K); { VER60 Requires P be Normalized }
- CvrSize := CvrSize - K;
- End;
- End;
- End; {Cover.PackQueue}
-
- Destructor Cover.Done; {.CP02}
- Begin DisposeStack; DisposeQueue; CvrMapPtr^.Done End;
-
- FUNCTION Cover.QueuePos(Locn : LL):Word; {.CP16}
- VAR Lo, Mid, Hi : Word;
- BEGIN
- IF CvrQueTail < 1 THEN QueuePos := 1 ELSE
- BEGIN
- Lo := 1; Hi := CvrQueTail;
- REPEAT
- Mid := Longint(Lo + Hi) SHR 1;
- IF Locn > CvrQuePtr^[Mid].LocLL
- THEN Lo := Mid + 1
- ELSE Hi := Mid - 1
- UNTIL (CvrQuePtr^[Mid].LocLL=Locn) OR (Lo > Hi);
- IF Locn > CvrQuePtr^[Mid].LocLL THEN Inc(Mid);
- QueuePos := Mid;
- END; {WITH}
- END; {QueuePos}
-
- PROCEDURE Cover.EnQueue(Arg : CvrRec); {.CP40}
- VAR I,J,K,L, Key : LL;
- BEGIN
- Key := QueuePos(Arg.LocLL);
- IF Arg.LocLL < CvrUnitPt^.UHPMT THEN
- IF Key > CvrQueTail THEN
- BEGIN
- Inc(CvrQueTail);
- CvrQuePtr^[CvrQueTail] := Arg
- END ELSE
- IF Arg.LocLL <> CvrQuePtr^[Key].LocLL THEN { Raise higher entries to }
- BEGIN { make room for insertion }
- Inc(CvrQueTail);
- I := Seg(CvrQuePtr^[CvrQueTail]); { Segment of Tail Entry }
- J := Ofs(CvrQuePtr^[CvrQueTail]); { Offset of Tail Entry }
- K := Ofs(CvrQuePtr^[Key]); { Offset to insert point }
- L := SizeOf(CvrRec); { Size of Cover Record }
- ASM { ASM used for speed only - can be done with FOR Loop }
- PUSH DS { Save DS for Turbo }
- MOV BX,J { Ofs(CvrQuePtr^[CvrQueTail]) }
- MOV CX,BX { Copy To CX }
- DEC BX { Back Down 1 Byte }
- MOV SI,BX { Ofs(CvrQuePtr^[CvrQueTail])-1 }
- MOV AX,L { SizeOf(CvrRec) }
- MOV DI,BX { Ofs(CvrQuePtr^[CvrQueTail])-1 }
- ADD DI,AX { +SizeOf(CvrRec) }
- SUB CX,K { Ofs(CvrQuePtr^[CvrQueTail])-Ofs(CvrQuePtr^[Key]) }
- MOV AX,I { Seg(CvrQuePtr^[CvrQueTail]) }
- MOV ES,AX { Set Target Segment }
- MOV DS,AX { Set Source Segment }
- STD { Set Direction Right-To-Left }
- REPNZ MOVSB { Raise the queue }
- POP DS { Restore DS for Turbo }
- END; { Replacement Ends }
- CvrQuePtr^[Key] := Arg
- END;
- WITH CvrQuePtr^[Key] DO
- IF LocOwn = 0 THEN LocOwn := Arg.LocOwn;
- IF CvrQueTail > CvrQueMax THEN CvrQueMax := CvrQueTail;
- END; {EnQueue}
-
- PROCEDURE Cover.Push( ArgLoc, ArgOwn : LL; {.CP13}
- ArgTyp : CoverId; ArgLvl : Word);
- VAR Arg : CvrRec;
- BEGIN
- Arg.LocLL := ArgLoc; Arg.LocOwn := ArgOwn;
- Arg.LocTyp := ArgTyp; Arg.LocLvl := ArgLvl;
- BEGIN
- Inc(CvrStkTop);
- IF CvrStkTop > CvrStkMax
- THEN CvrStkMax := CvrStkTop;
- CvrStkPtr^[CvrStkTop] := Arg
- END
- END; {Push}
-
- PROCEDURE Cover.Pop(VAR Arg : CvrRec); {.CP05}
- BEGIN
- Arg := CvrStkPtr^[CvrStkTop];
- Dec(CvrStkTop);
- END; {Pop}
-
- FUNCTION Cover.Queued(Key : LL):Boolean; {.CP11}
- VAR Loc : Word;
- BEGIN
- Loc := QueuePos(Key);
- IF Loc > CvrQueTail
- THEN Queued := False
- ELSE
- IF Key = CvrQuePtr^[Loc].LocLL
- THEN Queued := True
- ELSE Queued := False
- END; {Queued}
-
- Procedure Cover.CalcCovers; {.CP03}
-
- PROCEDURE CoverWrapUp;
-
- PROCEDURE CoverWrapPost(x,s:LL); {.CP09}
- VAR J : LL;
- BEGIN
- j := QueuePos(s);
- WITH CvrQuePtr^[j] DO
- IF LocLL = s THEN
- IF (LocOwn > x) OR (LocOwn = 0)
- THEN LocOwn := x;
- END; {CoverWrapPost}
-
- PROCEDURE CoverWrapType(x : LL); {.CP27}
- VAR D : DNamePtr; S : DStubPtr; T : TypePtr; i,j,k : LL;
- RP : VarStubPtr; DF : Char;
- BEGIN
- D := AddrDict(CvrUnitPt,x); { Q entry }
- S := AddrStub(D); { its stub }
- RP := @S^.sRVF;
- T := AddrType(CvrUnitPt,S^.sQTD);
- IF T <> Nil THEN { TD in this unit }
- BEGIN
- DF := Public(D^.DForm);
- CoverWrapPost(x,S^.sQTD.UntLL);
- IF (T^.tpTC = 2) OR (T^.tpTC = 3) THEN
- BEGIN
- i := T^.RecdDict;
- IF i <> x THEN
- WHILE i <> 0 DO BEGIN
- CoverWrapPost(x,i);
- D := AddrDict(CvrUnitPt,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 : Integer; {.CP08}
- BEGIN {CoverWrapUp}
- For i := 1 TO CvrQueTail DO
- WITH CvrQuePtr^[i] DO
- IF LocTyp = cvName THEN
- IF Public(AddrDict(CvrUnitPt,LocLL)^.DForm) = 'Q'
- THEN CoverWrapType(LocLL)
- END; {CoverWrapUp}
-
- PROCEDURE CoverType(Arg : CvrRec); {.CP51}
- VAR T, TT : TypePtr; H:HashPtr; TTL : LL; I : Integer; L : Word;
- BEGIN {CoverType}
- T := TypePtr(PtrAdjust(CvrUnitPt,Arg.LocLL));
- TTL := Arg.LocLL;
- IF T <> Nil THEN
- WITH T^ DO
- CASE tpTC OF
- $01: BEGIN
- IF AddrType(CvrUnitPt,BaseType) <> Nil
- THEN Push(BaseType.UntLL,0,cvType,L);
- IF AddrType(CvrUnitPt,BounDesc) <> Nil
- THEN Push(BounDesc.UntLL,0,cvType,L);
- END; {CASE $01}
- $02: IF RecdHash <> 0
- THEN Push(RecdHash,Arg.LocOwn,cvHash,L+1);
- $03: IF ObjtHash <> 0
- THEN Push(ObjtHash,ObjtName,cvHash,L+1);
- $04,
- $05: IF AddrType(CvrUnitPt,FileType) <> Nil
- THEN Push(FileType.UntLL,0,cvType,L);
- $06: BEGIN
- IF AddrType(CvrUnitPt,T^.PFRes) <> Nil
- THEN Push(T^.PFRes.UntLL,Arg.LocOwn,cvType,L);
- { Handle Parameter List Entries Here }
- FOR I := 1 TO T^.PNPrm DO WITH T^.PFPar[I] DO
- IF AddrType(CvrUnitPt,fPTD) <> Nil
- THEN Push(fPTD.UntLL,Arg.LocOwn,cvType,L);
- END; {CASE $06}
- $07: IF AddrType(CvrUnitPt,SetBase) <> Nil
- THEN Push(SetBase.UntLL,0,cvType,L);
- $08: IF AddrType(CvrUnitPt,PtrBase) <> Nil
- THEN Push(PtrBase.UntLL,0,cvType,L);
- $09: BEGIN
- IF AddrType(CvrUnitPt,StrBase) <> Nil
- THEN Push(StrBase.UntLL,0,cvType,L);
- IF AddrType(CvrUnitPt,StrBound) <> Nil
- THEN Push(StrBound.UntLL,0,cvType,L);
- END; {CASE $09}
- $0C, $0D,
- $0E: IF AddrType(CvrUnitPt,Cmpat) <> Nil
- THEN Push(Cmpat.UntLL,0,cvType,L);
- $0F: BEGIN
- IF AddrType(CvrUnitPt,Cmpat) <> Nil
- THEN Push(Cmpat.UntLL,0,cvType,L);
- { now stack the SET descriptor that follows }
- TT := TypePtr(PtrAdjust(@Cmpat,SizeOf(T^.Cmpat)));
- Push(FormLL(CvrUnitPt,TT),0,cvType,L);
- END; {CASE $0F}
- END; {CASE tpTC}
- END; {CoverType}
-
- PROCEDURE CoverDictStub(D : DNamePtr; {.CP38}
- S : DStubPtr; Owner : LL; L : Word);
-
- VAR T : TypePtr; H : HashPtr; I : Integer; LLDE : LL; C : Char;
- BEGIN {CoverDictStub}
- C := Public(D^.DForm);
- LLDE := FormLL(CvrUnitPt,D);
- WITH S^ DO
- CASE C OF
- 'P': IF AddrType(CvrUnitPt,sPTD) <> Nil
- THEN Push(sPTD.UntLL,0,cvType,L);
- 'Q': IF AddrType(CvrUnitPt,sQTD) <> Nil
- THEN Push(sQTD.UntLL,LLDE,cvType,L);
- 'X': IF AddrType(CvrUnitPt,sQTD) <> Nil
- THEN Push(sQTD.UntLL,0,cvType,L);
- 'R': IF AddrType(CvrUnitPt,sRTD) <> Nil
- THEN Push(sRTD.UntLL,0,cvType,L);
- 'S': BEGIN
- IF sSHT <> 0 THEN Push(sSHT,LLDE,cvHash,L+1);
- T := AddrProcType(S);
- Push(FormLL(T,CvrUnitPt),LLDE,cvType,L);
- IF AddrType(CvrUnitPt,T^.PFRes) <> Nil
- THEN Push(T^.PFRes.UntLL,0,cvType,L);
- { Handle Parameter List Entries Here }
- FOR I := 1 TO T^.PNPrm DO WITH T^.PFPar[I] DO
- IF AddrType(CvrUnitPt,fPTD) <> Nil
- THEN Push(fPTD.UntLL,0,cvType,L);
- IF (sSTp AND $02) <> 0 THEN
- Push(FormLL(CvrUnitPt,@T^.PFPar[T^.PNPrm+1]),LLDE,cvINLN,L);
- END; {CASE 'S'}
-
- 'Y': BEGIN
- IF sYNU <> 0 THEN Push(sYNU,0,cvName,L);
- IF sYPU <> 0 THEN Push(sYPU,0,cvName,L);
- END; {CASE 'Y'}
-
- END; {CASE D^.DForm}
- END; {CoverDictStub}
-
- PROCEDURE CoverDictHdr(Arg : CvrRec); {.CP08}
- VAR D : DNamePtr; S : DStubPtr;
- BEGIN {CoverDictHdr}
- D := AddrDict(CvrUnitPt,Arg.LocLL);
- S := AddrStub(D);
- CoverDictStub(D,S,Arg.LocLL,Arg.LocLvl);
- IF D^.HLink <> 0 Then Push(D^.HLink,Arg.LocOwn,cvName,Arg.LocLvl);
- END; {CoverDictHdr}
-
- PROCEDURE CoverHashTab(Arg : CvrRec); {.CP09}
- VAR HLim, I : LL; H : HashPtr; L : Word;
- BEGIN {CoverHashTab}
- L := Arg.LocLvl + 1;
- H := AddrHash(CvrUnitPt,Arg.LocLL);
- HLim := (H^.Bas DIV SizeOf(LL));
- WITH H^ DO FOR I := 0 TO HLim DO
- IF Slt[I] <> 0 THEN Push(Slt[I],Arg.LocOwn,cvName,L);
- END; {CoverHashTab}
-
- Begin {CalcCovers} {.CP25}
-
- With CvrUnitPt^ Do Begin
- Push(UHIHT,UHUDH,cvHash,0); { INTERFACE Hash Table }
- Push(UHUDH,0,cvName,1); { Unit Dictionary Entry }
- IF UHIHT <> UHDHT
- THEN Push(UHDHT,UHDHT,cvHash,0); { Debug Rtn Hash Table }
- End;
-
- WITH CvrWork DO
- WHILE CvrStkTop > 0 DO BEGIN
- Pop(CvrWork);
- IF NOT Queued(LocLL) THEN
- BEGIN
- EnQueue(CvrWork);
- CASE LocTyp OF
- cvName: CoverDictHdr(CvrWork); {DictHdr}
- cvHash: CoverHashTab(CvrWork); {HashTab}
- cvType: CoverType(CvrWork); {TypDesc}
- END; {CASE}
- END; {IF}
- END; {WHILE}
- CoverWrapUp;
-
- 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 Cover.IndexMaps; {.CP03}
-
- Var CodeBase, DataBase, FixCBase, FixDBase : Word;
-
- { This Procedure computes the size of each } {.CP24}
- { PROC and adds the result to the Xref map }
-
- Procedure SizeProcs;
- Var CodeLimit, I, J, K : Word; Pc, Pp : MapTabPtr; Rp, Rc : RMapPtr;
- Begin
- I := 0;
- CodeLimit := (CvrUnitPt^.UHENC+$F) AND $FFF0 + CvrUnitPt^.UHZCS;
- Rp := CvrMapPtr^.TMapProPtr; { Get RMap Pro Pointer }
- Pp := Rp^.RMapTabPtr; { Get Proc Ref Pointer }
- J := Rp^.RMapTabSiz; { Get Slot Count }
- Rc := CvrMapPtr^.TMapCodPtr; { Get RMap Cod Pointer }
- Pc := Rc^.RMapTabPtr; { Get CSeg Ref Pointer }
- 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;
- With Pp^[J-1] Do
- If MapCSM <> $FFFF
- Then MapSiz := Codelimit - MapEPT;
- End; {SizeProcs}
-
- { This Procedure Initializes the CSeg Xref Map } {.CP29}
- { and sets CSeg Load Points and Fix-Up Offsets }
-
- Procedure PrimeCSegs;
- Var Cx, Cn, I, N : Word; D : DMapTabPtr;
- C : CMapTabPtr; P : PMapPtr; Rmt, Rmv : MapTabPtr;
- Begin
- Rmt := CvrMapPtr^.TMapCodPtr^.RMapTabPtr;
- N := CvrMapPtr^.TMapCodPtr^.RMapTabSiz;
- Cn := CountCMapSlots(CvrUnitPt);
- C := AddrCMapTab(CvrUnitPt);
-
- If C <> Nil 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 := CodeBase;
- MapSiz := CSegCnt;
- Inc(CodeBase,CSegCnt);
- If CSegRel > 0 Then { We Have Fix-Ups for this CSeg }
- Begin
- MapFxI := FixCBase;
- FixCBase := FixCBase + CSegRel;
- MapFxJ := FixCBase - SizeOf(FixUpRec);
- End;
- End;
-
- { Now, we do a similar job for Typed Constant Data Segments }
-
- Rmv := CvrMapPtr^.TMapConPtr^.RMapTabPtr;
- N := CvrMapPtr^.TMapConPtr^.RMapTabSiz;
- D := AddrDMapTab(CvrUnitPt);
-
- 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;
- MapFxJ := DSegRel;
- If DSegOwn <> 0 Then
- Begin MapOwn := DSegOwn; MapTyp := mfTVMT End;
- End;
-
- { Now, we do a similar job for the PROC Map }
-
- Rmv := CvrMapPtr^.TMapProPtr^.RMapTabPtr;
- N := CvrMapPtr^.TMapProPtr^.RMapTabSiz;
- P := AddrPMapTab(CvrUnitPt);
-
- If P <> Nil Then
- For Cx := 0 To N-1 Do
- With P^[Cx], Rmv^[Cx] Do
- Begin
- MapCSM := CSegOfs;
- MapEPT := CSegJmp;
- If MapCSM <> $FFFF Then
- Begin
- MapTyp := mfPROC;
- I := MapCSM DIV SizeOf(CMapRec);
- MapEPT := MapEPT + Rmt^[I].MapLod; { Relocate Entry Point }
- End;
- MapSrc := 0;
- End;
-
- End; { PrimeCSegs }
-
- { This Procedure updates the CSeg Xref Table with information }{.CP57}
- { from the Trace and PROC Tables that allow us to determine }
- { which of the source files contained the CSeg represented by }
- { the map entry. }
-
- Procedure FinalCSegs;
- Var Cx, Cn, I, N, Sf, Sn, So : Word;
- Sp, Sh : SrcFilePtr; Tp : TraceRecPtr; Rmt, Rmv : MapTabPtr;
- Begin
- Rmt:= CvrMapPtr^.TMapCodPtr^.RMapTabPtr;
- Cn := CvrMapPtr^.TMapCodPtr^.RMapTabSiz;
- Sh := AddrSrcTabOff(CvrUnitPt,0); Sp := Sh; { Source File List }
- Sf := 0; { Total Source Files }
- Sn := 0; { Total Non-.OBJ Files }
- While Sp <> Nil Do Begin
- Inc(Sf); { Inc Total Source Files }
- If Sp^.SrcFlag <> $05 Then Inc(Sn); { Inc Non-Obj File Count }
- Sp := AddrNxtSrc(CvrUnitPt,Sp);
- End;
- So := Sf - Sn; { Total *.OBJ Files }
- Sp := Sh; { Restore Sp }
-
- If So > 0 Then { There ARE *.OBJ Files in Source File List }
- Begin
- For I := 1 to Sn Do Sp := AddrNxtSrc(CvrUnitPt,Sp);
- Cx := Cn - So; { 1st CMap Entry from .OBJ File }
- For I := Cx To Cn-1 Do
- With Rmt^[I] Do
- Begin
- MapSrc := FormLL(Sh,Sp);
- Sp := AddrNxtSrc(CvrUnitPt,Sp);
- End;
- 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. }
-
- Tp := AddrTraceTab(CvrUnitPt);
- Rmv := CvrMapPtr^.TMapProPtr^.RMapTabPtr;
- N := CvrMapPtr^.TMapProPtr^.RMapTabSiz;
- While Tp <> Nil Do With Tp^ Do Begin {For ALL Trace Entries}
- I := 0;
- While I < N Do With Rmv^[I] Do Begin {For ALL PROC Map Entries}
- If MapOwn = Trname Then {Proc has a Trace Entry }
- Begin
- Rmt^[MapCSM DIV SizeOf(CMapRec)].MapSrc := Trfill; {CSeg Refs}
- I := N; {quit loop and try next trace entry}
- End;
- Inc(I);
- End;
- Tp := AddrNxtTrace(CvrUnitPt,Tp);
- End;
- End; {FinalCSegs}
-
- { This Procedure updates the CONST Xref Table with data from }{.CP46}
- { 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 : Integer; HaveXtrn : Boolean; Rmt : MapTabPtr;
- Begin
- Rmt := CvrMapPtr^.TMapConPtr^.RMapTabPtr;
- N := CvrMapPtr^.TMapConPtr^.RMapTabSiz;
- HaveXtrn := False;
-
- If N > 0 Then
- Begin
- For I := 0 To N-1 Do With Rmt^[I] Do Begin
- MapLod := DataBase;
- DataBase := DataBase + MapSiz;
- If MapFxJ > 0 Then
- Begin
- MapFxI := FixDBase;
- Inc(FixDBase,MapFxJ);
- MapFxJ := FixDBase - SizeOf(FixUpRec);
- End;
- If MapTyp = mfNULL Then
- Begin
- MapTyp := mfXTRN;
- HaveXtrn := True;
- End;
- End; { Fix-Up Offsets are now set }
- { Source File problem deferred until later }
- End;
-
- Rmt := CvrMapPtr^.TMapVarPtr^.RMapTabPtr; { Classify VARS Too }
- N := CvrMapPtr^.TMapVarPtr^.RMapTabSiz;
- If N > 0 Then
- Begin
- For I := 0 To N-1 Do With Rmt^[I] Do
- If MapTyp = mfNULL Then MapTyp := mfXTRN
- End;
-
- End; {FinalCONST}
-
- Var I, J, DHT : Word; C : Char; SystemUnit, InINTF : Boolean; {.CP26}
- Pn : DNamePtr; Ps : DStubPtr; Pv : VarStubPtr; Pm, Pc : RMapPtr;
- Pp : PMapRecPtr; Tc, Tv, Td : DMapRecPtr; V : CvrRec; Q, Qc : MapRefRec;
-
- Begin {IndexMaps}
-
- If CvrMapPtr <> Nil Then CvrMapPtr^.Done;
- CvrMapPtr := New(TMapPtr,Init(CvrUnitPt));
-
- CodeBase := (CvrUnitPt^.UHENC + $F) AND $FFF0;
- DataBase := (CvrUnitPt^.UHZCS + CodeBase +$F) AND $FFF0;
- FixCBase := (CvrUnitPt^.UHZDT + DataBase +$F) AND $FFF0;
- DHT := CvrUnitPt^.UHDHT;
- SystemUnit := IsSystemUnit(CvrUnitPt);
-
- If CvrMapPtr^.TMapCodPtr^.RMapTabSiz > 0 { Initialize CSeg Map Refs }
- Then PrimeCSegs;
-
- FixDBase := (FixCBase +$F) AND $FFF0; { VMT Fix-Ups Start Here }
- Pc := CvrMapPtr^.TMapCodPtr; { Get Method Pointer }
-
- For I := 1 To CvrQueTail Do Begin { Get CONST/VAR Mapping }
- V := CvrQuePtr^[I];
- If V.LocTyp = cvName Then
- Begin
- Pn := Ptr(Seg(CvrUnitPt^),Ofs(CvrUnitPt^)+V.LocLL);
- Tc := Ptr(Seg(CvrUnitPt^),Ofs(CvrUnitPt^)+CvrUnitPt^.UHTMT);
- Tv := Ptr(Seg(CvrUnitPt^),Ofs(CvrUnitPt^)+CvrUnitPt^.UHDMT);
- Ps := AddrStub(Pn);
- C := Public(Pn^.DForm);
-
- If C = 'R' Then { a data instance of some kind } {.CP42}
- Begin
- If Ps^.sRAM < $02 Then { a global variable or typed const }
- Begin
- Pv := @Ps^.sRVF;
- J := Pv^.TOB;
- InINTF := (DHT > V.LocLL) OR SystemUnit;
-
- If Ps^.sRAM = $00 Then { it's a Global Variable }
- Begin
- Pm := CvrMapPtr^.TMapVarPtr;
- Pm^.FetchRef(Q,Pv^.TOB);
- Td := Ptr(Seg(Tv^),Ofs(Tv^)+Pv^.TOB);
- Q.MapSiz := Td^.DSegCnt;
- If InINTF Then Q.MapTyp := mfINTF
- Else Q.MapTyp := mfIMPL;
- Pm^.StoreRef(Q,Pv^.TOB);
- End
- Else { it's a Typed Constant }
- Begin
- Pm := CvrMapPtr^.TMapConPtr;
- Pm^.FetchRef(Q,Pv^.TOB);
- Td := Ptr(Seg(Tc^),Ofs(Tc^)+Pv^.TOB);
- 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 } {.CP27}
- If C = 'S' Then { It's a PROC ...... }
- If (Ps^.sSTP AND $02) = 0 Then { ... But NOT INLINE }
- Begin
- Pm := CvrMapPtr^.TMapProPtr; { 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 CvrMapPtr^.TMapCodPtr^.RMapTabSiz > 0 { Finish Up CSeg Map Refs }
- Then FinalCSegs;
-
- CvrMapPtr^.TMapProPtr^.SortPMap(CSegOrder); { Sort into Load Order }
- SizeProcs; { Get Proc Size(Bytes) }
- CvrMapPtr^.TMapProPtr^.SortPMap(PMapOrder); { Sort into PMap Order }
- FinalCONST; { Finish CONST Map Refs }
-
- End; {IndexMaps}
-
- (* E N D M E T H O D S *)
-
- Function FindCover(U : UnitPtr; S : CoverPtr) : CoverPtr; {.CP11}
- Begin
- FindCover := Nil;
- While S <> Nil Do
- If S^.CvrUnitPt = U Then
- Begin
- FindCover := S;
- S := Nil
- End
- Else S := S^.CvrNxtPtr
- End; {FindCover}
-
- PROCEDURE FetchVARsRef (VAR S : MapRefRec; {.CP09}
- U : UnitPtr;
- Offset: Word);
- Var Q : CoverPtr;
- Begin
- Q := FindCover(U,CvrRoot);
- If Q <> Nil
- Then Q^.CvrMapPtr^.TMapVarPtr^.FetchRef(S,Offset);
- End;
-
- PROCEDURE FetchCSegRef (VAR S : MapRefRec; {.CP09}
- U : UnitPtr;
- Offset: Word);
- Var Q : CoverPtr;
- Begin
- Q := FindCover(U,CvrRoot);
- If Q <> Nil
- Then Q^.CvrMapPtr^.TMapCodPtr^.FetchRef(S,Offset);
- End;
-
- PROCEDURE FetchProcRef (VAR S : MapRefRec; {.CP09}
- U : UnitPtr;
- Offset: Word);
- Var Q : CoverPtr;
- Begin
- Q := FindCover(U,CvrRoot);
- If Q <> Nil
- Then Q^.CvrMapPtr^.TMapProPtr^.FetchRef(S,Offset);
- End;
-
- PROCEDURE SortProcRefs ( U : UnitPtr;
- Mode : SortMode);
- Var Q : CoverPtr;
- Begin
- Q := FindCover(U,CvrRoot);
- If Q <> Nil
- Then Q^.CvrMapPtr^.TMapProPtr^.SortPmap(Mode);
- End;
-
- PROCEDURE FetchCONsRef (VAR S : MapRefRec; {.CP09}
- U : UnitPtr;
- Offset: Word);
- Var Q : CoverPtr;
- Begin
- Q := FindCover(U,CvrRoot);
- If Q <> Nil
- Then Q^.CvrMapPtr^.TMapConPtr^.FetchRef(S,Offset);
- End;
-
- PROCEDURE FetchNextSurvey (U : UnitPtr; VAR S : SurveyRec); {.CP23}
- Var Q : CvrRec;
- Begin
- S.LocTyp := cvNULL; S.LocLL := 0; S.LocOwn := 0; S.LocNxt := 0;
- If CvrRoot <> Nil Then
- Begin
- If CvrLocus = Nil Then CvrLocus := CvrRoot;
- If CvrLocus^.CvrUnitPt <> U
- Then CvrLocus := FindCover(U,CvrRoot);
- If CvrLocus <> Nil Then With CvrLocus^ Do
- Begin
- If CvrQueHead < CvrQueTail Then
- Begin
- Inc(CvrQueHead);
- Q := CvrQuePtr^[CvrQueHead];
- S.LocTyp := Q.LocTyp; S.LocLL := Q.LocLL;
- S.LocOwn := Q.LocOwn; S.LocNxt := U^.UHPMT
- End;
- If CvrQueHead < CvrQueTail
- Then S.LocNxt := CvrQuePtr^[CvrQueHead+1].LocLL;
- End;
- End;
- End; {FetchNextSurvey}
-
- Procedure PurgeUnitSurvey(U : UnitPtr); {.CP18}
- Var P, Q, R : CoverPtr;
- Begin
- P := Nil;
- Q := FindCover(U,CvrRoot);
- If Q <> Nil Then
- Begin
- P := Q^.CvrNxtPtr;
- R := CvrRoot;
- If Q = R
- Then CvrRoot := P Else
- Begin
- While R^.CvrNxtPtr <> Q Do R := R^.CvrNxtPtr;
- R^.CvrNxtPtr := P;
- End;
- Q^.Done;
- End;
- End; {PurgeUnitSurvey}
-
- PROCEDURE SurveyUnit(U : UnitPtr); {.CP15}
- Var S : CoverPtr;
- BEGIN {SurveyUnit}
- PurgeUnitSurvey(U); { Make sure no left-overs }
- CvrRoot := New(CoverPtr,
- Init(U,CvrRoot)); { Build new Instance }
- CvrRoot^.CalcCovers; { Analyze Dictionary }
- CvrRoot^.DisposeStack; { Release Cover Stack }
- CvrRoot^.PackQueue; { Trim Cover Queue }
- CvrRoot^.IndexMaps; { Cross-Index All Maps }
- END; {SurveyUnit}
-
- END. { TPU6TST }