PC Underground/UNDERGROUND.ISO/rtclock/rtc.pas

Pascal/Delphi Source File | 1995-08-08 | 5.2 KB | 231 lines

program rtc_unit;

uses crt,dos;

const
  Rtc_Seconds         = $00;
  Rtc_Seconds_alarm   = $01;
  Rtc_Minutes         = $02;
  Rtc_Minutes_alarm   = $03;
  Rtc_Hours           = $04;
  Rtc_Hours_alarm     = $05;
  Rtc_Weekday         = $06;
  Rtc_Day_of_Month    = $07;
  Rtc_Month           = $08;
  Rtc_Year            = $09;
  Rtc_Status_A        = $0A;
  Rtc_Status_B        = $0B;
  Rtc_Status_C        = $0C;
  Rtc_Status_D        = $0D;
  Rtc_Diagnosis_status = $0E;
  Rtc_Shutdown_status = $0F;
  Rtc_Floppy_Typ      = $10;
  Rtc_HD_Typ          = $12;
  Rtc_Equipment       = $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_Heads       = $22;
  Rtc_HD1_Lo_Precom   = $23;
  Rtc_HD1_Hi_Precom   = $24;
  Rtc_HD1_Lo_Landing  = $25;
  Rtc_HD1_Hi_Landing  = $26;
  Rtc_HD1_Sectors     = $27;
  Rtc_Options1        = $28;
  Rtc_Options2        = $2B;
  Rtc_Options3        = $2C;
  Rtc_Lo_Checksum     = $2E;
  Rtc_Hi_Checksum     = $2F;
  Rtc_Extendedmem_Lo  = $30;
  Rtc_Extendedmem_Hi  = $31;
  Rtc_Century         = $32;
  Rtc_Setup_Info      = $33;
  Rtc_CPU_speed       = $34;
  Rtc_HD2_Lo_Cylinder = $35;
  Rtc_HD2_Hi_Cylinder = $36;
  Rtc_HD2_Heads       = $37;
  Rtc_HD2_Lo_Precom   = $38;
  Rtc_HD2_Hi_Precom   = $39;
  Rtc_HD2_Lo_Landing  = $3A;
  Rtc_HD2_Hi_Landing  = $3B;
  Rtc_HD2_Sectors     = $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);
{
 Writes a value to the RTC register specified in Reg
}
begin;
  port[$70] := Reg;
  port[$71] := val;
end;

function read_rtc(Reg : byte) : byte;
{
 Reads a value from the RTC register specified in Reg
}
begin;
  port[$70] := Reg;
  read_rtc := port[$71];
end;

Procedure Write_Floppy;
{
 Outputs information about the installed floppy drives
}
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, 360K');
          end;
      2 : begin;
            writeln('5¼" Floppy, 1.2 Meg');
          end;
      3 : begin;
            writeln('3½" Floppy, 720K');
          end;
      4 : begin;
            writeln('3½" Floppy, 1.44 Meg');
          end;
    end;
  end;
end;

Procedure Write_Hd;
{
 Outputs the type of installed HD
}
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;
{
 Outputs available memory
}
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('Extended memory: ',extended,' KB');
end;

procedure Write_Display;
{
 Outputs the type of graphic card and tells whether a coprocessor
 is installed
}
var dtyp : byte;
    Copro : byte;
begin;
  dtyp  := Read_Rtc(Rtc_Equipment);
  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 in 40 column mode');
        end;
    2 : begin;
          writeln('Color display in 80 column mode');
        end;
    3 : begin;
          writeln('Monochrome display controller');
        end;
  end;
  if Copro = 1 then
    writeln('Coprocessor found')
  else
    writeln('Coprocessor not found');
end;

procedure write_shadow;
{
 Outputs which areas of shadow RAM are supported
}
var shadow : byte;
begin;
  shadow := read_rtc(Rtc_Options1);
  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;
{
 Indicates whether the CPU is in Turbo mode
}
var speed : byte;
begin;
  speed := read_rtc(Rtc_CPU_speed);
  if speed = 1 then
    writeln('CPU in Turbo mode')
  else
    writeln('CPU not in Turbo mode');
end;

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