home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPU55A.ZIP / TPUNEW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-11  |  46.9 KB  |  1,608 lines
  1. PROGRAM tpunew; {$D+,L+,S+,R-,E-,N-}
  2. USES Dos,Crt,TPUAMS1,TPURPT1,TPUUNA1;
  3.  
  4. TYPE
  5.     SurveyPtr = ^ SurveyRec;
  6.     SurveyRec =
  7.      RECORD
  8.         LocLL  : LL;    { LL to location of data structure      }
  9.         LocOwn : LL;    { LL to Dictionary Header of Owner or 0 }
  10.         LocTyp : Char;  { Type of Structure (D,T,H,?)           }
  11.      END;
  12.  
  13.     SurveyTabPtr = ^ SurveyTab;
  14.     SurveyTab =
  15.      RECORD
  16.         Svy : ARRAY[1..30] OF SurveyRec
  17.      END;
  18.  
  19.     MethodName = String[127];
  20.     HeadProc   = PROCEDURE;
  21. VAR
  22.     SurveyQuePtr,    SurveyStkPtr            : SurveyTabPtr;
  23.  
  24.     SurveyQueMax,    SurveyStkMax,    SurveyQueTop,
  25.     SurveyStkTop,    SurveyLimit,    SurveySize    : Word;
  26.  
  27.     CSegOrg,    CSegEnd        : Word;
  28.     NextLL,        LastLL        : Word;
  29.  
  30.     TabStop,    NoteX,        NoteY    : Integer;
  31.  
  32.     NoteTime    : LongInt;
  33.  
  34.     DisAssembly    : Boolean;
  35.  
  36.     SurveyWork    : SurveyRec;
  37.  
  38. PROCEDURE NoteBegin(S:String);                    {.CP08}
  39. VAR HH,MM,SS,CS : Word;
  40. BEGIN
  41.     NoteX := WhereX; NoteY := WhereY; ClrEol;
  42.     GetTime(HH,MM,SS,CS);
  43.     NoteTime := ((HH*60+MM)*60+SS)*100+CS;
  44.     Write(S);
  45. END;
  46.  
  47. PROCEDURE PageOverFlow(Lines : Word; CallProc : HeadProc);
  48. BEGIN
  49.     IF LinesRemaining < Lines THEN
  50.     BEGIN
  51.         NewTxtPage;
  52.         CallProc;
  53.     END
  54.     ELSE    NewTxtLine;
  55. END;
  56.  
  57. PROCEDURE NoteEnd;                        {.CP11}
  58. VAR HH,MM,SS,CS : Word; SF : String[3];  I : Integer;
  59. BEGIN
  60.     GetTime(HH,MM,SS,CS);
  61.     NoteTime := (((HH*60+MM)*60+SS)*100+CS) - NoteTime;
  62.         Str(NoteTime MOD 100 + 100:3,SF);
  63.         I := NoteTime DIV 100;
  64.     Write(', Finished in ',I:5,'.',Copy(SF,2,2),' seconds');
  65.     Delay(1000);
  66.     GoToXY(NoteX,NoteY);
  67. END;
  68.  
  69. PROCEDURE PrintTitleBlk(S : String; LinesNeeded : Integer);    {.CP11}
  70. BEGIN {PrintTitleBlk}
  71.     IF LinesRemaining < LinesNeeded+3
  72.         THEN NewTxtPage    ELSE SetCol(1);
  73.     PutTxt('-------------');
  74.     NewTxtLine;
  75.     PutTxt('- ' + S);
  76.     NewTxtLine;
  77.     PutTxt('-------------');
  78.     SetCol(1);
  79. END; {PrintTitleBlk}
  80.  
  81. PROCEDURE PrintAddress(Arg : LL);                {.CP06}
  82. BEGIN
  83.     IF ColumnsUsed <> 0 THEN NewTxtLine;
  84.     PutTxt(HexW(Arg));
  85.     SetCol(7);
  86. END; {PrintAddress}
  87.  
  88. PROCEDURE PrintByteList(U : UnitHeadPtr; Count, Space : Word);    {.CP11}
  89. BEGIN
  90.     WITH BufPtr(U)^ DO
  91.     WHILE Count > 0 DO
  92.     BEGIN
  93.         PutTxt(HexB(BufByt[NextLL]));
  94.         SetCol(ColumnsUsed+Space+1);
  95.         Inc(NextLL);
  96.         Dec(Count);
  97.     END
  98. END; {PrintByteList}
  99.  
  100. PROCEDURE PrintWd(U : UnitHeadPtr; S : String);            {.CP07}
  101. BEGIN
  102.     PrintAddress(NextLL);
  103.     PrintByteList(U,2,1);
  104.     SetCol(TabStop);
  105.     PutTxt(S);
  106. END; {PrintWd}
  107.  
  108. PROCEDURE PrintLL(U : UnitHeadPtr; S : String);            {.CP07}
  109. BEGIN
  110.     PrintAddress(NextLL);
  111.     PrintByteList(U,2,1);
  112.     SetCol(TabStop);
  113.     PutTxt('LL('+S+')');
  114. END; {PrintLL}
  115.  
  116. FUNCTION NilLG(U : UnitHeadPtr; Locn : LL) : Boolean;        {.CP08}
  117. VAR L : ^LG;
  118. BEGIN
  119.     L := Ptr(Seg(U^),Ofs(U^)+Locn);            {Get Ptr to LG}
  120.     IF (L^.UntLL = 0) AND (L^.UntId = 0)
  121.     THEN NilLG := True
  122.     ELSE NilLG := False
  123. END;
  124.  
  125. PROCEDURE PrintLG(U : UnitHeadPtr; S : String);            {.CP15}
  126. VAR L : ^LG; V : DictHeadPtr;
  127. BEGIN
  128.     IF NOT NilLG(U,NextLL) THEN
  129.     BEGIN
  130.         L := Ptr(Seg(U^),Ofs(U^)+NextLL); {Get Ptr to LG}
  131.         V := AddrLGUnit(U,L^);
  132.         IF V <> Nil THEN S := S + ' in "'+V^.DSymb+'" unit';
  133.         S := 'LG('+S+')';
  134.     END;
  135.     PrintAddress(NextLL);
  136.     PrintByteList(U,4,1);
  137.     SetCol(TabStop);
  138.     PutTxt(S);
  139. END; {PrintLG}
  140.  
  141. PROCEDURE PrintSoloByte(U : UnitHeadPtr; S : String);        {.CP08}
  142. VAR B : Byte;
  143. BEGIN
  144.     PrintAddress(NextLL);
  145.     PrintByteList(U,1,0);
  146.     SetCol(TabStop);
  147.     PutTxt(S);
  148. END; {PrintSoloByte}
  149.  
  150. PROCEDURE PrintBytes(U : UnitHeadPtr; Count, Limit : Word);    {.CP12}
  151. VAR I : Integer;
  152. BEGIN
  153.     I := 0;
  154.     WITH BufPtr(U)^ DO WHILE Count > 0 DO BEGIN
  155.         I := I MOD Limit;
  156.         IF I = 0 THEN PrintAddress(NextLL);
  157.         PrintByteList(U,1,1);
  158.         Inc(I);
  159.         Dec(Count);
  160.     END;
  161. END; {PrintBytes}
  162.  
  163. PROCEDURE BoundaryAlign(UH : UnitHeadPtr);            {.CP12}
  164. VAR I : Integer;
  165. BEGIN {BoundaryAlign}
  166.     I := ((NextLL + 15) AND $FFF0) - NextLL;
  167.     IF I > 0 THEN
  168.     BEGIN
  169.         PrintBytes(UH,I,8);
  170.         SetCol(36);
  171.         PutTxt('Align to Paragraph Boundary');
  172.         NewTxtLine
  173.     END;
  174. END;  {BoundaryAlign}
  175.  
  176. PROCEDURE PrintOffset(Base: Word);                {.CP05}
  177. BEGIN
  178.     PrintAddress(NextLL);
  179.     PutTxt('[+'+HexW(NextLL-Base)+']: ');
  180. END;
  181.  
  182. PROCEDURE PrintCodeBytes(U : UnitHeadPtr; Count,Limit,Base: Word); {.CP12}
  183. VAR I : Integer;
  184. BEGIN
  185.     I := 0;
  186.     WITH BufPtr(U)^ DO WHILE Count > 0 DO BEGIN
  187.         I := I MOD Limit;
  188.         IF I = 0 THEN PrintOffset(Base);
  189.         PrintByteList(U,1,1);
  190.         Inc(I);
  191.         Dec(Count);
  192.     END;
  193. END; {PrintBytes}
  194.  
  195. PROCEDURE PrintUnknowns(U : UnitHeadPtr; Till:LL);        {.CP06}
  196. BEGIN {PrintUnknowns}
  197.     PrintTitleBlk('The Purpose of the data below is Unknown',1);
  198.     PrintBytes(U,Till-NextLL,8);
  199.     NewTxtLine;
  200. END;  {PrintUnknowns}
  201.  
  202. PROCEDURE FormatHeader(U : UnitHeadPtr);            {.CP37}
  203. VAR I : Integer;
  204. BEGIN
  205.     NoteBegin('Formatting Unit Header');
  206.     PrintAddress(NextLL);
  207.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.FilHd[I]))+' ');
  208.     SetCol(TabStop);
  209.     PutTxt('=''');
  210.     FOR I := 0 TO 3 DO PutTxt(U^.FilHd[I]);
  211.     PutTxt('''');
  212.     NewTxtLine;
  213.     Inc(NextLL,4);
  214.     PrintAddress(NextLL);
  215.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.Fillr[I]))+' ');
  216.     NewTxtLine;
  217.     Inc(NextLL,4);
  218.     PrintLL(U,'Dict Entry-This Unit');
  219.     PrintLL(U,'Interface Hash Table');
  220.     PrintLL(U,'PROC Map');
  221.     PrintLL(U,'CSeg Map');
  222.     PrintLL(U,'DSeg Map-Typed CONSTs');
  223.     PrintLL(U,'DSeg Map-Global VARs');
  224.     PrintLL(U,'List of Donor Units');
  225.     PrintLL(U,'List of Source Files');
  226.     PrintLL(U,'Debug TRACE Step Controls');
  227.     PrintLL(U,'end NON-CODE part of Unit');
  228.     PrintWd(U,'Size of Code in CSeg''s');
  229.     PrintWd(U,'Size of CONST Data in DSeg''s');
  230.     PrintWd(U,'Size of Relocation List');
  231.     PrintWd(U,'unknown function (VIRTUAL Methods?)');
  232.     PrintWd(U,'Size of Global VARs in DSeg''s');
  233.     PrintLL(U,'DEBUG Hash Table');
  234.     PrintWd(U,'Flags Overlay if non-zero ?');
  235.     NewTxtLine;
  236.     IF NextLL < U^.UGHsh THEN PrintUnknowns(U,U^.UGHsh);
  237.     NoteEnd;
  238. END; {FormatHeader}
  239.  
  240. FUNCTION NameOfMethod(U:UnitHeadPtr;UsrDE:LL):MethodName;    {.CP20}
  241. VAR DS, DC : DictHeadPtr; S : DictStubPtr; T : TypePtr; N, M : String[64];
  242. BEGIN
  243.     N := ''; M := '???';
  244.     IF UsrDE <> $FFFF THEN
  245.     BEGIN
  246.         DS := DictHeadPtr(PtrAdjust(U,UsrDE));
  247.         M  := DS^.DSymb;
  248.         S  := AddrStub(DS);
  249.         IF DS^.DForm = 'S' THEN        {ensure subprogram entry}
  250.         IF (S^.TCod AND $10) <> 0 THEN {get OBJECT Name Qualifier}
  251.         IF  S^.Scop <> 0 THEN
  252.         BEGIN
  253.             T  := TypePtr(PtrAdjust(U,S^.Scop));    {to Object TD}
  254.             DC := DictHeadPtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  255.             N  := DC^.Dsymb+'.';
  256.         END
  257.     END;
  258.     NameOfMethod := N + M
  259. END;   {NameOfMethod}
  260.  
  261. PROCEDURE FormatDictionary(U : UnitHeadPtr);            {.CP16}
  262.  
  263.     PROCEDURE PrintDictEntry;
  264.     VAR D,DB : DictHeadPtr; S : DictStubPtr; I : Integer;  T : String[44];
  265.         W : String;
  266.     BEGIN {PrintDictEntry}
  267.         D := AddrDict(U,SurveyWork.LocLL); S := AddrStub(D);
  268.         WITH SurveyWork, D^, S^ DO BEGIN
  269.             I := 4+(Length(DSymb) SHR 4);
  270.             CASE DForm OF
  271.                 'O','T','U','V',
  272.                 'W','Q','X':         Inc(I);
  273.                 'P':             Inc(I,2);
  274.                 'Y','R': Inc(I,4); 'S': Inc(I,6);
  275.             END; {CASE}
  276.             W := '';                {.CP12}
  277.             IF DForm = 'R' THEN
  278.             IF RH = 8 THEN
  279.             IF SurveyWork.LocOwn <> 0
  280.                 THEN W := NameOfMethod(U,SurveyWork.LocOwn)
  281.                 ELSE
  282.             ELSE
  283.             IF ROB <> 0 THEN W := NameOfMethod(U,ROB);
  284.             IF W = '???' THEN W := '' ELSE
  285.             IF W <> '' THEN W := W + '.';
  286.             PrintTitleBlk('Dictionary Entry For: "'+ W +
  287.                 NameOfMethod(U,SurveyWork.LocLL)+'"',I);
  288.             IF HLink <> 0                {.CP24}
  289.             THEN PrintLL(U,AddrDict(U,HLink)^.DSymb)
  290.             ELSE PrintWd(U,'(no backward link)');
  291.             PrintBytes(U,1,1);
  292.             SetCol(TabStop);
  293.             PutTxt('Type "'+DForm+'" -> ');
  294.             CASE DForm OF                                                {.CP18}
  295.                 'O': PutTxt('GOTO Label');  'P': PutTxt('Constant');
  296.                 'Y': PutTxt('Unit');        'T': PutTxt('Built-In Procedure');
  297.                 'W': PutTxt('Port Array');  'U': PutTxt('Built-In Function');
  298.                 'Q': PutTxt('Named Type');  'V': PutTxt('Built-In "NEW"');
  299.                 'X': PutTxt('External VAR');
  300.                 'R': CASE RH OF
  301.                     $0: PutTxt('Global VAR');
  302.                     $1: PutTxt('Typed CONST');
  303.                     $2: PutTxt('VAR (VALUE on Stack)');
  304.                     $6: PutTxt('VAR (ADDRESS on Stack)');
  305.                     $8: PutTxt('Record/Object Field');
  306.                      END; {CASE RH}
  307.                 'S': PutTxt('User Subprogram/Method');
  308.             END; {CASE DForm OF}
  309.             PrintBytes(U,Length(DSymb)+1,16);
  310.             SetCol(TabStop); PutTxt('="'+DSymb+'"');
  311.             NewTxtLine;
  312.             CASE DForm OF { Format the Stub Part }        {.CP13}
  313.                 'O': PrintWd(U,'Code Offset for Jump???)');
  314.                 'P': BEGIN
  315.                     PrintLG(U,'type descriptor');
  316.                     PrintBytes(U,LastLL-NextLL,8); {Temporary Fix}
  317.                     {since value can be a string, we really need to check
  318.                      the type descriptor out but that usually lies in the
  319.                      system unit.  We circumvent for now by relying on the
  320.                      distance to the next structure to determine the size
  321.                      of the constant data for print purposes }
  322.                     SetCol(TabStop); PutTxt('Constant Value');
  323.                     NewTxtLine;
  324.                      END; {CASE 'P'}
  325.                 'Y': BEGIN                {.CP07}
  326.                     PrintWd(U,'TURBO Work?');
  327.                     PrintWd(U,'unknown purpose-signature???');
  328.                     PrintLL(U,'next unit in list');
  329.                     PrintLL(U,'prior unit in list');
  330.                     NewTxtLine;
  331.                      END; {CASE 'Y'}
  332.             'T','U','V': BEGIN                {.CP4}
  333.                     PrintWd(U,'unknown purpose');
  334.                     NewTxtLine;
  335.                      END;
  336.                 'W': BEGIN                {.CP4}
  337.                     PrintSoloByte(U,'0=byte array, 1=word array');
  338.                     NewTxtLine;
  339.                      END;
  340.                 'Q','X': BEGIN                {.CP4}
  341.                     PrintLG(U,'type descriptor');
  342.                     NewTxtLine;
  343.                      END;
  344.                 'R': BEGIN                {.CP32}
  345.                     CASE RH OF
  346.                         $0: T := 'Global VAR in DS';
  347.                         $1: T := 'Typed CONST in DS';
  348.                         $2: IF ROfs > $7FFF
  349.                             THEN T := 'Local Variable on Stack'
  350.                             ELSE T := 'Parameter VALUE on Stack';
  351.                         $6: T := 'Parameter ADDR on Stack';
  352.                         $8: T := 'Record/Object Field'
  353.                            ELSE T := '**** NEW CODE TO CHECK ****'
  354.                     END; {CASE RH}
  355.                     PrintSoloByte(U,T);
  356.                     T := '';
  357.                     IF (RH = $2) OR (RH = $6) THEN
  358.                     IF ROfs > $7FFF
  359.                       THEN T := 'BP-'+HexW($10000-ROfs)
  360.                       ELSE T := 'BP+'+HexW(ROfs)
  361.                     ELSE T := 'bytes';
  362.                     PrintWd(U,'allocation offset ('+T+')');
  363.                     CASE RH OF
  364.                       $0,$2,$6: IF ROB = 0
  365.                             THEN T := 'no containing scope'
  366.                             ELSE T := 'LL(containing Scope)';
  367.                         $1: T := 'offset to DSeg Map Entry';
  368.                         $8: IF ROB = 0
  369.                             THEN T := 'no successor field/method'
  370.                             ELSE T := 'LL(successor field/method)';
  371.                       ELSE T := 'unknown purpose'
  372.                     END; {CASE RH}
  373.                     PrintWd(U,T);
  374.                     PrintLG(U,'type descriptor');
  375.                      END; {CASE 'R'}
  376.                 'S': BEGIN                {.CP36}
  377.                     T := '';
  378.                     IF TCod = $00 THEN T := '+Nested PROC' ELSE
  379.                     IF (TCod AND $10) <> 0 THEN
  380.                     CASE (TCod AND $60) OF
  381.                         $00: T := '+Method';    $20: T := '+Constructor';
  382.                         $40: T := '+Destructor';
  383.                         ELSE T := '+Method?'
  384.                     END;
  385.                     IF (TCod AND $08) <> 0 THEN T := T + '+EXTERNAL';
  386.                     IF (TCod AND $01) <> 0 THEN T := T + '+INTERFACE';
  387.                     IF (TCod AND $02) <> 0 THEN T := T + '+INLINE';
  388.                     IF Length(T) > 0 THEN Delete(T,1,1);
  389.                     PrintSoloByte(U,T);
  390.                     IF (TCod AND $02) <> 0  THEN T := 'INLINE Code Bytes'
  391.                                 ELSE T := 'offset in PROC Map';
  392.                     PrintWd(U,T);
  393.                     IF Scop = 0 THEN T := 'no containing scope'
  394.                             ELSE T := 'LL(containing scope)';
  395.                     PrintWd(U,T);
  396.                     IF SHsh = 0 THEN T := 'no local Hash Table'
  397.                             ELSE T := 'LL(local scope Hash Table)';
  398.                     PrintWd(U,T);
  399.                     IF (SVMO <> 0) AND (SVMO <> $FFFF)
  400.                         THEN T := 'Method PTR offset in VMT'
  401.                         ELSE T := 'not a VIRTUAL Method';
  402.                     PrintWd(U,T);
  403.                     IF Smth = 0 THEN T := 'no successor Methods'
  404.                             ELSE T := 'LL(Next Method for Object)';
  405.                     PrintWd(U,T);
  406.                     SetCol(1);
  407.                     END; {CASE 'S'}
  408.             END; {CASE DForm OF}
  409.         END; {WITH}
  410.  
  411.     END;  {PrintDictEntry}
  412.  
  413.     PROCEDURE PrintTypeEntry;                    {.CP46}
  414.     VAR T : TypePtr; W : String[64]; D : DictHeadPtr; I : Integer;
  415.  
  416.     BEGIN {PrintTypeEntry}
  417.         T := TypePtr(PtrAdjust(U,SurveyWork.LocLL));
  418.         I := 0;
  419.         CASE T^.Typ OF
  420.             $01, $02, $09: I := 2; $04, $05, $07, $08: I := 1;
  421.             $0C..$0F: I := 3; $03: I := 10;  $06: I := 7 + 2*T^.PNPrm;
  422.         END; {CASE}
  423.         W := '';
  424.         IF SurveyWork.LocOwn <> 0
  425.         THEN W := NameOfMethod(U,SurveyWork.LocOwn)
  426.         ELSE
  427.             IF T^.Typ = $03
  428.                 THEN W := NameOfMethod(U,T^.ObjtName);
  429.         IF (W <> '') AND (W <> '???') THEN W := ' For: "' + W + '"';
  430.         PrintTitleBlk('Type Descriptor' + W,I+2);
  431.         WITH T^ DO BEGIN
  432.             PrintBytes(U,2,8);SetCol(TabStop);
  433.             CASE Typ OF
  434.                 $00: W := 'un-typed';       $01: W := 'Array';
  435.                 $02: W := 'Record';         $03: W := 'Object';
  436.                 $04: W := 'File';           $05: W := 'Text';
  437.                 $06: W := 'Procedure';      $07: W := 'Set';
  438.                 $08: W := 'Pointer';        $09: W := 'String';
  439.                 $0A: CASE TMod OF
  440.                     $00: W := 'Single';       $02: W := 'Extended';
  441.                     $04: W := 'Double';       $06: W := 'Comp';
  442.                     ELSE W := '8087-Floating?'
  443.                      END; {CASE TMod}
  444.                 $0B: W := 'Real';
  445.                 $0C: CASE TMod OF
  446.                     $00: W := 'un-named byte integer';  $01: W := 'ShortInt';
  447.                     $02: W := 'Byte';      $04: W := 'un-named word integer';
  448.                     $05: W := 'Integer';   $06: W := 'Word';
  449.                     $0C: W := 'un-named double-word integer';
  450.                     $0D: W := 'LongInt';
  451.                     ELSE W := 'unknown integer type';
  452.                      END; {CASE TMod}
  453.                 $0D: W := 'Boolean';     $0E: W := 'Char';
  454.                 $0F: W := 'enumeration';
  455.                 ELSE W := 'unknown type code';
  456.             END; {CASE Typ OF}
  457.             PutTxt('Type='+W);
  458.             PrintWd(U,'Storage Width (bytes)');
  459.             CASE Typ OF                        {.CP05}
  460.                 $01: BEGIN
  461.                     PrintLG(U,'Base Type Desc');
  462.                     PrintLG(U,'Array Bounds');
  463.                      END;
  464.                 $02: BEGIN                    {.CP04}
  465.                     PrintLL(U,'Field List Hash Table');
  466.                     PrintLL(U,'Dict Entry of 1st Field');
  467.                      END;
  468.                 $03: BEGIN                    {.CP17}
  469.                     PrintLL(U,'Field/Method Hash Table');
  470.                     PrintLL(U,'Field/Method Dictionary');
  471.                     WITH ObjtOwnr DO
  472.                         IF NilLG(U,NextLL)
  473.                         THEN PrintLG(U,'nothing inherited')
  474.                         ELSE PrintLG(U,'ancestor Object Desc');
  475.                     PrintWd(U,'Size of VMT (bytes)');
  476.                     IF ObjtDMap = $FFFF
  477.                         THEN PrintWd(U,'there is no VMT')
  478.                         ELSE PrintWd(U,'DSeg Map Offset of VMT Skeleton');
  479.                     IF ObjtVMTO = $FFFF
  480.                         THEN PrintWd(U,'Object has no VIRTUAL Methods')
  481.                         ELSE PrintWd(U,'Offset in Object to VMT Pointer');
  482.                     D := AddrDict(U,ObjtName);
  483.                     PrintLL(U,'Dict Entry ('+D^.DSymb+')');
  484.                      END;
  485.                 $06: BEGIN                    {.CP21}
  486.                     IF NilLG(U,NextLL)
  487.                     THEN PrintLG(U,'Procedures have no Function Result')
  488.                     ELSE PrintLG(U,'Function Result Type');
  489.                     IF PNPrm = 0 THEN PrintWd(U,'no parameter list') ELSE
  490.                     BEGIN
  491.                         Str(PNPrm,W); W := W + ' Formal Parameter';
  492.                         IF PNPrm > 1 THEN W := W + 's';
  493.                         PrintWd(U,W);
  494.                         FOR I := 1 TO PNPrm DO WITH PFPar[I] DO BEGIN
  495.                             Str(I,W);
  496.                             PrintLG(U,'Parm ' + W + ' TypDesc');
  497.                             IF ALM = $02
  498.                             THEN W := 'Pass VALUE on Stack'
  499.                             ELSE IF ALM = $06
  500.                                 THEN W := 'Pass ADDRESS on Stack'
  501.                                 ELSE W := '**** NEW CODE VALUE ***';
  502.                             PrintSoloByte(U,W)
  503.                         END; {FOR}
  504.                     END;
  505.                      END;  { CASE $06 }
  506.                 $04..                        {.CP20}
  507.                 $05: PrintLG(U,'Base File TypeDesc');
  508.                 $07: PrintLG(U,'Base Set TypeDesc');
  509.                 $08: PrintLG(U,'Base Ptr TypeDesc');
  510.                 $09: BEGIN
  511.                     PrintLG(U,'Type[array of char]');
  512.                     PrintLG(U,'Array Bounds TypeDesc');
  513.                      END;
  514.                 $0C..                                                      {.CP12}
  515.                 $0F: BEGIN
  516.                     PrintBytes(U,SizeOf(T^.LoBnd),8);
  517.                     SetCol(TabStop);PutTxt('Subrange Lower Bound');
  518.                     PrintBytes(U,SizeOf(T^.HiBnd),8);
  519.                     SetCol(TabStop);PutTxt('Subrange Upper Bound');
  520.                     PrintLG(U,'Upward Compat TypeDesc');
  521.                      END; { $0C,$0D,$0E,$0F}
  522.             END; {CASE Typ OF}
  523.         END; {WITH}
  524.  
  525.     END;  {PrintTypeEntry}
  526.  
  527.     PROCEDURE PrintHashEntry;                    {.CP22}
  528.     VAR H : HashPtr;
  529.  
  530.         FUNCTION PrintEmptyHash(Bot,Top:Word):Word;
  531.         VAR  I, J, K : Word;
  532.         BEGIN
  533.             I := Bot;
  534.             WITH H^ DO REPEAT
  535.                     IF Slt[I] = 0
  536.                     THEN Inc(I)
  537.                     ELSE Top := I-1;
  538.                    UNTIL Top < I;
  539.             K := 0;
  540.             WITH H^ DO FOR J := Bot TO Top DO BEGIN
  541.                 IF (K AND $3)=0 THEN PrintAddress(NextLL);
  542.                 PutTxt(HexB(LO(Slt[J]))+' ');
  543.                 PutTxt(HexB(HI(Slt[J]))+' ');
  544.                 Inc(NextLL,2);
  545.                 Inc(K);
  546.             END;
  547.             PrintEmptyHash := I
  548.         END; {PrintEmptyHash}
  549.  
  550.     VAR  D : DictHeadPtr; I, J, K, N : Word; W : String[44];    {.CP26}
  551.  
  552.     BEGIN {PrintHashEntry}
  553.         H := AddrHash(U,SurveyWork.LocLL);
  554.         N := H^.Bas DIV 2;
  555.         W := '';
  556.         IF SurveyWork.LocLL = U^.UGHsh
  557.         THEN W := '- INTERFACE Dictionary'    ELSE
  558.         IF SurveyWork.LocLL = U^.UHash2
  559.         THEN W := '- Turbo DEBUG Dictionary'    ELSE
  560.         IF SurveyWork.LocOwn <> 0
  561.         THEN W := 'Owned By: "'+NameOfMethod(U,SurveyWork.LocOwn)+'"';
  562.         PrintTitleBlk('Hash Table '+W,3);
  563.         PrintWd(U,'Bytes in Hash Table - 2');
  564.         SetCol(1);PutTxt('----');
  565.         I := 0;
  566.  
  567.         WITH H^ DO REPEAT
  568.             IF Slt[I] <> 0 THEN
  569.             BEGIN
  570.                 PrintLL(U,AddrDict(U,Slt[I])^.DSymb);
  571.                 Inc(I)
  572.             END ELSE I := PrintEmptyHash(I,N);
  573.         UNTIL I > N;
  574.         NewTxtLine;
  575.     END;  {PrintHashEntry}
  576.  
  577.     PROCEDURE PrintInLineEntry;                    {.CP15}
  578.     VAR D : DictHeadPtr; S : DictStubPtr; I : Integer;  T : TypePtr;
  579.  
  580.     BEGIN {PrintInLineEntry}
  581.         D := AddrDict(U,SurveyWork.LocOwn);   { Procedure  Header }
  582.         S := AddrStub(D);                     { Procedure  Stub   }
  583.         T := AddrProcType(S);                 { Type Descriptor   }
  584.         WITH SurveyWork, T^ DO BEGIN
  585.             I := (S^.BCod+15) SHR 4;
  586.             PrintTitleBlk('INLINE Code Bytes FOR: "'+
  587.                     NameOfMethod(U,SurveyWork.LocOwn)+'"',I);
  588.             PrintBytes(U,S^.BCod,16);
  589.             SetCol(1);
  590.         END;
  591.     END;  {PrintInLineEntry}
  592.  
  593. VAR I : Word; BU : SurveyRec; DoneHash : Boolean; BUL : LL;    {.CP27}
  594. BEGIN {FormatDictionary}
  595.     NoteBegin('Formatting Dictionary');
  596.     DoneHash := False;
  597.     WITH SurveyWork DO
  598.     FOR I := 1 TO SurveyQueTop DO BEGIN
  599.         SurveyWork := SurveyQuePtr^.Svy[I];
  600.         IF I < SurveyQueTop
  601.         THEN LastLL := SurveyQuePtr^.Svy[I+1].LocLL
  602.         ELSE LastLL := U^.UHPrc;
  603.         BU := SurveyWork;
  604.         IF NextLL < LocLL THEN
  605.         IF NOT DoneHash THEN PrintUnknowns(U,LocLL) ELSE
  606.         BEGIN
  607.             BUL := LastLL;
  608.             LocLL := NextLL; LastLL := BU.LocLL;
  609.             LocOwn := 0; LocTyp := 'T';
  610.             PrintTypeEntry;
  611.             SurveyWork := BU; LastLL := BUL;
  612.         END;
  613.         CASE LocTyp OF
  614.             'D': PrintDictEntry;
  615.             'T': PrintTypeEntry;
  616.             'H': BEGIN PrintHashEntry; DoneHash := True END;
  617.             'I': PrintInLineEntry;
  618.         END; {CASE}
  619.     END;   {FOR}
  620.     IF NextLL < U^.UHPrc THEN PrintUnknowns(U,U^.UHPrc);        {.CP9}
  621.     FreeMem(SurveyQuePtr,SurveySize);
  622.     FreeMem(SurveyStkPtr,SurveySize);
  623.     SurveyQuePtr := Nil;
  624.     SurveyStkPtr := Nil;
  625.     SurveyQueTop := 0;
  626.     SurveyStkTop := 0;
  627.     NoteEnd;
  628. END;  {FormatDictionary}
  629.  
  630. FUNCTION SearchSurveyQue(Locn : LL):Word;                {.CP17}
  631. VAR Lo, Mid, Hi : Word;
  632. BEGIN
  633.     IF SurveyQueTop < 1 THEN SearchSurveyQue := 1 ELSE
  634.     WITH SurveyQuePtr ^ DO
  635.     BEGIN
  636.         Lo := 1; Hi := SurveyQueTop;
  637.         REPEAT
  638.             Mid := Longint(Lo + Hi) SHR 1;
  639.             IF Locn > Svy[Mid].LocLL
  640.             THEN Lo := Mid + 1
  641.             ELSE Hi := Mid - 1
  642.         UNTIL (Svy[Mid].LocLL=Locn) OR (Lo > Hi);
  643.         IF Locn > Svy[Mid].LocLL THEN Mid := Mid+1;
  644.         SearchSurveyQue := Mid;
  645.     END;     {WITH}
  646. END; {SearchSurveyQue}
  647.  
  648. PROCEDURE AddToSurveyQue(U : UnitHeadPtr; Arg : SurveyRec);        {.CP23}
  649.  
  650. VAR I, Key : LL;
  651. BEGIN
  652.     Key := SearchSurveyQue(Arg.LocLL);
  653.     IF Arg.LocLL < U^.UHPrc THEN
  654.     WITH SurveyQuePtr^ DO
  655.     IF Key > SurveyQueTop THEN
  656.     BEGIN
  657.         SurveyQueTop := SurveyQueTop + 1;
  658.         Svy[SurveyQueTop] := Arg
  659.     END ELSE
  660.     IF Arg.LocLL <> Svy[Key].LocLL THEN
  661.     BEGIN
  662.         SurveyQueTop := SurveyQueTop + 1;
  663.         FOR I := SurveyQueTop DownTo Key+1 DO
  664.             Svy[I] := Svy[I-1];
  665.         Svy[Key] := Arg
  666.     END;
  667.     WITH SurveyQuePtr^ DO
  668.     IF Svy[Key].LocOwn = 0        THEN Svy[Key].LocOwn := Arg.LocOwn;
  669.     IF SurveyQueTop > SurveyQueMax    THEN SurveyQueMax := SurveyQueTop;
  670. END; {AddToSurveyQue}
  671.  
  672. PROCEDURE AddToSurveyStk(U : UnitHeadPtr; ArgLoc,ArgOwn:LL; ArgTyp:Char);{.CP13}
  673.  
  674. VAR Arg : SurveyRec;
  675. BEGIN
  676.     Arg.LocLL := ArgLoc; Arg.LocOwn := ArgOwn; Arg.LocTyp := ArgTyp;
  677.     WITH SurveyStkPtr^ DO
  678.     BEGIN
  679.         SurveyStkTop := SurveyStkTop + 1;
  680.         IF SurveyStkTop > SurveyStkMax
  681.             THEN SurveyStkMax := SurveyStkTop;
  682.         Svy[SurveyStkTop] := Arg
  683.     END
  684. END; {AddToSurveyStk}
  685.  
  686. PROCEDURE PopFromSurveyStk(VAR Arg : SurveyRec);            {.CP05}
  687. BEGIN
  688.     Arg := SurveyStkPtr^.Svy[SurveyStkTop];
  689.     Dec(SurveyStkTop);
  690. END; {PopFromSurveyStk}
  691.  
  692. FUNCTION IsInSurveyQue(Key : LL):Boolean;                {.CP11}
  693. VAR Loc : Word;
  694. BEGIN
  695.     Loc := SearchSurveyQue(Key);
  696.     IF Loc > SurveyQueTop
  697.     THEN IsInSurveyQue := False
  698.     ELSE
  699.         IF Key = SurveyQuePtr^.Svy[Loc].LocLL
  700.         THEN IsInSurveyQue := True
  701.         ELSE IsInSurveyQue := False
  702. END; {IsInSurveyQue}
  703.  
  704. PROCEDURE SurveyDictionary(U:UnitHeadPtr);            {.CP03}
  705.  
  706.     PROCEDURE SurveyWrapUp;
  707.  
  708.         PROCEDURE SurveyWrapPost(x,s:LL);        {.CP09}
  709.         VAR J : LL;
  710.         BEGIN
  711.             j := SearchSurveyQue(s);
  712.             WITH SurveyQuePtr^.Svy[j] DO
  713.             IF LocLL = s THEN
  714.             IF (LocOwn > x) OR (LocOwn = 0)
  715.             THEN LocOwn := x;
  716.         END;
  717.  
  718.         PROCEDURE SurveyWrapType(x : LL);        {.CP26}
  719.         VAR D : DictHeadPtr; S : DictStubPtr; T : TypePtr; i,j,k : LL;
  720.         BEGIN
  721.             D := AddrDict(U,x); { Q entry }
  722.             S := AddrStub(D);   { its stub }
  723.             T := AddrType(U,S^.QTG);
  724.             IF T <> Nil THEN  { TD in this unit }
  725.             BEGIN
  726.                 SurveyWrapPost(x,S^.QTG.UntLL);
  727.                 IF (T^.Typ = 2) OR (T^.Typ = 3) THEN
  728.                 BEGIN
  729.                     i := T^.RecdDict;
  730.                     IF i <> x THEN
  731.                     WHILE i <> 0 DO BEGIN
  732.                         SurveyWrapPost(x,i);
  733.                         D := AddrDict(U,i);
  734.                         S := AddrStub(D);
  735.                         IF D^.DForm = 'R'
  736.                         THEN i := S^.ROB ELSE
  737.                         IF D^.DForm = 'S'
  738.                         THEN i := S^.Smth
  739.                         ELSE i := 0;
  740.                     END
  741.                 END
  742.             END
  743.         END;    {SurveyWrapType}
  744.  
  745.     VAR i : Integer;                    {.CP08}
  746.     BEGIN
  747.         For i := 1 TO SurveyQueTop DO
  748.             WITH SurveyQuePtr^.Svy[i] DO
  749.             IF LocTyp = 'D' THEN
  750.             IF AddrDict(U,LocLL)^.DForm = 'Q'
  751.             THEN SurveyWrapType(LocLL)
  752.     END;    {SurveyWrapUp}
  753.  
  754.     PROCEDURE SurveyType(Arg : SurveyRec);            {.CP52}
  755.     VAR T, TT : TypePtr; H:HashPtr; TTL : LL; I : Integer;
  756.     BEGIN {SurveyType}
  757.         T := TypePtr(PtrAdjust(U,Arg.LocLL));
  758.         TTL := Arg.LocLL;
  759.         IF T <> Nil THEN
  760.         WITH T^ DO
  761.         CASE Typ OF
  762.             $01: BEGIN
  763.                 IF   AddrType(U,BaseType) <> Nil
  764.                 THEN AddToSurveyStk(U,BaseType.UntLL,0,'T');
  765.                 IF   AddrType(U,BounDesc) <> Nil
  766.                 THEN AddToSurveyStk(U,BounDesc.UntLL,0,'T');
  767.                  END; {CASE $01}
  768.             $02: IF RecdHash <> 0 THEN
  769.                 AddToSurveyStk(U,RecdHash,Arg.LocOwn,'H');
  770.             $03: IF ObjtHash <> 0 THEN
  771.                 AddToSurveyStk(U,ObjtHash,ObjtName,'H');
  772.             $04,
  773.             $05: IF AddrType(U,FileType) <> Nil THEN
  774.                 AddToSurveyStk(U,FileType.UntLL,0,'T');
  775.             $06: BEGIN
  776.                 IF AddrType(U,T^.PFRes) <> Nil THEN
  777.                 AddToSurveyStk(U,T^.PFRes.UntLL,Arg.LocOwn,'T');
  778.                 { Handle Parameter List Entries Here }
  779.                 FOR I := 1 TO T^.PNPrm DO WITH T^.PFPar[I] DO
  780.                     IF AddrType(U,TDG) <> Nil THEN
  781.                     AddToSurveyStk(U,TDG.UntLL,Arg.LocOwn,'T');
  782.                 END; {CASE $06}
  783.             $07: IF AddrType(U,SetBase) <> Nil THEN
  784.                 AddToSurveyStk(U,SetBase.UntLL,0,'T');
  785.             $08: IF AddrType(U,PtrBase) <> Nil THEN
  786.                 AddToSurveyStk(U,PtrBase.UntLL,0,'T');
  787.             $09: BEGIN
  788.                 IF AddrType(U,StrBase) <> Nil THEN
  789.                 AddToSurveyStk(U,StrBase.UntLL,0,'T');
  790.                 IF AddrType(U,StrBound) <> Nil THEN
  791.                 AddToSurveyStk(U,StrBound.UntLL,0,'T');
  792.                  END; {CASE $09}
  793.             $0C,
  794.             $0D,
  795.             $0E: IF AddrType(U,Cmpat) <> Nil THEN
  796.                 AddToSurveyStk(U,Cmpat.UntLL,0,'T');
  797.             $0F: BEGIN                                                   {.CP09}
  798.                 IF AddrType(U,Cmpat) <> Nil THEN
  799.                 AddToSurveyStk(U,Cmpat.UntLL,0,'T');
  800.                 { now stack the SET descriptor that follows }
  801.                 TT := TypePtr(PtrAdjust(@Cmpat,SizeOf(T^.Cmpat)));
  802.                 AddToSurveyStk(U,FormLL(U,TT),0,'T');
  803.                  END; {CASE $0F}
  804.         END;  {CASE Typ}
  805.     END;  {SurveyType}
  806.  
  807.     PROCEDURE SurveyDictStub(D : DictHeadPtr;            {.CP39}
  808.                  S : DictStubPtr; Owner : LL);
  809.  
  810.     VAR T : TypePtr; H : HashPtr; I : Integer; LLDE : LL; C : Char;
  811.     BEGIN {SurveyDictStub}
  812.         C := D^.DForm;
  813.         LLDE := FormLL(U,D);
  814.         WITH S^ DO
  815.         CASE C OF
  816.             'P': IF AddrType(U,DTG) <> Nil THEN
  817.                 AddToSurveyStk(U,DTG.UntLL,0,'T');
  818.             'Q': IF AddrType(U,QTG) <> Nil THEN
  819.                 AddToSurveyStk(U,QTG.UntLL,LLDE,'T');
  820.             'X': IF AddrType(U,QTG) <> Nil THEN
  821.                 AddToSurveyStk(U,QTG.UntLL,0,'T');
  822.             'R': IF AddrType(U,RLG) <> Nil THEN
  823.                 AddToSurveyStk(U,RLG.UntLL,0,'T');
  824.  
  825.             'S': BEGIN
  826.                 IF SHsh <> 0 THEN AddToSurveyStk(U,SHsh,LLDE,'H');
  827.                 T := AddrProcType(S);
  828.                 AddToSurveyStk(U,FormLL(T,U),LLDE,'T');
  829.                 IF AddrType(U,T^.PFRes) <> Nil THEN
  830.                 AddToSurveyStk(U,T^.PFRes.UntLL,0,'T');
  831.                 { Handle Parameter List Entries Here }
  832.                 FOR I := 1 TO T^.PNPrm DO WITH T^.PFPar[I] DO
  833.                 IF AddrType(U,TDG) <> Nil THEN
  834.                 AddToSurveyStk(U,TDG.UntLL,0,'T');
  835.                 IF (TCod AND $02) <> 0 THEN
  836.                 AddToSurveyStk(U,FormLL(U,@T^.PFPar[T^.PNPrm+1]),LLDE,'I');
  837.                  END; {CASE 'S'}
  838.  
  839.             'Y': BEGIN                                                 {.CP07}
  840.                 IF UA <> 0 THEN AddToSurveyStk(U,UA,0,'D');
  841.                 IF UZ <> 0 THEN AddToSurveyStk(U,UZ,0,'D');
  842.                  END; {CASE 'Y'}
  843.  
  844.         END; {CASE D^.DForm}
  845.     END;  {SurveyDictStub}
  846.  
  847.     PROCEDURE SurveyDictHdr(Arg : SurveyRec);        {.CP09}
  848.     VAR D : DictHeadPtr; S : DictStubPtr;
  849.     BEGIN {SurveyDictHdr}
  850.         D := AddrDict(U,Arg.LocLL);
  851.         S := AddrStub(D);
  852.         SurveyDictStub(D,S,Arg.LocLL);
  853.         IF D^.HLink <> 0 THEN
  854.         AddToSurveyStk(U,D^.HLink,0,'D');
  855.     END; {SurveyDictHdr}
  856.  
  857.     PROCEDURE SurveyHashTab(Arg : SurveyRec);        {.CP08}
  858.     VAR HLim, I : LL; H : HashPtr;
  859.     BEGIN {SurveyHashTab}
  860.         H := AddrHash(U,Arg.LocLL);
  861.         HLim := (H^.Bas DIV SizeOf(LL));
  862.         WITH H^ DO FOR I := 0 TO HLim DO
  863.         IF Slt[I] <> 0 THEN AddToSurveyStk(U,Slt[I],Arg.LocOwn,'D');
  864.     END; {SurveyHashTab}
  865.  
  866. BEGIN  {SurveyDictionary}                    {.CP33}
  867.     NoteBegin('Surveying Dictionary');
  868.     SurveySize := (U^.UHPrc-U^.UGHsh) + SizeOf(SurveyRec) - 1;
  869.     SurveySize := SurveySize-(SurveySize MOD SizeOf(SurveyRec));
  870.     GetMem(SurveyQuePtr,SurveySize);
  871.     GetMem(SurveyStkPtr,SurveySize);
  872.     SurveyLimit := SurveySize DIV SizeOf(SurveyRec);
  873.     SurveyQueTop := 0; SurveyQueMax := 0;
  874.     SurveyStkTop := 0; SurveyStkMax := 0;
  875.  
  876.     WITH U^ DO BEGIN
  877.     AddToSurveyStk(U,UGHsh,UDirE,'H');    { INTERFACE Hash Table  }
  878.     AddToSurveyStk(U,UDirE,0,'D');        { Unit Dictionary Entry }
  879.     IF UGHsh <> UHash2 THEN
  880.     AddToSurveyStk(U,UHash2,UHash2,'H');    { Debug Rtn Hash Table  }
  881.     END;
  882.  
  883.     WITH SurveyWork DO
  884.     WHILE SurveyStkTop > 0 DO  BEGIN
  885.         PopFromSurveyStk(SurveyWork);
  886.         IF NOT IsInSurveyQue(LocLL) THEN
  887.         BEGIN
  888.             AddToSurveyQue(U,SurveyWork);
  889.             CASE LocTyp OF
  890.                 'D': SurveyDictHdr(SurveyWork);
  891.                 'H': SurveyHashTab(SurveyWork);
  892.                 'T': SurveyType(SurveyWork);
  893.             END; {CASE}
  894.         END; {IF}
  895.     END; {WHILE}
  896.     SurveyWrapUp;        {Resolve Type Descriptor Names}
  897.     NoteEnd;
  898. END;   {SurveyDictionary}
  899.  
  900. FUNCTION NameOfObject(U:UnitHeadPtr;UsrDE:LL):LexNam;        {.CP15}
  901. VAR D : DictHeadPtr; T : TypePtr;
  902. BEGIN
  903.     IF UsrDE = $0000 THEN NameOfObject := '???' ELSE
  904.     BEGIN
  905.         T  := TypePtr(PtrAdjust(U,UsrDE));    {to Object TD}
  906.         D  := Nil;
  907.         IF T^.Typ = $03 THEN
  908.         BEGIN
  909.             D  := DictHeadPtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  910.             NameOfObject := D^.Dsymb
  911.         END ELSE
  912.             NameOfObject := '???'
  913.     END
  914. END;  {NameOfObject}
  915. {$F+}
  916. PROCEDURE CSegHeadings;                        {.CP09}
  917. BEGIN
  918.     SetCol(8);
  919.     PutTxt('Entry   Turbo Segmt Relo  Trace : Source File   Load 1''st n''th');
  920.     SetCol(8);
  921.     PutTxt('Offset  Work? Bytes Bytes Entry : For CODE Seg  ADDR Relo Relo');
  922.     SetCol(8);
  923.     PutTxt('------  ----- ----- ----- ----- : ------------  ---- ---- ----');
  924. END; {CSegHeadings}{$F-}
  925.  
  926. PROCEDURE FormatCSegMap(UPt:UnitHeadPtr;                {.CP23}
  927.             VAR PE:PMapRefTab;PELim:Word;
  928.             VAR CE:CMapRefTab;CELim:Word);
  929.  
  930. VAR    C : CSegMapTabPtr; SF : SrcFilePtr;
  931.     D : DictHeadPtr;    T : TypePtr;
  932.     I, J, K, OldTabSet, Base, RBase : Word;
  933. BEGIN
  934.     NoteBegin('Formatting CSeg Map');
  935.     OldTabSet := TabStop;
  936.     TabStop := 42;
  937.     RBase :=  (UPt^.UndNC  + $F) AND $FFF0;
  938.     RBase :=  (UPt^.ULCod  + $F) AND $FFF0 + RBase;
  939.     RBase :=  (UPt^.ULTCon + $F) AND $FFF0 + RBase;
  940.  
  941.     IF NMapC > 0 THEN    { make sure CSeg Map non-empty }    {.CP33}
  942.     BEGIN
  943.         PrintTitleBlk('CSeg Map Table Begins Here (LL at 000E)',7);
  944.         NextLL := Upt^.UHCsg;
  945.         I := 0;
  946.         K := 0;
  947.         CSegHeadings; Base := NextLL;
  948.         REPEAT
  949.             PageOverFlow(6,CSegHeadings);
  950.             SF := AddrSrcTabOff(UPt,CE.CmRefs[I].CmNdxF);
  951.             PrintCodeBytes(UPt,8,8,Base);
  952.             SetCol(TabStop);
  953.             PutTxt(SF^.SrcName);
  954.             SetCol(TabStop+14);
  955.             PutTxt(HexW(CE.CmRefs[i].CmSegL)+' ');
  956.             IF CE.CmRefs[i].CmNdxR <= CE.CmRefs[i].CmCntR THEN
  957.             BEGIN
  958.                 j := CE.CmRefs[i].CmNdxR;
  959.                 PutTxt(HexW(RBase+SizeOf(ReloListEntry)*j)+' ');
  960.                 j := CE.CmRefs[i].CmCntR;
  961.                 PutTxt(HexW(RBase+SizeOf(ReloListEntry)*j));
  962.             END;
  963.             I := I + 1;
  964.         UNTIL I > CELim-1;
  965.     END;
  966.     TabStop := OldTabSet;
  967.     NoteEnd;
  968. END;  { FormatCSegMap }
  969. {$F+}
  970. PROCEDURE ProcHeadings;
  971. BEGIN
  972.     SetCol(8); PutTxt('Entry   CSeg  PROC  : Jump Byte   Name Of');
  973.     SetCol(8); PutTxt('Offset  Map^  Ofset : Addr Cnt   Procedure');
  974.     SetCol(8); PutTxt('------  ----- ----- : ---- ----  ----------');
  975. END; {ProcHeadings}{$F-}
  976.  
  977. PROCEDURE FormatProcMap(UPt:UnitHeadPtr;VAR PE:ProcMapTab;Limit:Word);    {.CP10}
  978.  
  979. TYPE V = ARRAY[0..1] OF Word; Vector = ^V; 
  980.  
  981.     FUNCTION UnravelPMapSort:Vector;            {.CP11}
  982.     VAR VP : Vector; i : Word;
  983.     BEGIN
  984.         IF PMapP = Nil THEN VP := Nil ELSE
  985.         BEGIN
  986.             GetMem(VP,NMapP*SizeOf(WORD));
  987.             FOR i := 0 TO NMapP-1 DO WITH PMapP^.PMRefs[i] DO
  988.                 VP^[PmNdxP] := i;
  989.         END;
  990.         UnravelPMapSort := VP
  991.     END;    {UnravelPMapSort}
  992.  
  993. VAR     Base, I, J, OldTabStop : Word; VP : Vector; {.CP25}
  994. BEGIN {FormatProcMap}
  995.     NoteBegin('Formatting PROC Map');
  996.     OldTabStop := TabStop;
  997.     TabStop := 30;
  998.     SetCol(1);
  999.     VP := UnravelPMapSort;
  1000.     IF CountPMapSlots(UPt) > 0 THEN  { Make Sure PROC Map not empty }
  1001.     BEGIN
  1002.         PrintTitleBlk('PROC Map Table Begins Here (LL at 000C)',7);
  1003.         NextLL := Upt^.UHPrc;
  1004.         I := 0; Base := NextLL;
  1005.         ProcHeadings;
  1006.         WITH PMapP^,UPt^ DO REPEAT
  1007.             PageOverFlow(3,PROCHeadings);
  1008.             PrintCodeBytes(UPt,4,4,Base);
  1009.             SetCol(TabStop);
  1010.             PutTxt(HexW(PmRefs[VP^[i]].PmEntP)+' ');
  1011.             PutTxt(HexW(PmRefs[VP^[i]].PmSizP)+'  ');
  1012.             IF I = 0 THEN
  1013.                 IF ProcMapPtr(PtrAdjust(UPt,UHPrc))^.ProcMap[0].CSegOfs = $FFFF
  1014.                 THEN PutTxt('Not Used (No Unit Init Code)')
  1015.                 ELSE PutTxt('Unit Initialization Code')
  1016.             ELSE PutTxt(NameOfMethod(UPt,PmRefs[VP^[i]].PmDirN));
  1017.             I := I + 1;
  1018.         UNTIL NextLL >= UHCsg;
  1019.     END;
  1020.     FreeMem(VP,NMapP*SizeOf(Word));
  1021.     TabStop := OldTabStop;
  1022.     NoteEnd;
  1023. END; {FormatProcMap}
  1024. {$F+}
  1025. PROCEDURE CONSTHeadings;
  1026. BEGIN
  1027.     SetCol(8); PutTxt('Entry   Turbo Segmt Relo   VMT ');
  1028.     SetCol(8); PutTxt('Offset  Work? Bytes Bytes Owner');
  1029.     SetCol(8); PutTxt('------  ----- ----- ----- -----');
  1030. END; {CONSTHeadings}{$F-}
  1031.  
  1032. PROCEDURE FormatTypedConMap(UPt:UnitHeadPtr);            {.CP42}
  1033.  
  1034. VAR C : DSegMapTabPtr; Wk : Str4;  I, J, K : Integer; T:TypePtr;
  1035.     Base : Word;
  1036. BEGIN { FormatTypedConMap }
  1037.     NoteBegin('Formatting CONST DSeg Map');
  1038.     IF CountDMapSlots(UPt) > 0 THEN
  1039.     BEGIN
  1040.         PrintTitleBlk('CONST DSeg Map Begins Here (LL at 0010)',7);
  1041.         K := TabStop;
  1042.         TabStop := 42;
  1043.         NextLL := Upt^.UHDsT;
  1044.         Base := NextLL;
  1045.         C := AddrDMapTab(UPt);
  1046.         J := CountDMapSlots(UPt)-1;
  1047.         CONSTHeadings;
  1048.         FOR I := 0 TO J DO WITH C^.DSegMap[I] DO
  1049.         BEGIN
  1050.             PageOverFlow(7,ConstHeadings);
  1051.             PrintCodeBytes(UPt,8,8,Base);
  1052.             SetCol(TabStop);
  1053.             PutTxt('Owned By ');
  1054.             IF DSegOwn <> $0000
  1055.             THEN PutTxt(NameOfObject(UPt,DSegOwn))
  1056.             ELSE PutTxt('???');
  1057.             NewTxtLine;
  1058.         END; { FOR }
  1059.         TabStop := K;
  1060.     END; { IF }
  1061.     NoteEnd;
  1062. END;  { FormatTypedConMap }
  1063. {$F+}
  1064. PROCEDURE VARHeadings;
  1065. BEGIN
  1066.     SetCol(8); PutTxt('Entry   Turbo Segmt Usage Usage');
  1067.     SetCol(8); PutTxt('Offset  Work? Bytes  ???   ??? ');
  1068.     SetCol(8); PutTxt('------  ----- ----- ----- -----');
  1069. END; {VARHeadings}{$F-}
  1070.  
  1071. PROCEDURE FormatGlobalVarMap(U : UnitHeadPtr);            {.CP42}
  1072.  
  1073. VAR Base, I : Word; SaveTab : Integer;
  1074. BEGIN
  1075.     NoteBegin('Formatting Global VAR Map');
  1076.     SaveTab := TabStop;
  1077.     TabStop := 42;
  1078.     IF U^.UHDsV <> U^.URULt THEN
  1079.     BEGIN
  1080.         I := 0;
  1081.         PrintTitleBlk('Global VAR DSeg Map Begins Here (LL at 0012)',5);
  1082.         VARHeadings;
  1083.         NextLL := U^.UHDsV;
  1084.         Base := NextLL;
  1085.         WHILE U^.URULt > NextLL DO
  1086.         BEGIN
  1087.             PageOverFlow(5,VARHeadings);
  1088.             PrintCodeBytes(U,8,8,Base);
  1089.             SetCol(TabStop);
  1090.             CASE I OF
  1091.                 0: PutTxt('Owner: INTERFACE');
  1092.                 1: PutTxt('Owner: IMPLEMENTATION');
  1093.             ELSE PutTxt('Owner: ???')
  1094.             END; {CASE}
  1095.             Inc(I);
  1096.             SetCol(1);
  1097.         END;
  1098.     END;
  1099.     TabStop := SaveTab;
  1100.     NoteEnd;
  1101. END; {FormatGlobalVarMap}
  1102.  
  1103. PROCEDURE FormatUnitDonorList(U : UnitHeadPtr);            {.CP22}
  1104. VAR UCP : UnitDonorPtr; UNE : LL;
  1105. BEGIN
  1106.     NoteBegin('Formatting Donor Unit List');
  1107.     SetCol(1);
  1108.     IF U^.USRCF <> NextLL THEN WITH U^ DO
  1109.     BEGIN
  1110.         PrintTitleBlk('Code/Data Donor Units Listed Here (LL at 0014)',2);
  1111.         UCP := UnitDonorPtr(PtrAdjust(U,U^.URULt));
  1112.         WHILE NextLL <> USRCF DO WITH UCP^ DO BEGIN
  1113.             IF LinesRemaining < 2 THEN NewTxtPage;
  1114.             UNE := FormLL(U,UCP)+SizeOf(UDExxx) + 1 + Ord(UDEnam[0]);
  1115.             PrintWd(U,'Offset='+HexW(NextLL-URULt)+', TURBO Work?');
  1116.             PrintBytes(U,1+Ord(UDEnam[0]),9);
  1117.             SetCol(TabStop);
  1118.             PutTxt('=''' + UDEnam + '''');
  1119.             SetCol(1);
  1120.             UCP := UnitDonorPtr(PtrAdjust(U,UNE));
  1121.         END;
  1122.     END;
  1123.     NoteEnd;
  1124. END; {FormatUnitDonorList}
  1125.  
  1126. PROCEDURE FormatSourceFileList(U : UnitHeadPtr);        {.CP52}
  1127. VAR S : SrcFilePtr; SLL : LL; StA : String[10]; StW : String[4];
  1128.     OldTabStop : Integer;
  1129.  
  1130.     PROCEDURE FormatTime(Time : Word);
  1131.     VAR I : Integer;
  1132.     BEGIN
  1133.         Str( Time SHR 11:2,StA);         StA := StA + ':';
  1134.         Str((Time AND 2047) SHR 5:2,StW);StA := StA + StW + ':';
  1135.         Str((Time AND 31) SHL 1:2,StW);  StA := StA + StW;
  1136.         FOR I := 1 TO 7 DO IF StA[I] = ' ' THEN StA[I] := '0';
  1137.     END; {FormatTime}
  1138.  
  1139.     PROCEDURE FormatDate(Date : Word);
  1140.     VAR I : Integer;
  1141.     BEGIN
  1142.         Str((Date AND 511)SHR 5:2,StA); StA := StA + '/';
  1143.         Str( Date AND 31:2,StW);        StA := StA + StW + '/';
  1144.         Str((Date SHR 9) + 1980:4,StW); StA := StA + StW;
  1145.         FOR I := 1 TO 4 DO IF StA[I] = ' ' THEN StA[I] := '0';
  1146.     END; {FormatDate}
  1147.  
  1148. BEGIN {FormatSourceFileList}
  1149.     NoteBegin('Formatting Source File List');
  1150.     OldTabStop := TabStop;
  1151.     TabStop := 48;
  1152.     PrintTitleBlk('Source File List Begins Here (LL at 0016)',5);
  1153.     SLL := U^.UDBTS;
  1154.     S := SrcFilePtr(PtrAdjust(U,NextLL));
  1155.     WHILE SLL <> NextLL DO WITH S^ DO BEGIN
  1156.         IF LinesRemaining < 5 THEN NewTxtPage;
  1157.         PrintSoloByte(U,'Flag');
  1158.         PrintWd(U,'TURBO Work?');
  1159.         CASE SrcFlag OF
  1160.             $03,$04:         { .PAS OR .INC file }
  1161.                 BEGIN
  1162.                     FormatTime(SrcTime); PrintWd(U,'Time-Stamp='+StA);
  1163.                     FormatDate(SrcDate); PrintWd(U,'Date-Stamp='+StA);
  1164.                 END
  1165.             ELSE    BEGIN
  1166.                     PrintBytes(U,4,9);SetCol(TabStop);
  1167.                     PutTxt('NO Time, Date-Stamps');
  1168.                 END
  1169.         END;   { CASE }
  1170.         PrintBytes(U,1+Ord(SrcName[0]),13);
  1171.         SetCol(TabStop);PutTxt('='''+SrcName+'''');
  1172.         SetCol(1);
  1173.         S := AddrNxtSrc(U,S);
  1174.     END;
  1175.     TabStop := OldTabStop;
  1176.     NoteEnd;
  1177. END; {FormatSourceFileList}
  1178.  
  1179. PROCEDURE FormatTraceTable(U : UnitHeadPtr);                {.CP41}
  1180. VAR    T : TraceRecPtr; S,X : String[6]; I,J, Limit : Word;
  1181.     Cp : CSegMapTabPtr; Cx : Integer;
  1182. BEGIN
  1183.     NoteBegin('Formatting Trace Table');
  1184.     SetCol(1);
  1185.     T := AddrTraceTab(U);
  1186.     IF T <> Nil THEN
  1187.     BEGIN
  1188.         Limit := GetTrExecSize(T);
  1189.         Cp := AddrCMapTab(U);
  1190.         Cx := 0;
  1191.         PrintTitleBlk('Trace Table for Turbo Debugger is Next (LL at 0018)',
  1192.                 7+(Limit SHR 3));
  1193.         WHILE T <> Nil DO WITH T^ DO BEGIN
  1194.             Limit := GetTrExecSize(T);
  1195.             IF LinesRemaining < (7+Limit SHR 3) THEN NewTxtPage;
  1196.             IF TrName <> 0
  1197.             THEN PrintLL(U,NameOfMethod(U,TrName))
  1198.             ELSE PrintWd(U,'Unit Init Code Block');
  1199.             PrintWd(U,'Src File: "' + AddrSrcTabOff(U,TrFill)^.SrcName + '"');
  1200.             Str(T^.TrPfx,S);  PrintWd(U,S+' Data bytes precede Code');
  1201.             Str(T^.TrBeg,S);  PrintWd(U,'BEGIN Stmt at Line # '+S);
  1202.             Str(T^.TrLNos,S); PrintWd(U,S+' Lines of Code to Execute');
  1203.             I := 1;
  1204.             WHILE I <= Limit DO BEGIN
  1205.                 J := I + 7;
  1206.                 IF J > Limit THEN J := Limit;
  1207.                 Str(I-1+TrBeg,S); Str(J-1+TrBeg,X);
  1208.                 PrintBytes(U,J+1-I,8);
  1209.                 SetCol(TabStop);
  1210.                 PutTxt('Code Bytes in Lines '+S+' Thru '+X);
  1211.                 NewTxtLine;
  1212.                 I := J + 1;
  1213.             END;
  1214.             T := AddrNxtTrace(U,T);
  1215.             NewTxtLine;
  1216.         END;
  1217.     END;
  1218.     NoteEnd;
  1219. END; {FormatTraceTable}
  1220.  
  1221. PROCEDURE FormatEndNonCode(U : UnitHeadPtr);                {.CP05}
  1222. BEGIN
  1223.     PrintTitleBlk('End Non-Code Part Of Unit (LL at 001A)',0);
  1224.     BoundaryAlign(U);
  1225. END; {FormatEndNonCode}
  1226.  
  1227. PROCEDURE FormatObjectCode(UH : UnitHeadPtr);            {.CP06}
  1228. VAR HexOff : Word;
  1229.  
  1230. VAR    PM : CSegMapTabPtr;  MyFil, MyOrg, MyEnd, MyTrc : LL;
  1231.     SP : SrcFilePtr; R : ReloListPtr;
  1232.     CMaps, CXs, I, J : Integer;      SaveTab : Word; SF : Byte;
  1233.  
  1234.     PROCEDURE DisplayCode(U : UnitHeadPtr; Count: Word;TrcNdx:LL);
  1235.  
  1236.         PROCEDURE DisplayCodeLine(VAR P : ObjArg);    {.CP20}
  1237.         BEGIN
  1238.             WITH P DO WHILE Lim > 0 DO BEGIN
  1239.                 UnAssemble(U,P);
  1240.                 NextLL := Locn;
  1241.                 PrintOffset(HexOff);
  1242.                 SetCol(16);    PutTxt(Code);
  1243.                 SetCol(39);    PutTxt(Mnem);
  1244.                 SetCol(55);    PutTxt(Opr1);
  1245.                 IF Length(Opr2) > 0 THEN PutTxt(','+Opr2);
  1246.                 IF Length(Opr3) > 0 THEN
  1247.                 BEGIN
  1248.                     IF Opr3[1] <> ';'
  1249.                         THEN PutTxt(',')
  1250.                         ELSE PutTxt(' ');
  1251.                     PutTxt(Opr3)
  1252.                 END;
  1253.                 NewTxtLine;
  1254.             END;
  1255.         END;    {DisplayCodeLine}
  1256.  
  1257.     VAR    P : ObjArg;   I,J,K,L:Word; Limit, IP : LL;        {.CP42}
  1258.         T : TraceRecPtr; S : String[6];
  1259.     BEGIN   {DisplayCode}
  1260.         IF Count > 0 THEN
  1261.         BEGIN
  1262.             Limit := Count;
  1263.             IP  := NextLL;
  1264.             P.TCpu := C086;
  1265.             T := AddrTraceTab(U);
  1266.             IF (T = Nil) OR (TrcNdx = $FFFF) THEN
  1267.             BEGIN
  1268.                 P.Lim := Limit;
  1269.                 P.Obj := IP;
  1270.                 DisplayCodeLine(P);
  1271.                 IP  := P.Obj;
  1272.             END ELSE
  1273.             BEGIN
  1274.                 T := Ptr(Seg(T^),Ofs(T^)+TrcNdx);
  1275.                 L := T^.TrBeg;
  1276.                 K := GetTrExecSize(T);
  1277.                 P.Obj := IP;
  1278.                 I := 1;
  1279.                 WHILE I <= K DO BEGIN
  1280.                     IF T^.TrExec[I] = $80 THEN Inc(I);
  1281.                     P.Lim := T^.TrExec[I];
  1282.                     IF P.Lim > 0 THEN
  1283.                     BEGIN
  1284.                         PutTxt('; ------------> Code From Line: ');
  1285.                         Str(L,S);
  1286.                         PutTxt(S);
  1287.                         IF I = 1 THEN PutTxt('  ("BEGIN" Statement)') ELSE
  1288.                         IF I = K THEN PutTxt('  ("END" Statement)');
  1289.                         NewTxtLine;
  1290.                         DisplayCodeLine(P);
  1291.                     END;
  1292.                     Inc(L); Inc(I);
  1293.                 END;
  1294.                 IP := P.Obj;
  1295.             END;
  1296.             NextLL := IP;
  1297.         END;
  1298.     END; {DisplayCode}
  1299.  
  1300.     PROCEDURE UnAssembleCode(Hash : LL;SF : Byte;            {.CP31}
  1301.                  Org, Limit : Word;
  1302.                  TrcNdx : LL;Comment:Boolean);
  1303.     VAR Stopper : LL;
  1304.     BEGIN
  1305.         IF LinesRemaining < 4 THEN NewTxtPage;
  1306.         Stopper := Limit-Org;
  1307.         IF NextLL > Org THEN Stopper := Limit-NextLL;
  1308.         IF (Stopper > 0) THEN
  1309.         BEGIN
  1310.             IF Comment THEN {Allow Remarks}
  1311.             BEGIN
  1312.                 SetCol(7); PutTxt('Code For ');
  1313.                 IF SF < $05
  1314.                 THEN
  1315.                     IF Hash <> $FFFF
  1316.                     THEN PutTxt('PROC "'+NameOfMethod(UH,Hash)+'"')
  1317.                     ELSE PutTxt('Unit Initialization')
  1318.                 ELSE
  1319.                 IF Hash <> $FFFF
  1320.                     THEN PutTxt('PUBLIC "'+NameOfMethod(UH,Hash)+'"')
  1321.                     ELSE PutTxt('PRIVATE or Un-named PUBLIC');
  1322.                 PutTxt(' starts at '+HexW(NextLL));
  1323.                 NewTxtLine;NewTxtLine;
  1324.             END;
  1325.             IF DisAssembly
  1326.                 THEN DisplayCode(UH,Stopper,TrcNdx)
  1327.                 ELSE PrintCodeBytes(UH,Stopper,16,HexOff);
  1328.             NewTxtLine;NewTxtLine;
  1329.         END;
  1330.     END;  {UnAssembleCode}
  1331.  
  1332.     PROCEDURE UnAssembleData(PMRefs : PMapRefRec; SF: Byte);    {.CP13}
  1333.     BEGIN
  1334.         SetCol(7);
  1335.         IF SF <> $05
  1336.             THEN PutTxt('(Preamble Data Begins at ')
  1337.             ELSE PutTxt('(PRIVATE Code or Data Begins at ');
  1338.         PutTxt(HexW(NextLL)+')');
  1339.         NewTxtLine;NewTxtLine;
  1340.         IF SF <> $05
  1341.             THEN PrintCodeBytes(UH,PMRefs.PmEntP-NextLL,16,HexOff)
  1342.             ELSE UnAssembleCode(PMRefs.PmDirN,SF,NextLL,PMRefs.PmEntP,$FFFF,False);
  1343.         NewTxtLine;NewTxtLine;
  1344.     END;  {UnAssembleData}
  1345.  
  1346. BEGIN  {FormatObjectCode}                        {.CP46}
  1347.     NoteBegin('Formatting CODE Segments');
  1348.     PM := AddrCMapTab(UH);
  1349.     IF UH^.UHCsg < UH^.UHDsT THEN WITH PM^, PMapP^, PMapC^ DO
  1350.     BEGIN
  1351.         SaveTab := TabStop;
  1352.         TabStop := 55;
  1353.         R := AddrFixUps(UH);
  1354.         PrintTitleBlk('Object Code Begins Here',0);
  1355.         CMaps := NMapC;                { Code Segments }
  1356.         CXs := NMapP-1;                { Procs         }
  1357.         IF (PMRefs[CXs].PmEntP = $FFFF)    { remove unused init proc  }
  1358.         THEN Dec(CXs);
  1359.         I := 0;                        { Track PMRefs Table           }
  1360.         J := 0;                        { Track CSeg Map Table     }
  1361.  
  1362.         REPEAT                                                         {.CP30}
  1363.             NewTxtLine;
  1364.             WHILE PMRefs[I].PmNdxC < J DO Inc(I);
  1365.             MyOrg := CmRefs[J].CmSegL;            { Segment Load Point }
  1366.             MyEnd := MyOrg + CmRefs[J].CmSegS;        { Next Segment Start }
  1367.             MyFil := CmRefs[J].CmNdxF;            { Segment Source Fil }
  1368.             MyTrc := CSegMap[CmRefs[J].CmNdxC].CSegTrc;
  1369.             SP := AddrSrcTabOff(UH,MyFil);
  1370.             PutTxt('----  Code Segment at '+HexW(NextLL)+' Found In "');
  1371.             PutTxt(SP^.SrcName+'"');
  1372.             NewTxtLine; NewTxtLine;
  1373.             HexOff := NextLL;
  1374.             SF := SP^.SrcFlag;
  1375.             IF (PMRefs[I].PmEntP <> NextLL)
  1376.                 THEN UnAssembleData(PMRefs[I],SF);
  1377.             WHILE (I <= CXs) AND (PMRefs[I].PmNdxC = J) DO BEGIN
  1378.                         WITH PmRefs[I] DO
  1379.                 UnAssembleCode(PmDirN,SF,PmEntP,PmEntP+PmSizP,MyTrc,True);
  1380.                 Inc(I);
  1381.             END;
  1382.             Inc(J);
  1383.         UNTIL (J = CMaps);
  1384.  
  1385.         TabStop := SaveTab;
  1386.         SetCol(1);PutTxt('----  END OF ALL OBJECT CODE');
  1387.         NewTxtLine;NewTxtLine;
  1388.         BoundaryAlign(UH);
  1389.     END;
  1390.     NoteEnd;
  1391. END; {FormatObjectCode}
  1392.  
  1393. PROCEDURE FormatDataAreas(UH : UnitHeadPtr);                {.CP37}
  1394. VAR    PD : DSegMapTabPtr; SaveTab : Word; T : TypePtr;
  1395.     I, MapEnd : Word; EndLL : LL;
  1396. BEGIN
  1397.     NoteBegin('Formatting CONST Data Segments');
  1398.     SaveTab := TabStop;
  1399.     EndLL := NextLL + UH^.ULTCon;
  1400.     IF EndLL <> NextLL THEN
  1401.     BEGIN
  1402.         PrintTitleBlk('CONST Data Segments Follow',5);
  1403.         WITH UH^ DO MapEnd := (UHDsV-UHDsT) DIV SizeOf(DSegMapRec);
  1404.         BEGIN
  1405.             PD := AddrDMapTab(UH);
  1406.             FOR I := 0 TO MapEnd-1 DO WITH PD^.DSegMap[I] DO
  1407.             BEGIN
  1408.                 NewTxtLine;
  1409.                 SetCol(7);
  1410.                 IF DSegOwn <> 0 THEN
  1411.                 BEGIN
  1412.                     T := TypePtr(PtrAdjust(UH,DSegOwn));
  1413.                     PutTxt('VMT Skeleton for "');
  1414.                     PutTxt(AddrDict(UH,T^.ObjtName)^.DSymb+'"');
  1415.                 END ELSE
  1416.                     PutTxt('Data Area Begins at '+HexW(NextLL));
  1417.                 SetCol(1);
  1418.                 NewTxtLine;
  1419.                 PrintBytes(UH,DSegCnt,16);
  1420.                 SetCol(1);
  1421.             END; {FOR}
  1422.         END;   {WITH}
  1423.         NewTxtLine;PutTxt('----  END OF ALL DATA SEGMENTS');
  1424.         NewTxtLine;NewTxtLine;
  1425.     END; {IF}
  1426.     TabStop := SaveTab;
  1427.     BoundaryAlign(UH);
  1428.     NoteEnd;
  1429. END; {FormatDataAreas}
  1430.  
  1431. {$F+}
  1432. PROCEDURE ReloHeadings;                        {.CP06}
  1433. BEGIN
  1434.     SetCol(7); PutTxt('Un Fl  Map  E-Adr Patch : Ptch Type Refers');
  1435.     SetCol(7); PutTxt('it ag Ofset Ofset Ofset : Size  Map To Unit');
  1436.     SetCol(7); PutTxt('-- -- ----- ----- ----- : ---- ---- --------');
  1437. END; {ReloHeadings} {$F-}
  1438.  
  1439. PROCEDURE FormatReloList(UH : UnitHeadPtr);            {.CP02}
  1440. TYPE Remark = String[8]; T4 = String[4]; T8 = String[8];
  1441.  
  1442.     PROCEDURE ReloIdentify(    R : ReloListEntry;        {.CP17}
  1443.                 VAR S2, S1 : T4; VAR S3 : T8);
  1444.     VAR PU : UnitDonorPtr;
  1445.     BEGIN  {ReloIdentify}
  1446.         CASE (R.RloFlg SHR 6) AND $3 OF
  1447.             0: S1 := 'PROC';    1: S1 := 'CSeg';
  1448.             2: S1 := 'DATA';    3: S1 := 'CONS';
  1449.         END;
  1450.         CASE (R.RloFlg SHR 4) AND $3 OF
  1451.             0: S2 := 'WORD';    1: S2 := 'WD+E';
  1452.             2: S2 := 'SEG ';    3: S2 := 'FPTR';
  1453.         END;
  1454.         IF (R.RloFlg AND $F) <> 0 THEN
  1455.         BEGIN S1 := '??? ';    S2 := '????';  END;
  1456.         PU := UnitDonorPtr(PtrAdjust(UH,UH^.URULt+R.RloDnr));
  1457.         S3 := PU^.UDENam;
  1458.     END;   {ReloIdentify}
  1459.  
  1460. VAR    R : ReloListPtr; T : TypePtr; PU : UnitDonorPtr;        {.CP47}
  1461.     PC : CSegMapTabPtr; PD : DSegMapTabPtr; S1,S2:T4;S3 : T8;
  1462.     I, J, K, MapEnd : Word; EndS, EndLL : LL; SaveTab : Word;
  1463. BEGIN
  1464.     NoteBegin('Formatting Relo Lists');
  1465.     SaveTab := TabStop;
  1466.     TabStop := 33;
  1467.     EndLL := NextLL + UH^.ULPtch;
  1468.     IF EndLL <> NextLL THEN WITH UH^ DO
  1469.     BEGIN
  1470.         PrintTitleBlk('Relocation Data Table Follows',7);
  1471.         SetCol(1);
  1472.         J := 0;
  1473.         R := ReloListPtr(PtrAdjust(UH,NextLL));
  1474.         IF UHCsg < UHDsT THEN
  1475.         BEGIN
  1476.             PC := AddrCMapTab(UH);
  1477.             MapEnd := (UHDsT-UHCsg) DIV SizeOf(CSegMapRec);
  1478.             FOR I := 0 TO MapEnd-1 DO WITH PC^.CSegMap[I] DO
  1479.             IF CSegRel <> 0 THEN
  1480.             BEGIN
  1481.                 SetCol(1);
  1482.                 IF LinesRemaining < 9   THEN NewTxtPage
  1483.                             ELSE NewTxtLine;
  1484.                 SetCol(7);
  1485.                 PutTxt('Relocation Data For CSeg Map Entry at ');
  1486.                 PutTxt(HexW(I*SizeOf(CSegMapRec)+UHCsg));
  1487.                 PutTxt(' (Segment Load Addr = ');
  1488.                 EndS := PMapC^.CmRefs[i].CmSegL;
  1489.                 PutTxt(HexW(EndS)+')');
  1490.                 EndS := EndS + PMapC^.CmRefs[i].CmSegS;
  1491.                 SetCol(1);NewTxtLine;
  1492.                 ReloHeadings;
  1493.                 FOR K := PMapC^.CmRefs[i].CmNdxR TO PMapC^.CmRefs[i].CmCntR DO
  1494.                 BEGIN
  1495.                     PageOverFlow(2,ReloHeadings);
  1496.                     ReloIdentify(R^.ReloList[K],S1,S2,S3);
  1497.                     PrintBytes(UH,8,8);
  1498.                     SetCol(TabStop); PutTxt(S1);
  1499.                     SetCol(TabStop+5);PutTxt(S2);
  1500.                     SetCol(TabStop+10);PutTxt(S3);
  1501.                     Inc(J);
  1502.                 END; {WITH}
  1503.             END; {FOR}
  1504.         END;   { IF CSeg Map non-Empty }
  1505.  
  1506.         IF UHDsT < UHDsV THEN    {DSeg Map non-Empty}        {.CP49}
  1507.         BEGIN
  1508.             PD := AddrDMapTab(UH);
  1509.             K := NextLL;
  1510.             NewTxtLine;NewTxtLine;
  1511.             BoundaryAlign(UH);
  1512.             IF K <> NextLL THEN Inc(J);
  1513.             MapEnd := (UHDsV-UHDsT) DIV SizeOf(DSegMapRec);
  1514.             EndS := (EndS + $F) AND $FFF0;
  1515.             FOR I := 0 TO MapEnd-1 DO WITH PD^.DSegMap[I] DO
  1516.             IF DSegRel <> 0 THEN
  1517.             BEGIN
  1518.                 SetCol(1);
  1519.                 IF LinesRemaining < 9    THEN NewTxtPage
  1520.                             ELSE NewTxtLine;
  1521.                 SetCol(7);
  1522.                 PutTxt('Relocation Data For CONST DSeg Map Entry at ');
  1523.                 PutTxt(HexW(I*SizeOf(DSegMapRec)+UHDsT));
  1524.                 PutTxt(' (Segment Load Addr = ');
  1525.                 PutTxt(HexW(EndS)+')');
  1526.                 EndS := EndS + DSegCnt;
  1527.                 SetCol(1);NewTxtLine;
  1528.                 ReloHeadings;
  1529.                 K := 0;
  1530.                 WHILE K < (DSegRel DIV SizeOf(ReloListEntry)) DO
  1531.                 BEGIN
  1532.                     PageOverFlow(2,ReloHeadings);
  1533.                     ReloIdentify(R^.ReloList[J],S1,S2,S3);
  1534.                     PrintBytes(UH,8,8);
  1535.                     SetCol(TabStop); PutTxt(S1);
  1536.                     SetCol(TabStop+5);PutTxt(S2);
  1537.                     SetCol(TabStop+10);PutTxt(S3);
  1538.                     Inc(J);
  1539.                     Inc(K);
  1540.                 END; {WHILE}
  1541.             END; {FOR}
  1542.         END;   { IF DSeg Map non-Empty }
  1543.         NewTxtLine;NewTxtLine;
  1544.         PutTxt('----  END OF ALL RELOCATION TABLES');
  1545.         NewTxtLine;NewTxtLine;
  1546.  
  1547.     END;   {IF Relo List non-Empty}
  1548.  
  1549.     TabStop := SaveTab;
  1550.     BoundaryAlign(UH);
  1551.     NoteEnd;
  1552. END; {FormatReloList}
  1553.  
  1554. PROCEDURE DocumentUnit(P : UnitHeadPtr);            {.CP18}
  1555. BEGIN
  1556.     FormatHeader(P);
  1557.     SurveyDictionary(P);                { Ident Dictionary Entries }
  1558.     FormatDictionary(P);                { PRINT the Dictionary     }
  1559.     XrefMaps(P);                    { Cross-index Map Tables   }
  1560.     FormatProcMap(P,AddrPMapTab(P)^,NMapP);        { PRINT the PROC Map       }
  1561.     FormatCSegMap(P,PMapP^,NMapP,PMapC^,NMapC); { PRINT the CSeg Map       }
  1562.     FormatTypedConMap(P);                { PRINT the CONST Map      }
  1563.     FormatGlobalVarMap(P);                { PRINT the VAR Map        }
  1564.     FormatUnitDonorList(P);                { PRINT the Donor Unit Tab }
  1565.     FormatSourceFileList(P);            { PRINT the Source Files   }
  1566.     FormatTraceTable(P);                { PRINT the Trace Table    }
  1567.     FormatEndNonCode(P);                { PRINT separator          }
  1568.     FormatObjectCode(P);                { PRINT CODE Segments      }
  1569.     FormatDataAreas(P);                { PRINT CONST Segment Data }
  1570.     FormatReloList(P);                { PRINT LINKER Relo Data   }
  1571. END; {DocumentUnit}
  1572.  
  1573.  
  1574. VAR i,j : integer; P : UnitHeadPtr; Module:String[8]; c:char;        {.CP35}
  1575.  
  1576. BEGIN       { Main Program }
  1577.     ClrScr;
  1578.     Write('Enter Name of Unit to Document: ');ReadLn(Module);
  1579.     i := WhereX; j := WhereY;
  1580.     REPEAT
  1581.         GoToXY(i,j);ClrEol;
  1582.         Write('Do You Want Dis-Assembly of Code? [Y|N] ');
  1583.         ReadLn(c);
  1584.     UNTIL UpCase(c) IN ['Y','N'];
  1585.     DisAssembly := UpCase(c) = 'Y';
  1586.     FOR I := 1 TO Length(Module) DO Module[I] := UpCase(Module[I]);
  1587.     TabStop := 36;
  1588.     InitJobUnit(Module);
  1589.     IF BufPtrJob <> Nil THEN
  1590.     BEGIN
  1591.         P := UnitHeadPtr(BufPtrJob);
  1592.         Write('Unit Header="');
  1593.         FOR i := 0 TO 3 DO WITH P^ DO Write(FilHd[i]);
  1594.         WriteLn('"');
  1595.         WriteLn('Unit Name="',DictHeadPtr(PtrAdjust(P,P^.UdirE))^.DSymb,'"');
  1596.         OpenTxt(Module+'.LST',60,80);
  1597.         PutTxt('==============================================');   NewTxtLine;
  1598.         PutTxt('* Unit Header For: "'
  1599.         + DictHeadPtr(PtrAdjust(P,P^.UdirE))^.DSymb + '"'); NewTxtLine;
  1600.         PutTxt('==============================================');   NewTxtLine;
  1601.         NextLL := 0;
  1602.         DocumentUnit(P); NewTxtPage;
  1603.         CloseTxt;
  1604.     END ELSE
  1605.         WriteLn('File "',module,'.TPU" Not Found!');
  1606.     DropJobUnit;
  1607.  
  1608. END.