program rtc_unit;

uses crt,dos;

const
  Rtc_Sekunden        = $00;
  Rtc_Sekunden_alarm  = $01;
  Rtc_Minuten         = $02;
  Rtc_Minuten_alarm   = $03;
  Rtc_Stunden         = $04;
  Rtc_Stunden_alarm   = $05;
  Rtc_Wochentag       = $06;
  Rtc_Tag_des_Monats  = $07;
  Rtc_Monat           = $08;
  Rtc_Jahr            = $09;
  Rtc_Status_A        = $0A;
  Rtc_Status_B        = $0B;
  Rtc_Status_C        = $0C;
  Rtc_Status_D        = $0D;
  Rtc_Diagnose_status = $0E;
  Rtc_Shutdown_status = $0F;
  Rtc_Floppy_Typ      = $10;
  Rtc_HD_Typ          = $12;
  Rtc_Ausstattung     = $14;
  Rtc_Lo_Basememory   = $15;
  Rtc_Hi_Basememory   = $16;
  Rtc_Lo_Extendedmem  = $17;
  Rtc_Hi_Extendedmem  = $18;
  Rtc_HD1_extended    = $19;
  Rtc_HD2_extended    = $1A;
  Rtc_Features        = $1F;
  Rtc_HD1_Lo_Cylinder = $20;
  Rtc_HD1_Hi_Cylinder = $21;
  Rtc_HD1_Koepfe      = $22;
  Rtc_HD1_Lo_Precom   = $23;
  Rtc_HD1_Hi_Precom   = $24;
  Rtc_HD1_Lo_Landing  = $25;
  Rtc_HD1_Hi_Landing  = $26;
  Rtc_HD1_Sektoren    = $27;
  Rtc_Optionen1       = $28;
  Rtc_Optionen2       = $2B;
  Rtc_Optionen3       = $2C;
  Rtc_Lo_Checksumme   = $2E;
  Rtc_Hi_Checksumme   = $2F;
  Rtc_Extendedmem_Lo  = $30;
  Rtc_Extendedmem_Hi  = $31;
  Rtc_Jahrhundert     = $32;
  Rtc_Setup_Info      = $33;
  Rtc_CPU_speed       = $34;
  Rtc_HD2_Lo_Cylinder = $35;
  Rtc_HD2_Hi_Cylinder = $36;
  Rtc_HD2_Koepfe      = $37;
  Rtc_HD2_Lo_Precom   = $38;
  Rtc_HD2_Hi_Precom   = $39;
  Rtc_HD2_Lo_Landing  = $3A;
  Rtc_HD2_Hi_Landing  = $3B;
  Rtc_HD2_Sektoren    = $3C;


function wrhexb(b : byte) : string;
const hexcar : array[0..15] of char =
 ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
begin;
  wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
end;

function wrhexw(w : word) : string;
begin;
  wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
end;

procedure write_rtc(Reg,val : byte);
{
 Schreibt einen Wert in das in Reg angegebene RTC-Register
}
begin;
  port[$70] := Reg;
  port[$71] := val;
end;

function read_rtc(Reg : byte) : byte;
{
 Liest einen Wert aus dem in Reg angegebene RTC-Register
}
begin;
  port[$70] := Reg;
  read_rtc := port[$71];
end;

Procedure Write_Floppy;
{
 Gibt Informationen �ber die installierten Floppy-Laufwerke aus
}
Var Fl : byte;
    Fls : array[1..2] of byte;
begin;
  Fl     := Read_Rtc(Rtc_Floppy_Typ);
  Fls[2] := Fl AND $0F;
  Fls[1] := Fl SHR 4;
  for Fl := 1 to 2 do begin;
    write('Floppy ',Fl,': ');
    case Fls[Fl] of
      0 : begin;
            writeln('No  Floppy        ');
          end;
      1 : begin;
            writeln('5¬" Floppy, 360 KB');
          end;
      2 : begin;
            writeln('5¬" Floppy, 1.2 MB');
          end;
      3 : begin;
            writeln('3«" Floppy, 720 KB');
          end;
      4 : begin;
            writeln('3«" Floppy, 1.44 MB');
          end;
    end;
  end;
end;

Procedure Write_Hd;
{
 Gibt den Typ der installierten HDs aus
}
Var Hd : byte;
    Hds : array[1..2] of byte;
begin;
  Hd     := Read_Rtc(Rtc_HD_Typ);
  Hds[2] := Hd AND $0F;
  Hds[1] := Hd SHR 4;
  If HDs[1] = $F then HDs[1] := Read_Rtc(Rtc_HD1_extended);
  If HDs[2] = $F then HDs[2] := Read_Rtc(Rtc_HD2_extended);
  writeln('HD 1 : Typ ',Hds[1]);
  writeln('HD 2 : Typ ',Hds[2]);
end;

procedure Write_Memory;
{
 Gibt den zur Verf�gung stehenden Speicher aus
}
var base,extended : word;
begin;
  Base     := 256 * Read_Rtc(Rtc_Hi_Basememory) +
              Read_Rtc(Rtc_Lo_Basememory);
  extended := 256 * Read_Rtc(Rtc_Hi_Extendedmem) +
              Read_Rtc(Rtc_Lo_Extendedmem);
  writeln('Base memory: ',Base,' KB');
  writeln('Exteded memory: ',extended,' KB');
end;

procedure Write_Display;
{
 Gibt den Typ der Grafik-Karte aus und informiert, ob ein Co-Prozessor
 installiert ist
}
var dtyp : byte;
    Copro : byte;
begin;
  dtyp  := Read_Rtc(Rtc_Ausstattung);
  Copro := (dtyp AND 3) SHR 1;
  dtyp  := (dtyp AND 63) SHR 4;
  case dtyp of
    0 : begin;
          writeln('Extended functionality GFX-Controller');
        end;
    1 : begin;
          writeln('Color Display im 40-Spalten Modus');
        end;
    2 : begin;
          writeln('Color Display im 80-Spalten Modus');
        end;
    3 : begin;
          writeln('Monochrome Display Controller');
        end;
  end;
  if Copro = 1 then
    writeln('Co-Prozessor gefunden')
  else
    writeln('Kein Co-Prozessor gefunden');
end;

procedure write_shadow;
{
 Gibt aus, welche Bereiche vom Shadow-Ram unterst�tzt werden
}
var shadow : byte;
begin;
  shadow := read_rtc(Rtc_Optionen1);
  shadow := shadow AND 3;
  case shadow of
    0 : begin;
          writeln('Shadow System AND Video BIOS');
        end;
    1 : begin;
          writeln('Shadow System BIOS');
        end;
    2 : begin;
          writeln('Shadow disabled');
        end;
  end;
end;

procedure write_cpuspeed;
{
 Gibt an, ob sich die CPU im Turbo-Mode befindet
}
var speed : byte;
begin;
  speed := read_rtc(Rtc_CPU_speed);
  if speed = 1 then
    writeln('CPU in Turbo-Mode')
  else
    writeln('CPU in Deturbo-Mode');
end;

var speed : byte;
begin;
 clrscr;
 Write_Floppy;
 Write_Hd;
 Write_Memory;
 Write_Display;
 Write_Shadow;
 Write_CPUSpeed;
end.