MODULE TestGDT;  (* pjm *)

(*
Show GDT and IDT entries.

Ref: http://developer.intel.com/design/pentium4/manuals/245472.htm
*)

IMPORT SYSTEM, Texts, Oberon;

VAR
  w: Texts.Writer;

PROCEDURE WriteChar(c: CHAR);
BEGIN
  Texts.Write(w, c)
END WriteChar;

(* WriteString - Write a string *)

PROCEDURE WriteString(s: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
  i := 0;  WHILE s[i] # 0X DO WriteChar(s[i]);  INC(i) END
END WriteString;

(* WriteLn - Skip to the next line on trace output *)

PROCEDURE WriteLn;
BEGIN
  Texts.WriteLn(w)
END WriteLn;

(* WriteInt - Write "x" as a decimal number.  "w" is the field width. *)

PROCEDURE WriteInt(x, w: LONGINT);
VAR i: LONGINT;  x0: LONGINT;  a: ARRAY 12 OF CHAR;  s: ARRAY 2 OF CHAR;
BEGIN
  IF x < 0 THEN
    IF x = MIN(LONGINT) THEN
      WriteString("-2147483648");
      RETURN
    ELSE
      DEC(w); x0 := -x
    END
  ELSE
    x0 := x
  END;
  i := 0;
  REPEAT
    a[i] := CHR(x0 MOD 10 + 30H); x0 := x0 DIV 10; INC(i)
  UNTIL x0 = 0;
  s[0] := " ";  s[1] := 0X;
  WHILE w > i DO WriteString(s); DEC(w) END;
  s[0] := "-";
  IF x < 0 THEN WriteString(s) END;
  REPEAT DEC(i); s[0] := a[i]; WriteString(s) UNTIL i = 0
END WriteInt;

(* WriteHex - Write "x" as a hexadecimal number. The absolute value of "w" is the field width.  If "w" is negative, two hex digits are printed (x MOD 100H), otherwise 8 digits are printed. *)

PROCEDURE WriteHex(x, w: LONGINT);
VAR
  buf: ARRAY 10 OF CHAR;
  i, j: LONGINT;
BEGIN
  IF w >= 0 THEN j := 8 ELSE j := 2; w := -w END;
  FOR i := j+1 TO w DO WriteChar(" ") END;
  FOR i := j-1 TO 0 BY -1 DO
    buf[i] := CHR(x MOD 10H + 48);
    IF buf[i] > "9" THEN
      buf[i] := CHR(ORD(buf[i]) - 48 + 65 - 10)
    END;
    x := x DIV 10H
  END;
  buf[j] := 0X;
  WriteString(buf)
END WriteHex;

PROCEDURE Bits(s: ARRAY OF CHAR;  x: SET;  ofs, n: LONGINT);
BEGIN
  WriteString(s);  WriteChar("=");
  REPEAT
    DEC(n);
    IF (ofs+n) IN x THEN WriteChar("1") ELSE WriteChar("0") END
  UNTIL n = 0
END Bits;

(* WriteDesc - Write a 8-byte segment descriptor. *)

PROCEDURE WriteDesc(a: LONGINT);
VAR type, t, t0, t1: LONGINT;  s0, s1: SET;
BEGIN
  SYSTEM.GET(a, s0);  SYSTEM.GET(a+4, s1);  SYSTEM.GET(a, t0);  SYSTEM.GET(a+4, t1);
  WriteHex(a, 8);  WriteHex(t0, 9);  WriteHex(t1, 9);
  Bits(" P", s1, 15, 1);  Bits(", DPL", s1, 13, 2);  WriteString(", ");
  IF 12 IN s1 THEN  (* data/code *)
    type := 16;
    IF 22 IN s1 THEN WriteString("32-bit") ELSE WriteString("16-bit") END;
    IF 11 IN s1 THEN WriteString(" code");  Bits(", CRA", s1, 8, 3)
    ELSE WriteString(" data");  Bits(", EWA", s1, 8, 3)
    END;
    Bits(", avl", s1, 20, 1)
  ELSE
    type := ASH(t1, -8) MOD 16;
    CASE type OF
      0, 8, 10, 13: WriteString("type");  WriteInt(type, 1)
      |1, 3: WriteString("16-bit TSS");  Bits(", busy", s1, 9, 1)
      |2: WriteString("LDT")
      |4: WriteString("16-bit call gate")
      |5: WriteString("task gate")
      |6, 14: WriteString("interrupt gate");  Bits(", 32bit", s1, 11, 1)
      |7, 15: WriteString("trap gate");  Bits(", 32bit", s1, 11, 1)
      |9, 11: WriteString("32-bit TSS");  Bits(", busy", s1, 9, 1);  Bits(", avl", s1, 20, 1)
      |12: WriteString("32-bit call gate, params=");  WriteInt(t1 MOD 32, 1)
    END
  END;
  WriteLn;
  CASE type OF
    5: WriteString("  tsssel=");  WriteHex(ASH(t0, -16), 8);  WriteLn
    |6, 7, 12, 14, 15:
      WriteString("  segsel=");  WriteHex(ASH(t0, -16), 8);
      WriteString(", ofs=");  WriteHex(SYSTEM.VAL(LONGINT, s1 * {16..31} + s0 * {0..15}), 8);  WriteLn
    |9, 11, 16:
      t := SYSTEM.VAL(LONGINT, s1 * {24..31} + SYSTEM.LSH(s1 * {0..7}, 16) + SYSTEM.LSH(s0, -16));
      WriteString("  base=");  WriteHex(t, 8);
      t := SYSTEM.VAL(LONGINT, s1 * {16..19} + s0 * {0..16});
      WriteString(", limit=");  WriteHex(t, 8);
      IF 23 IN s1 THEN WriteString(" * 4K =");  WriteHex(t * 4096, 9) END;
      WriteLn
    ELSE (* skip *)
  END
END WriteDesc;

PROCEDURE StoreIDT(adr: LONGINT);
CODE {SYSTEM.i386}
  MOV EAX, adr[EBP]
  SIDT [EAX]
END StoreIDT;

PROCEDURE StoreGDT(adr: LONGINT);
CODE {SYSTEM.i386}
  MOV EAX, adr[EBP]
  SGDT [EAX]
END StoreGDT;

PROCEDURE WriteGDT;
VAR ptr: ARRAY 2 OF LONGINT;  a, n, i: LONGINT;
BEGIN
  StoreGDT(SYSTEM.ADR(ptr)+2);
  a := ptr[1];  n := ASH(ptr[0], -16);
  WriteString("GDT base=");  WriteHex(a, 8);  WriteString(" limit=");  WriteHex(n, 8);  WriteLn;
  n := (n+1) DIV 8;  i := 0;
  WHILE i < n DO
    WriteHex(i, -2);  WriteChar(" ");
    WriteDesc(a);  INC(a, 8);  INC(i)
  END;
  WriteLn
END WriteGDT;

PROCEDURE WriteIDT;
VAR ptr: ARRAY 2 OF LONGINT;  a, n, i: LONGINT;
BEGIN
  StoreIDT(SYSTEM.ADR(ptr)+2);
  a := ptr[1];  n := ASH(ptr[0], -16);
  WriteString("IDT base=");  WriteHex(a, 8);  WriteString(" limit=");  WriteHex(n, 8);  WriteLn;
  n := (n+1) DIV 8;  i := 0;
  WHILE i < n DO
    WriteHex(i, -2);  WriteChar(" ");
    WriteDesc(a);  INC(a, 8);  INC(i)
  END;
  WriteLn
END WriteIDT;

PROCEDURE ShowGDT*;
VAR t: Texts.Text;
BEGIN
  WriteGDT;
  NEW(t); Texts.Open(t, "");
  Oberon.OpenText("", t, 400, 200);
  Texts.Append(t, w.buf)
END ShowGDT;

PROCEDURE ShowIDT*;
VAR t: Texts.Text;
BEGIN
  WriteIDT;
  NEW(t); Texts.Open(t, "");
  Oberon.OpenText("", t, 400, 200);
  Texts.Append(t, w.buf)
END ShowIDT;

BEGIN
  Texts.OpenWriter(w)
END TestGDT.

TestGDT.ShowGDT
TestGDT.ShowIDT