{ PICSPCW.CLK - Pascal Integrated Communications System Clock Routines } { Adapted from ROS system file: } { ROSCLK.INC - Remote Operating System Clock Routines } { Author: Werner Cirsovius - January 1988 } { System: CP/M PLUS built in clock } const ref_year = 78; mona : array [1..12] of byte = (31,28,31,30,31,30,31,31,30,31,30,31); function leap(y: integer):boolean; begin leap := ((y mod 4) = 0) end; function february(y: integer):integer; begin if leap(y) then february := 29 else february := 28 end; function year_get(y: integer):integer; begin if leap(y) then year_get := 366 else year_get := 365 end; procedure GetTAD(var t: tad_array); { Return a 6 element byte array of the current system time in seconds, minutes, hours, day, month, and year. } var year,days,mon: integer; comp : boolean; ticks : byte; drtime : integer; block : array[0..3] of byte; begin ticks := BDOS(getclock, addr(block)); t[0] := 10*(ticks div 16) + ticks mod 16; drtime := block[0] + 256*block[1]; for ticks:= 1 to 2 do t[ticks] := 10*(block[4-ticks] div 16) + block[4-ticks] mod 16; year := ref_year; comp := true; while comp do begin days := year_get(year); year := succ(year); if drtime > days then drtime := drtime - days else comp := false; end; t[5] := pred(year); mona[2] := february(pred(year)); comp := true; mon := 0; while comp do begin mon := succ(mon); if drtime >= mona[mon] then drtime := drtime - mona[mon] else comp := false end; t[4] := mon; if drtime = 0 then begin t[4] := pred(mon); drtime := mona[pred(mon)] end; t[3] := drtime end; procedure SetTAD(var t: tad_array); { Set the system time using a 6 element byte array which contains seconds, minutes, hours, day, month, and year. } const days = 365; var ticks : byte; year,drtime : integer; diff,mon : integer; block : array[0..3] of byte; begin year := t[5]; mona[2] := february(year); diff := year - ref_year; drtime := diff*days; if diff > 0 then drtime := drtime + (diff div 4); mon := pred(t[4]); if mon <> 0 then for mon := mon downto 1 do drtime := drtime + mona[mon]; drtime := drtime + t[3]; block[0] := lo(drtime); block[1] := hi(drtime); for ticks:= 1 to 2 do block[4-ticks] := 16*(t[ticks] div 10) + t[ticks] mod 10; BDOS(setclock, addr(block)) end; { Dummy routines for PICS } procedure tick_a_sec; begin end; procedure tick_a_min; begin end;