home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SHOLDT.ZIP / LDTWIN.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-10-19  |  10.3 KB  |  380 lines
  1. {$IFNDEF Dpmi}
  2.   !! This unit requires Protected Mode !!
  3. {$ENDIF}
  4.  
  5. {$A+,F+,I-,O-,R-,S-,T-,V-,X+}
  6.  
  7. unit LDTWin;  {Window that dumps the LDT table}
  8.  
  9. {$I OPDEFINE.INC}
  10.  
  11. interface
  12.  
  13. uses
  14.   Dpmi,
  15.   OpRoot,
  16.   OpString,
  17.   OpCrt,
  18. {$IFDEF UseMouse}
  19.   OpMouse,
  20. {$ENDIF}
  21.   OpCmd,
  22.   OpFrame,
  23.   OpWindow,
  24.   OpEdit,
  25.   OpPick,
  26.   OpBrowse;
  27.  
  28. const
  29.   DescTableSize = 8096;
  30.  
  31. type
  32.   DescTable = Array[1..DescTableSize] of Word;
  33.   PDescTable = ^DescTable;
  34.  
  35.   PLDTList = ^LDTList;
  36.   LDTList =
  37.     object(PickList)
  38.       PLDT  : PDescTable;
  39.       NumDesc : Word;
  40.  
  41.       constructor Init(X1, Y1, X2, Y2 : Byte);
  42.       constructor InitCustom(X1, Y1, X2, Y2 : Byte; var Colors : ColorSet;
  43.                              WOpts : LongInt);
  44.       destructor Done;  virtual;
  45.       procedure ItemString(Item : Word; Mode : pkMode; var iType : pkItemType;
  46.                            var iString : String);  virtual;
  47.       procedure Info(S : String);
  48.       procedure DefInfo;
  49.     end;
  50.  
  51.  
  52. procedure ShowLDT(var Colors : ColorSet);
  53.  
  54. implementation
  55.  
  56.   procedure ParseDesc(var Desc : DescriptorTableEntry;
  57.                       var Base : LongInt;
  58.                       var Limit : LongInt;
  59.                       var TypeOfField : Byte;
  60.                       var DPL : Byte);
  61.   begin
  62.     with Desc do begin
  63.       Limit := LongInt(LimitL) or (LongInt(Words[1] and $0F) shl 16);
  64.       Base := LongInt(BaseL) or
  65.           (LongInt((Words[0] and $00FF) or (Words[1] and $FF00)) shl 16);
  66.       TypeOfField := (Words[0] shr 8) and $0F;
  67.       DPL := (Words[0] shr 13) and $03;
  68.     end;
  69.   end;
  70.  
  71.   function ValidDesc(var Desc : DescriptorTableEntry) : Boolean;
  72.   var
  73.     Base, Limit : LongInt;
  74.     Typ, DPL : Byte;
  75.   begin
  76.     ParseDesc(Desc, Base, Limit, Typ, DPL);
  77.     ValidDesc := (Typ <> 0) and (Typ <> $F);
  78.   end;
  79.  
  80.   function LoadDescTable(P : PDescTable) : Word;
  81.   var
  82.     Sel, Index, NumEls : Word;
  83.     Desc : DescriptorTableEntry;
  84.   begin
  85.     FillChar(P^, SizeOf(DescTable), 0);
  86.     NumEls := 0;
  87.     for Index := 0 to $1FFF do begin
  88.       Sel := ((Index * 8) or 3) + 4;
  89.       if GetDescriptor(Sel, Desc) = 0 then
  90.         if ValidDesc(Desc) then begin
  91.           Inc(NumEls);
  92.           P^[NumEls] := Sel;
  93.         end;
  94.     end;
  95.     LoadDescTable := NumEls;
  96.   end;
  97.  
  98.   function Desc2Str(Selector : Word;
  99.                     var Desc : DescriptorTableEntry;
  100.                     var P : String) : Boolean;
  101.   var
  102.     Base, Limit : LongInt;
  103.     Typ, DPL : Byte;
  104.     N : String[12];
  105.     L : LongInt;
  106.     Q : Pointer;
  107.   const
  108.     Dummy = ' ----:---- ';
  109.     CodeData : Array[Boolean] of String[5] =
  110.                  (' Data', ' Code');
  111.     ReadWrite : Array[Boolean] of String[4] =
  112.                  (' R  ', ' R/W');
  113.     Accessed : Array[Boolean] of String[2] =
  114.                  ('  ', ' A');
  115.     UpDown : Array[Boolean] of String[3] =
  116.                (' Up', ' Dn');
  117.     Loaded : Array[Boolean] of String[7] =
  118.                ('       ', ' Loaded');
  119.   begin
  120.     if GetDescriptor(Selector, Desc) = 0 then ;
  121.     ParseDesc(Desc, Base, Limit, Typ, DPL);
  122.  
  123.     if (Typ = 0) or (Typ = $F) then begin
  124.       Desc2Str := False;
  125.       Exit;
  126.     end
  127.     else
  128.       Desc2Str := True;
  129.     P := HexW(Selector);
  130.     if GetSegmentBaseAddr(Selector, L) = 0 then begin
  131.       if L <= $000FFFFF then begin
  132.         Q := UnLinear(L);
  133.         P := P + ' ' + HexPtr(Q)+' ';
  134.       end
  135.       else
  136.         P := P + '  '+HexL(L)+' ';
  137.     end
  138.     else
  139.       P := P + Dummy;
  140.     N := Long2Str(Limit + 1);
  141.     P := P + LeftPad(N, 8) + ' ' + HexB(DPL);
  142.     if Typ and $08 > 0 then
  143.       P := P + CodeData[True]+ReadWrite[False]+'   '
  144.     else
  145.       P := P + CodeData[False]+ReadWrite[(Typ and $02) > 0]+UpDown[(Typ and $04) > 0];
  146.     P := P + Accessed[Typ and $01 > 0] + Loaded[Desc.Words[0] and $8000 > 0] + HexL(Base) + ' ';
  147.   end;
  148.  
  149.   constructor LDTList.Init(X1, Y1, X2, Y2 : Byte);
  150.   begin
  151.     if not LDTList.InitCustom(X1, Y1, X2, Y2, DefaultColorSet, DefWindowOptions) then
  152.       Fail;
  153.   end;
  154.  
  155.   constructor LDTList.InitCustom(X1, Y1, X2, Y2 : Byte; var Colors : ColorSet;
  156.                                  WOpts : LongInt);
  157.   begin
  158.     if not PickList.InitAbstractDeluxe(X1, Y1, X2, Y2, Colors, WOpts,
  159.                                        Succ(X2-X1), 1, PickVertical,
  160.                                        SingleChoice,
  161.                                        DefPickOptions and not pkMinHeight) then Fail;
  162.     if not GetMemCheck(PLDT, DescTableSize * SizeOf(Word)) then begin
  163.       Done;
  164.       Fail;
  165.     end;
  166.     NumDesc := LoadDescTable(PLDT);
  167.     ChangeNumItems(NumDesc);
  168.   end;
  169.  
  170.   destructor LDTList.Done;
  171.   begin
  172.     if PLDT <> nil then
  173.       FreeMemCheck(PLDT, DescTableSize * SizeOf(Word));
  174.     PickList.Done;
  175.   end;
  176.  
  177.   procedure LDTList.ItemString(Item : Word; Mode : pkMode;
  178.                                var iType : pkItemType; var iString : String);
  179.   var
  180.     Desc : DescriptorTableEntry;
  181.   begin
  182.     if not Desc2Str(PLDT^[Item], Desc, iString) then
  183.       iString := Center('** Invalid **', Width);
  184.   end;
  185.  
  186.   procedure LDTList.Info(S : String);
  187.   begin
  188.     fFastWrite(Center(S, Width), 1, 1, ColorMono(wTextColor, wTextMono));
  189.   end;
  190.  
  191.   procedure LDTList.DefInfo;
  192.   begin
  193.     fFastWrite(Pad('Sele  Address    Size     Info', Width), 1, 1,
  194.                ColorMono(wTextColor, wTextMono));
  195.   end;
  196.  
  197. {-------------------------------------------------------------------------}
  198.  
  199. var
  200.   Br : BrowserPtr;
  201.   MyColors : ColorSet;
  202.  
  203.   function MyEdit(MsgCode : Word; Prompt : String;
  204.                   ForceUp, TrimBlanks : Boolean;
  205.                   MaxLen : Byte; var S : String) : Boolean;
  206.   var
  207.     Finished : Boolean;
  208.     LE : LineEditor;
  209.   begin
  210.     with Br^, MyColors do
  211.       FastFill(Width, ' ', wYL-1, wXL, ColorMono(PromptColor, PromptMono));
  212.     LE.Init(MyColors);
  213.     if ForceUp then
  214.       LE.leEditOptionsOn(leForceUpper);
  215.     if not TrimBlanks then
  216.       LE.leEditOptionsOff(leTrimBlanks);
  217.     LE.ReadString(Prompt, Br^.wYL-1, Br^.wXL, MaxLen,
  218.                   Br^.Width - Length(Prompt)-2, S);
  219.     MyEdit := (LE.GetLastCommand <> ccQuit);
  220.     LE.Done;
  221.     with Br^, MyColors do
  222.       FastFill(Width, ' ', wYL-1, wXL, ColorMono(PromptColor, PromptMono));
  223.   end;
  224.  
  225.   procedure MyStatus(BP : BrowserPtr);
  226.     {-Display status line}
  227.   const
  228.     RawStatus : string[80] =
  229.     {         1         2         3     x   4         5         6         7         8}
  230.     {12345678901234567890123456789012345678901234567890123456789012345678901234567890}
  231.     ' Line x       Col x                          ';
  232.   var
  233.     S : string[80];
  234.     {$IFDEF UseMouse}
  235.     SaveMouse : Boolean;
  236.     {$ENDIF}
  237.  
  238.     procedure MergeString(T : String; N : Byte; var S : String);
  239.     begin
  240.       MoveFast(T[1], S[N], Length(T)); {!!.01}
  241.     end;
  242.  
  243.   begin
  244.     with BP^ do begin
  245.       S := Pad(RawStatus, Width);
  246.       if brWorkingFlag <> 0 then
  247.         MergeString('Working...', 36, S);
  248.       MergeString(Long2Str(brCurLine), 7, S);
  249.       MergeString(Long2Str(brColOfs+1), 19, S);
  250.  
  251.       {$IFDEF UseMouse}
  252.       HideMousePrim(SaveMouse);
  253.       {$ENDIF}
  254.  
  255.       with MyColors do
  256.         fFastWrite(S, 1, 1, ColorMono(HeaderColor, HeaderMono));
  257.  
  258.       {$IFDEF UseMouse}
  259.       ShowMousePrim(SaveMouse);
  260.       {$ENDIF}
  261.     end;
  262.   end;
  263.  
  264.   procedure ShowLDT(var Colors : ColorSet);
  265.   var
  266.     LL : PLDTList;
  267.  
  268.     procedure DumpSelector(Sele : Word; var Colors : ColorSet);
  269.     var
  270.       Desc : DescriptorTableEntry;
  271.       Base, Limit : LongInt;
  272.       Typ, DPL : Byte;
  273.       Bool : Boolean;
  274.  
  275.       function GenerateFile : Boolean;
  276.       var
  277.         X, Y : Word;
  278.         F : File;
  279.       begin
  280.         GenerateFile := False;
  281.         if Limit > $FFFF then
  282.           Y := $FFFF
  283.         else
  284.           Y := Word(Limit);
  285.  
  286.         Assign(F, 'SELECTOR.DMP');
  287.         Rewrite(F, 1);
  288.         if IOResult <> 0 then
  289.           exit;
  290.  
  291.         BlockWrite(F, Ptr(Sele, 0)^, Y, X);
  292.         GenerateFile := (IOResult = 0) and (X = Y);
  293.         Close(F);  if IOResult = 0 then ;
  294.       end;
  295.  
  296.     begin
  297.       if GetDescriptor(Sele, Desc) = 0 then ;
  298.       ParseDesc(Desc, Base, Limit, Typ, DPL);
  299.       if Desc.Words[0] and $8000 = 0 then begin
  300.         LL^.Info('Not a valid selector - press a key:');
  301.         RingBell;
  302.         if ReadKeyWord = 0 then ;
  303.         LL^.DefInfo;
  304.         exit;
  305.       end;
  306.  
  307.       LL^.Info('Generating dump...');
  308.       Bool := GenerateFile;
  309.       LL^.DefInfo;
  310.       if not Bool then exit;
  311.  
  312.       New(Br, InitCustom(2, ScreenHeight - 15, 77, ScreenHeight-4, Colors,
  313.                          DefWindowOptions or wBordered, $FFF0));
  314.       if Br = nil then exit;
  315.  
  316.       with Br^ do begin
  317.         AdjustFrameCoords(wXL-1, wYL-2, wXH+1, wYH+1);
  318.         SetStatusProc(MyStatus);
  319.         SetEditProc(MyEdit);
  320.  
  321.         {$IFDEF UseShadows}
  322.         wFrame.AddShadow(shBR, shSeeThru);
  323.         {$ENDIF}
  324.  
  325.         wFrame.AddHeader(' Dump of Selector '+HexW(Sele)+' ', heTC);
  326.         wFrame.AddHeader(' <Esc> Quit ', heBC);
  327.  
  328.         {$IFDEF UseScrollBars}
  329.         wFrame.AddCustomScrollBar(frRR, 0, MaxLongInt, 2, 1, '■', '░', Colors);
  330.         {$ENDIF}
  331.  
  332.         OpenFile('SELECTOR.DMP');
  333.         if GetLastError = 0 then begin
  334.           brOptionsOn(brHexMode);
  335.           Draw;
  336.           repeat
  337.              Process;
  338.           until GetLastCommand in [ccQuit, ccError];
  339.           Erase;
  340.         end;
  341.         Dispose(Br, Done);
  342.       end;
  343.     end;
  344.  
  345.   begin
  346.     MyColors := Colors;
  347.     New(LL, InitCustom(24, 7, 70, ScreenHeight - 5, Colors,
  348.                        DefWindowOptions or wBordered));
  349.     if LL = nil then
  350.       Exit;
  351.     with LL^ do begin
  352.       AdjustFrameCoords(23, 4, 71, ScreenHeight-4);
  353.       {$IFDEF UseShadows}
  354.       wFrame.AddShadow(shBR, shSeeThru);
  355.       {$ENDIF}
  356.       wFrame.AddHeader(' Current LDT ', heTC);
  357.       wFrame.AddHeader(' <Enter> View Dump, <Esc> Quit ', heBC);
  358.       wFrame.AddSpanHeader('╞','═','╡', 2, frTT);
  359.       {$IFDEF UseScrollBars}
  360.       wFrame.AddCustomScrollBar(frRR, 0, MaxLongInt, 3, 1, '■', '░', Colors);
  361.       {$ENDIF}
  362.  
  363.       Draw;
  364.       DefInfo;
  365.  
  366.       repeat
  367.         Process;
  368.         if GetLastCommand = ccSelect then
  369.           DumpSelector(PLDT^[GetLastChoice], Colors);
  370.       until GetLastCommand in [ccQuit, ccError];
  371.       Erase;
  372.       if GetLastCommand <> ccQuit then
  373.         Halt
  374.       else
  375.         Dispose(LL, Done);
  376.     end;
  377.   end;
  378.  
  379. end.
  380.