program datetest ;
uses Dos ;

type S30 = string [30] ; S2 = string [2] ;
EpochRec = record eYr, eMo, eDy, eDoW, eHr, eMi, eSc, eCs : word end ;
RTCrec = record rCy, rYr, rMo, rDy, rHr, rMi, rSc : byte end { 2 nibbles } ;

const
Sp = #32 ;
DigitString : string [16] = '0123456789ABCDEF' ;
Weekdays : array [0..6] of string [3] =
  ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat') ;

var DigitArray : array [-1..15] of char absolute DigitString ;


function BCD(X : byte) : byte ;
begin BCD := (X div 10)*16 + (X mod 10) end ;

function DCB(X : byte) : byte ;
begin DCB := (X div 16)*10 + (X mod 16) end ;

function CC(const B : byte) : S2 ;
const St : S2='@@' ;
begin St[1] := char((B div 10) + 48) ; St[2] := char((B mod 10) + 48) ;
  CC := St end ;

function TimeString(const E : EpochRec) : S30 ;
begin with E do begin
    TimeString := Sp+CC(eHr)+':'+CC(eMi)+':'+CC(eSc) end end ;

function DateString(const E : EpochRec) : S30 ;
var S5 : string [5] ;
begin with E do begin Str(eYr:5, S5) ;
    DateString := S5+'-'+CC(eMo)+'-'+CC(eDy) end end ;

function DateTimeString(const E : EpochRec) : S30 ;
begin DateTimeString := Sp+DateString(E)+TimeString(E) end ;


procedure ReadRTC(var E : EpochRec) ;
var R : Registers ;
begin with E, R do begin
    Write('Read  RTC with BIOS Int 1A/04, 1A/02 ') ;
    AH := $04 ; Intr($1A, R) ;
    eYr := DCB(CH)*100+DCB(CL) ; eMo := DCB(DH) ; eDy := DCB(DL) ;
    AH := $02 ; Intr($1A, R) ;
    eHr := DCB(CH) ; eMi := DCB(CL) ; eSc := DCB(DH) ;
    Writeln(DateTimeString(E)) ;
    end end ;


procedure WriteRTC(const E : EpochRec) ;
var R : Registers ;
begin with E, R do begin
    Writeln('Write RTC with BIOS Int 1A/05, 1A/03') ;
    AH := $05 ; CH := BCD(eYr div 100) ; CL := BCD(eYr mod 100) ;
    DH := BCD(eMo) ; DL := BCD(eDy) ; Intr($1A, R) ;
    AH := $03 ; CH := BCD(eHr) ;
    CL := BCD(eMi) ; DH := BCD(eSc) ; DL := 0 ; Intr($1A, R) ;
    end end ;


procedure ReadDos(var E : EpochRec) ;
begin with E do begin
    GetDate(eYr, eMo, eDy, eDoW) ; GetTime(eHr, eMi, eSc, eCs) ;
    Writeln('Borland Pascal : GetDate, GetTime => ', DateTimeString(E)) ;
    end end ;


procedure WriteDos(const E : EpochRec) ;
begin with E do begin
    SetDate(eYr, eMo, eDy) ; SetTime(eHr, eMi, eSc, eCs) ;
    end end ;



procedure PushF ; inline($9C) { Push Flags } ;
procedure PopF  ; inline($9D) { Pop  Flags -
  PopF does not restore IE in DPMI or V86 ? } ;
procedure CLI ; inline($FA) { CLI - disable interrupts } ;
procedure STI ; inline($FB) { STI -  enable interrupts } ;

procedure DI ; inline($9C/$FA) ;
procedure EI ; inline($9D) ;

function GetCMOSreg(const A : byte) : byte ;
begin DI ; Port[$70] := A ; GetCMOSreg := Port[$71] ; EI end ;

{ procedure PutCMOSreg(const B : byte ; const A : byte) ;
  begin DI ; Port[$70] := A ; Port[$71] := B ; EI end ; }

function ReadUIPbit : boolean ;
begin ReadUIPbit := (GetCMOSreg($0A) and $80)>0 end ;

procedure WaitForNotUIP ;
begin repeat until not ReadUIPbit end ;

{ procedure WaitForUIPend ;
  begin repeat until ReadUIPbit ; WaitForNotUIP end ; }


function NN(const n2 : byte) : S2 { n2 is BCD nibbles } ;
const St : S2='@@' ;
begin St[1] := DigitArray[n2 shr 4] ; St[2] := DigitArray[n2 and $F] ;
  NN := St end ;

function TimeStringRTC(const RTC : RTCrec) : S30 ;
begin with RTC do
    TimeStringRTC := Sp+NN(rCy)+NN(rYr)+'-'+NN(rMo)+'-'+NN(rDy) +
    Sp+NN(rHr)+':'+NN(rMi)+':'+NN(rSc) end ;


procedure ReadRTCdirectly ;
var RTC : RTCrec ;
begin Write('Read  RTC by direct port access :     ') ;
  WaitForNotUIP ;
  repeat DI ; if not ReadUIPbit then BREAK ; EI until false ;
  with RTC do begin rCy := GetCMOSreg($32) ;
    rYr := GetCMOSreg($09) ; rMo := GetCMOSreg($08) ; rDy := GetCMOSreg($07) ;
    rHr := GetCMOSreg($04) ; rMi := GetCMOSreg($02) ; rSc := GetCMOSreg($00) ;
    EI end ;
  Writeln(TimeStringRTC(RTC)) end ;


var Epo, SaveDos, SaveRTC : EpochRec ;

BEGIN Writeln(^M^J'DATETEST www.merlyn.demon.co.uk >= 1999-02-13') ;

ReadDos(Epo) ; SaveDos := Epo ;
ReadRTC(Epo) ; SaveRTC := Epo ;
Writeln('   Dos values are saved in SaveDos ;') ;

Writeln ;
Writeln('Decrement Day and Hour') ;
with Epo do begin Dec(eDy) ; Dec(eHr) end ;
WriteRTC(Epo) ;
ReadRTC(Epo) ; ReadRTCDirectly ; ReadDos(Epo) ;
Writeln('The paragraph ending here should show'^M^J,
  '  that now the RTC is 25 hours slow, but DOS is correct.') ;

Writeln ;
Writeln ('Now WriteDos(SaveDos) ;') ;
WriteDos(SaveDos) ;
ReadRTC(Epo) ; ReadRTCDirectly ; ReadDos(Epo) ;
Writeln('The paragraph ending here should show'^M^J,
  '  that correcting DOS has corrected the RTC as well.') ;

Write('<cr>') ; Readln ;
END.