head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.16.30;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.11.58.03;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.53.33;  author jwh;  state Exp;
branches ;
next     55.3;

55.3
date     91.11.04.13.50.44;  author jwh;  state Exp;
branches ;
next     55.2;

55.2
date     91.11.04.12.59.57;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.28.52;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.10.31.29;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.09.36.56;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.31.19;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.31.13;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.15.38;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.15.15;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.29.54;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.13.42;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.19.59;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.04.06;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.51.15;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.59.10;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.16.16;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.08.42;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.53.00;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.35.17;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.56.35;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.41.18;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.33.11;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.46.54;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.24.35;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.39.51;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.15.06;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.46.46;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.55.42;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.16.46;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.53.45;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.38.30;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.04.46;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.47.14;  author bayes;  state Exp;
branches ;
next     26.4;

26.4
date     88.09.28.13.26.38;  author bayes;  state Exp;
branches ;
next     26.3;

26.3
date     88.09.28.13.26.24;  author bayes;  state Exp;
branches ;
next     26.2;

26.2
date     88.09.28.13.26.11;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.25.56;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.07.57;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.48.04;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.32.14;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.15.50;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.28.11;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.41.02;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.45.26;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.52.31;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.03.23;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.42.14;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.49.50;  author jws;  state Exp;
branches ;
next     13.3;

13.3
date     87.04.01.10.54.36;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.03.31.10.12.32;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.47.02;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.39.14;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.05.48;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.20.21;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.02.45;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.14.34;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.21.44;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.18.52;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.06.59;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.10.13.16.14.09;  author geli;  state Exp;
branches ;
next     3.2;

3.2
date     86.10.13.16.12.09;  author geli;  state Exp;
branches ;
next     3.1;

3.1
date     86.10.13.16.09.27;  author geli;  state Exp;
branches ;
next     2.1;

2.1
date     86.10.13.16.08.01;  author geli;  state Exp;
branches ;
next     1.2;

1.2
date     86.10.13.16.05.47;  author geli;  state Exp;
branches ;
next     1.1;

1.1
date     86.10.13.16.04.35;  author geli;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@(*

 (c) Copyright Hewlett-Packard Company, 1986.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$SYSPROG$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$ALLOW_PACKED ON$  {JWS 3/31/87 }

PROGRAM A804XINIT(OUTPUT);
MODULE A804XDVR;

$SEARCH 'INITLOAD','ASM','SYSDEVS','INIT'$

IMPORT SYSGLOBALS,SYSDEVS,ISR,ASM;
EXPORT
TYPE
  DATAHOOKTYPE = PROCEDURE(DATA:BYTE);
VAR
  DATAHOOK : DATAHOOKTYPE;
  STATUS5HOOK : KBDHOOKTYPE;
  STATUS6HOOK : KBDHOOKTYPE;

  PROCEDURE SENDCMD(CMD:BYTE);
  PROCEDURE SENDDATA(DATA:BYTE);
  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);

  FUNCTION  INITA804X:BOOLEAN;

IMPLEMENT

CONST
  UP = TRUE; DOWN = FALSE;
TYPE
  STATUSTYPE = PACKED RECORD
		 CASE INTEGER OF
		 0:(PAD1  :0..63;
		    BUSY  :BOOLEAN;
		    READY :BOOLEAN);
		 1:(STATBYTE :CHAR);
	       END;
  STRING3 = STRING[3];

VAR
  DATAREG   [HEX('428001')] : CHAR;
  STATUSREG [HEX('428003')] : CHAR;
  CMDREG    [HEX('428003')] : CHAR;
  ISRREC        : ISRIB;
  MAXDATA       : SHORTINT;
  HAVEDATA      : SHORTINT;
  DATABUFFER    : WINDOWP;
  EXTLEFT,EXTRIGHT: BOOLEAN;
  MASK          : BYTE;
  BOBBATPRESENT : BOOLEAN;      {SFB 4/11/85}

  PROCEDURE DUMMYSTATUS56(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN END;

  PROCEDURE STATUS5ISR(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN { IF ANYTHING WRONG THEN RESET EXTENDCHAR BITS }
	{ OTHERWISE IGNORE IT}
    IF DATABYTE>127 THEN BEGIN EXTLEFT:=FALSE; EXTRIGHT:=FALSE; END;
  END;

  PROCEDURE DATAISR(DATA:BYTE);
  BEGIN
    IF HAVEDATA<MAXDATA THEN
    BEGIN DATABUFFER^[HAVEDATA]:=CHR(DATA);
	  HAVEDATA:=HAVEDATA+1;
    END;
  END;


  PROCEDURE A804XISR(ISRIBPTR : PISRIB);
  VAR
    STATUS,DATA : BYTE;
    DOIT        : BOOLEAN;
  BEGIN
    STATUS := ORD(STATUSREG);   { READ STATUS REG }
    DATA   := ORD(DATAREG);     { READ DATA REG }
    DOIT   := TRUE;
    CASE STATUS DIV 16 OF
    0,7    : { UN IMPLEMENTED OPERATIONS };
	     { 0 RESERVED; 7 REPORT ON POWERUP }
    1,2,3  : CALL(TIMERISRHOOK,STATUS,DATA,DOIT);
    4      : CALL(DATAHOOK,DATA);    { REQUESTED DATA OTHER THAN CARAVAN }
    5      : CALL(STATUS5HOOK,STATUS,DATA,DOIT); { CARAVAN STATUS CHANGE }
    6      : CALL(STATUS6HOOK,STATUS,DATA,DOIT); { CARAVAN RAW DATA }
    8..11  : BEGIN
	       CALL(KBDTRANSHOOK,STATUS,DATA,DOIT);
	       IF DOIT THEN CALL(KBDISRHOOK,STATUS,DATA,DOIT);
	     END;
    OTHERWISE CALL(RPGISRHOOK,STATUS,DATA,DOIT);
    END;
  END;


  PROCEDURE POLLISR(WAIT:BOOLEAN);
  VAR KBDSTATUS : STATUSTYPE;
      ISRIBPTR  : PISRIB;
  BEGIN
    IF INTLEVEL>0 THEN
    BEGIN { POLL FOR INTERUPT OR JUST LEAVE }
      REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
      UNTIL KBDSTATUS.READY OR NOT WAIT;
      IF KBDSTATUS.READY THEN
      BEGIN ISRIBPTR := ADDR(ISRREC); A804XISR(ISRIBPTR); END;
    END;
  END;

  PROCEDURE SETUPREAD(COUNT:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  BEGIN
    MAXDATA:=COUNT; HAVEDATA:=0; DATABUFFER:=ADDR(BUFFER,OFFSET);
  END;

  PROCEDURE WAIT4KBDREADY;
  VAR KBDSTATUS : STATUSTYPE;
  BEGIN
    REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
    UNTIL NOT KBDSTATUS.BUSY;
  END;

  PROCEDURE SENDCMD(CMD:BYTE);
  BEGIN WAIT4KBDREADY; CMDREG:=CHR(CMD);
  END;

  PROCEDURE SENDDATA(DATA:BYTE);
  BEGIN WAIT4KBDREADY; DATAREG:=CHR(DATA);
  END;

  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);
  BEGIN DATA := 0;      {set ALL 16 BITS TO 0 - SFB 5/1/85}
	SETUPREAD(1,DATA,1); SENDCMD(CMD);
	WHILE HAVEDATA<MAXDATA DO POLLISR(TRUE);
  END;

  PROCEDURE SENDBYTESLSF(N:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  VAR I : SHORTINT;      { SEND LEAST SIGNIFICANT BYTE FIRST }
  BEGIN
    FOR I:=N-1 DOWNTO 0 DO SENDDATA(ORD(BUFFER[I+OFFSET]));
  END;

  PROCEDURE BEEPOP(FREQUENCY,DURATION : BYTE);
  BEGIN
    SENDCMD(HEX('A3'));
    SENDDATA((256-DURATION) MOD 256); SENDDATA(FREQUENCY);
  END;

  PROCEDURE MASKOPS(ENABLE,DISABLE:BYTE);
  BEGIN
    MASK:=IOR(DISABLE,IAND(MASK,-1-ENABLE));
    SENDCMD(HEX('40')+MASK);
  END;

  PROCEDURE DO_RPGOPS(CMD : BYTE; VAR DATA : BYTE);
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE RPG }
    1: MASKOPS(0,KBDMASK);      { DISABLE RPG }
    2: BEGIN SENDCMD(HEX('A6')); SENDDATA(DATA); END;    { SET RATE }
    3: BEGIN SENDCMD(HEX('26')); CMD_READ_1(HEX('17'),DATA) ; END;
				{FIX 4/12/84 SFB GET RATE}
    OTHERWISE
    END;
  END;

  PROCEDURE DO_KBDOPS(CMD: BYTE; VAR DATA: BYTE);
  TYPE
    LANGITF=ARRAY[0..31] OF LANGTYPE;
    LANGNONITF=ARRAY[0..5] OF LANGTYPE;
  CONST
    WHICHITFLANG=LANGITF[NO_KBD,NO_KBD,NO_KBD,SWISS_FR_KBD,NO_KBD,NO_KBD,
			  NO_KBD,CDN_ENG_KBD,NO_KBD,NO_KBD,NO_KBD,ITALIAN_KBD,
			  NO_KBD,DUTCH_KBD,SWEDISH_KBD,GERMAN_KBD,
			  NO_KBD,NO_KBD,
			  SWISS_FR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  SPANISH_EUR_KBD,
			  SWISS_GR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  BELGIAN_KBD,FINISH_KBD,UK_KBD,CDN_FR_KBD,
			  SWISS_GR_KBD,NORWEGIAN_KBD,FRENCH_KBD,DANISH_KBD,
			  KATAKANA_KBD,SPANISH_LATIN_KBD,US_KBD];
    WHICHNONITFLANG = LANGNONITF[US_KBD,FRENCH_KBD,GERMAN_KBD,SWEDISH_KBD,
			    SPANISH_KBD,KATAKANA_KBD];
  VAR C:BYTE;
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE KEYBOARD }
    1: MASKOPS(0,KBDMASK);      { DISABLE KEYBOARD }
    2,3: BEGIN
	 IF CMD=2 THEN C:=HEX('A0') { SET AUTO DELAY }
		  ELSE C:=HEX('A2'); { SET REPEAT RATE }
	 SENDCMD(C); SENDDATA(256-DATA);
       END;
    4,5: BEGIN
	 IF CMD=4 THEN C:=HEX('20')  {GET DELAY}
		  ELSE C:=HEX('22'); {GET REPEAT}
	 SENDCMD(C);                 { COPY DATA TO TIMER - SFB 3/20/84 }
	 CMD_READ_1(HEX('17'),DATA); DATA:=256-DATA; { READ byte from TIMER
						       SFB 3/20/84 }
       END;
    6: BEGIN    { SET_KBDTYPE }
	 CMD_READ_1(HEX('11'),KBDCONFIG);
	 IF ODD(KBDCONFIG DIV 32) THEN BEGIN
	   HIL_PRESENT:=TRUE;
	   IF ODD(KBDCONFIG DIV 2) THEN
	     KBDTYPE:=LARGEKBD
	   ELSE
	     KBDTYPE:=ITFKBD
	 END
	 ELSE BEGIN
	   HIL_PRESENT:=FALSE;
	   IF ODD(KBDCONFIG) THEN KBDTYPE:=SMALLKBD
			     ELSE KBDTYPE:=LARGEKBD;
	 END;
	 DATA:=KBDCONFIG;
       END;
     7:BEGIN    { SET_KBDLANG }
	 CMD_READ_1(HEX('12'),DATA);
	 CASE KBDTYPE OF
	   SMALLKBD,LARGEKBD : KBDLANG:=WHICHNONITFLANG[DATA];
	   ITFKBD            : KBDLANG:=WHICHITFLANG[DATA MOD 32];
	   OTHERWISE          KBDLANG:=NO_KBD;
	 END;
       END;
    OTHERWISE
    END;
  END;

  PROCEDURE SEND_WAIT(L:STRING3);
  VAR I,J : SHORTINT;    { SEND COMMANDS & WAIT FOR DATA }
  BEGIN
    FOR I:=1 TO STRLEN(L) DO
    BEGIN J:=HAVEDATA; SENDCMD(ORD(L[I])); WHILE J=HAVEDATA DO; END;
  END;


 {Bobcat battery backed clock support--SFB 4/11/85}

 function bobcatbatterybackedclock : boolean;
 var tmp : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  bobcatbatterybackedclock := false;
  cmd_read_1(hex('11'), tmp);
  if odd(tmp div 32) then
   begin
    cmd_read_1(hex('FE'),tmp);             {read extended ID reg on 8042}
    bobcatbatterybackedclock := odd(tmp div 32);
   end;
  setintlevel(oldlevel);
 end;


 function write_bobbat(data, reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(data*16 + reg);               {packed as nibbles}
  sendcmd(hex('C2'));                    {trigger write}
  cmd_read_1(hex('C3'), tmp);            {read back for confirmation}
  write_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 function read_bobbat(reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(reg);
  cmd_read_1(hex('C3'), tmp);            {trigger read and read}
  read_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 procedure readbobtimedate(var yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     readok : boolean;
     buf    : array[0..12] of shortint;
 begin
  repeat
   readok := true;
   for i := 0 to 12 do           {read the bobbat time}
    buf[i] := read_bobbat(i);
   for i := 0 to 12 do           {and read again to ensure not rippling}
    if buf[i] <> read_bobbat(i) then
     readok := false;            {at least 1 byte changed so it was rippling}
  until readok;

  sec := buf[1]*10  + buf[0];
  min := buf[3]*10  + buf[2];
  hr  := (buf[5] mod 4)*10 + buf[4];
  dd  := buf[8]*10  + buf[7];
  mm  := buf[10]*10 + buf[9];
  yr  := buf[12]*10 + buf[11];

  {RDQ 14MAR88 yr 0..27 cvt to 100..127
	       yr 28..69 illegal
	       yr 70..127 are ok}
  {patch for case where clock hardware rolled the year over}
  if (yr>=0) and (yr<=27) then yr := yr +100;
  {invalid date screening}
  if (sec > 59) or (min > 59) or (hr > 23) or (dd > 31) or (mm > 12) or
     (yr > 127) or (yr < 70) or (dd = 0) or (mm = 0) then
   {LAF 880211 default time changed to 1Jan70 from 1Mar00}
   begin         {no valid timedate in bobbat clock}
    sec := 0;    {so return default}
    min := 0;
    hr  := 0;
    dd  := 1;
    mm  := 1;
    yr  :=70;
   end;
 end;


 procedure setbobtimedate(yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     tmp    : byte;
     error  : boolean;
     buf    : array[0..12] of shortint;
 begin
  buf[0] := sec mod 10;          {format the data for bobcat battery clock}
  buf[1] := sec div 10;
  buf[2] := min mod 10;
  buf[3] := min div 10;
  buf[4] := hr  mod 10;
  buf[5] := (hr div 10) + 8;     {set "24-hour clock" bit}
  buf[6] := 0;                   {buf[6] is "don't care"}
  buf[7] := dd  mod 10;
  buf[8] := dd  div 10;
  buf[9] := mm  mod 10;
  buf[10]:= mm  div 10;
  buf[11]:= yr  mod 10;
  buf[12]:= yr  div 10;
  repeat                                 {try to send all 13 bytes of data}
   error := false;
   tmp := write_bobbat(15,13);   {reset prescaler}
   for i := 0 to 12 do
    begin
     tmp := write_bobbat(buf[i], i);     {tmp is readback of data sent}
     if tmp <> buf[i] then
      error := true;
    end;
  until not error;       {keep trying if error in transmission}
 end;

function cvt_bob_to_rtc(yr,mm,dd,hr,min,sec : integer): rtctime;
var ttime : rtctime;
    ldate: daterec;
    ltime: timerec;

begin
 with ldate, ltime do begin
   year:=yr {mod 100};   {LAF 880211 range is now 0..127}
   month:=mm;
   day:=dd;
   hour:=hr;
   minute:=min;
   centisecond:=sec*100;
 end;
 ttime.packedtime:=timedate_to_secs(ldate,ltime);
 ttime.packeddate:=ttime.packedtime div 86400;
 ttime.packedtime:=(ttime.packedtime mod 86400)*100;
 cvt_bob_to_rtc  := ttime;
end;

PROCEDURE CLOCKOPS(CMD:CLOCKOP; VAR THETIME:RTCTIME); {MODS SFB 4/11/85}
var yr,mm,dd,hr,min,sec : integer;
    TTIME : RTCTIME;
    LTIME : TIMEREC;
    LDATE : DATEREC;
    SECS: INTEGER;
  BEGIN
    CASE CMD OF
    CGET:
	  BEGIN         { READ THE TIME AND DATE }
	   THETIME.PACKEDTIME:=0; SETUPREAD(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('31')); SEND_WAIT(#21#20#19);
	   THETIME.PACKEDDATE:=0; SETUPREAD(2,THETIME.PACKEDDATE,2);
	   SEND_WAIT(#23#22);
	  END;
    CSET:
	  BEGIN         { SET THE TIME AND DATE }
	   SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);
	   IF BOBBATPRESENT THEN        { UPDATE IT ALSO--SFB 4/11/85 }
	    BEGIN
	     TTIME.PACKEDTIME:=THETIME.PACKEDDATE*86400
			       +(THETIME.PACKEDTIME+50) DIV 100;
	     TTIME.PACKEDTIME:=TTIME.PACKEDTIME+TIMEZONE;
	     SECS_TO_TIMEDATE(TTIME.PACKEDTIME, LDATE, LTIME);
	     WITH LTIME,LDATE DO       {ADDED 4/17/86 JWS -- TIMEZONE FIX}
	       {LAF 880211 year range is now 0..127}
	       SETBOBTIMEDATE(YEAR {MOD 100}, MONTH, DAY, HOUR, MINUTE,
			       CENTISECOND DIV 100);
	    END; {IF }
	  END;

    CUPDATE:            { SFB 4/11/85 } {UPDATE RTC FROM BOBBAT, AND COPY
					 TO THETIME AS SIDE EFFECT}
	  BEGIN         { COPY BOBCAT BATTERY BACKED CLOCK TO 8042 RTC }
	   IF BOBBATPRESENT THEN        { COPY IT TO RTC }
	    BEGIN
	     READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	     TTIME := CVT_BOB_TO_RTC(YR, MM, DD, HR, MIN, SEC);
	     THETIME := TTIME;
	     CLOCKOPS(CSET, TTIME);
	    END;
	  END;

    CTZ:                {JWS 4/17/86 -- SET TIME ZONE, ADJUST LOCAL TIME}
	 BEGIN
	   IF BOBBATPRESENT THEN BEGIN  {SET LOCAL TIME TO BATTERY + TZ }
	     WITH LDATE, LTIME, TTIME DO BEGIN
	       READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	       YEAR:=YR {MOD 100};   {LAF 880211 range is now 0..127}
	       MONTH:=MM;
	       DAY:=DD;
	       HOUR:=HR;
	       MINUTE:=MIN;
	       CENTISECOND:=SEC*100;
	       PACKEDTIME:=TIMEDATE_TO_SECS(LDATE,LTIME);
	       PACKEDTIME:=TTIME.PACKEDTIME-TIMEZONE; {NOTE SUBTRACTION!}
	       PACKEDDATE:=PACKEDTIME DIV 86400;
	       PACKEDTIME:=(PACKEDTIME MOD 86400)*100;

	       {UPDATE THE 8042}
	       SENDCMD(HEX('AD')); SENDBYTESLSF(3,TTIME.PACKEDTIME,1);
	       SENDCMD(HEX('AF')); SENDBYTESLSF(2,TTIME.PACKEDDATE,2);
	     END; {WITH}
	   END; { IF BOBBATPRESENT }
	 END; {BEGIN}
    END;        {CASE}
  END;

  PROCEDURE TIMEROPS(TIMER:TIMERTYPES; OP:TIMEROPTYPE;
		     VAR TD:TIMERDATA);
  VAR TDATA:INTEGER;
      C    : BYTE;
  BEGIN
    CASE OP OF
    SETT:
      CASE TIMER OF
	DELAYT,CYCLICT:
	   BEGIN
	     IF TIMER=CYCLICT THEN C:=HEX('BA') ELSE C:=HEX('B7');
	     SENDCMD(C);
	     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
	     ELSE
	     BEGIN TDATA:=16777216-TD.COUNT; SENDBYTESLSF(3,TDATA,1); END;
	   END;
	PERIODICT:;     { DON'T DO ANY THING }
	DELAY7T:   BEGIN
		     SENDCMD(HEX('B2'));
		     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
		     ELSE
		     BEGIN TDATA:=65536-TD.COUNT; SENDBYTESLSF(2,TDATA,2); END;
		   END;
	MATCHT:    BEGIN
		     TDATA:=(TD.MATCH.HOUR*360000)+(TD.MATCH.MINUTE*6000)+
			     TD.MATCH.CENTISECOND;
		     SENDCMD(HEX('B4'));
		     IF TDATA=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
				ELSE SENDBYTESLSF(3,TDATA,1);
		   END;
	OTHERWISE
      END; { CASE TIMER }
    READT:
      BEGIN
	TDATA:=0;
	CASE TIMER OF
	  DELAYT,CYCLICT:
		   BEGIN
		     SETUPREAD(3,TDATA,1);
		     IF TIMER=CYCLICT THEN C:=HEX('3E') ELSE C:=HEX('3B');
		     SENDCMD(C); SEND_WAIT(#21#20#19);
		     TD.COUNT:=16777216-TDATA;
		   END;
	  PERIODICT: TD.COUNT:=1;
	  DELAY7T: BEGIN
		     SETUPREAD(2,TDATA,2);
		     SENDCMD(HEX('36')); SEND_WAIT(#20#19);
		     TD.COUNT:= 65536-TDATA;
		   END;
	  MATCHT:  BEGIN
		     SETUPREAD(3,TDATA,1);
		     SENDCMD(HEX('38')); SEND_WAIT(#21#20#19);
		     TD.MATCH.HOUR:=TDATA DIV 360000;
		    {TD.MATCH.MINUTE BUGFIX SFB 5/1/85}
		     TD.MATCH.MINUTE:=(TDATA-(TD.MATCH.HOUR*360000)) DIV 6000;
		     TD.MATCH.CENTISECOND:= TDATA MOD 6000;
		   END;
	  OTHERWISE
	END; { CASE TIMER }
      END;
    GETTINFO:
      BEGIN
	TD.RESOLUTION:=10000;
	IF TIMER=DELAY7T THEN TD.RANGE:=65535
	ELSE
	IF TIMER=PERIODICT THEN TD.RANGE:=1
			   ELSE TD.RANGE:=16777215;
      END;
    END; { CASE OP }
  END;


  PROCEDURE KEYTRANS(VAR STATBYTE,KEY: BYTE; VAR DOKEY: BOOLEAN);
  VAR EXTSTATE: BOOLEAN;

    PROCEDURE SSET(VAR K:BOOLEAN);
    BEGIN K:=TRUE; DOKEY:=TRANSMODE=KPASS_EXTC;
	  EXTSTATE:= DOKEY;
    END;
    PROCEDURE SCLEAR(VAR K:BOOLEAN);
    BEGIN K:=FALSE; DOKEY:=FALSE;
	  IF TRANSMODE=KPASS_EXTC THEN EXTSTATE:= TRUE
	  ELSE EXTSTATE:= NOT (EXTLEFT OR EXTRIGHT);
    END;

  BEGIN {KEYTRANS}
    STATBYTE := (STATBYTE DIV 16)*16; DOKEY:=TRUE;
    IF KBDTYPE=ITFKBD THEN
    BEGIN
      IF TRANSMODE=KPASSTHRU THEN EXTSTATE:= UP
      ELSE
      BEGIN     { NOT PASSTHRU }
	IF KEY=18 THEN SSET(EXTLEFT)
	ELSE
	 IF KEY=19 THEN SSET(EXTRIGHT)
	 ELSE
	  IF KEY=146 THEN SCLEAR(EXTLEFT)
	  ELSE
	   IF KEY=147 THEN SCLEAR(EXTRIGHT)
	   ELSE
	   BEGIN
	     IF KBDSYSMODE THEN
	     CASE KEY OF
	     27: KEY:=26;  {F1=K0}
	     28: KEY:=42;  {F2=RECALL}
	     29: KEY:=51;  {F5=STEP}
	     30: KEY:=49;  {F6=ALPHA}
	     31: KEY:=50;  {F7=GRAPHICS}
	     32: KEY:=45;  {F3=CLR->END}
	     33: KEY:=58;  {F4=CONTINUE}
	     34,35: ; { UP AND DOWN ARROW KEYS }
	     36: KEY:=37;  {F8=K9}
	     OTHERWISE
	     END; { CASE KEY }
	     IF TRANSMODE=KSHIFT_EXTC THEN EXTSTATE:= NOT(EXTLEFT OR EXTRIGHT)
				      ELSE EXTSTATE:= UP;
	   END;
      END;  { NOT PASSTHRU MODE }
      STATBYTE:=STATBYTE+(ORD(EXTSTATE)*8)+7; { INCLUDE EXTCHAR STATUS }
    END     { ITFKBD }
    ELSE STATBYTE:=STATBYTE+15; { TURN ON ALL LOW ORDER BITS }
  END;  {KEYTRANS}

  FUNCTION INITA804X:BOOLEAN;
  VAR
    i : integer;
    TEMP : BYTE;
    THETIME:RTCTIME; {JWS 3/31/87}
  BEGIN
    INITA804X:=FALSE;
    TRY
      TEMP := ORD(STATUSREG);   { IS THE 8041/8042 PRESENT ? }
      MASK := 0;          { INITIALIZE MASK }
      MASKOPS(0,KBDMASK+RESETMASK+TIMERMASK+PSIMASK+FHIMASK);
      PERMISRLINK(A804XISR,ADDR(STATUSREG),1,1,1,ADDR(ISRREC));
      HAVEDATA := 0;  MAXDATA := 0;
      BFREQUENCY:=8;  BDURATION:=8;
      BEEPERHOOK := BEEPOP;
      RPGREQHOOK := DO_RPGOPS;
      KBDREQHOOK := DO_KBDOPS;
      KBDPOLLHOOK:= POLLISR;
      CLOCKIOHOOK:= CLOCKOPS;
      TIMERIOHOOK:= TIMEROPS;
      DATAHOOK   := DATAISR;
      DO_KBDOPS(SET_KBDTYPE,TEMP);
      DO_KBDOPS(SET_KBDLANG,TEMP);
      KBDSYSMODE  :=TRUE;
      IF KBDTYPE=ITFKBD THEN SETSTATUS(6,'S');
      TRANSMODE   := KPASSTHRU;
      KBDALTLOCK  := FALSE; KBDCAPSLOCK:=TRUE;
      EXTLEFT     := FALSE; EXTRIGHT := FALSE;
      KBDTRANSHOOK:= KEYTRANS;
      MASKOPSHOOK := MASKOPS;
      STATUS5HOOK := DUMMYSTATUS56;
      STATUS6HOOK := DUMMYSTATUS56;

      BOBBATPRESENT := BOBCATBATTERYBACKEDCLOCK;      {SFB 4/11/85}

      {FIX TO CLEAR 804X CLOCK IN CASE OTHER OS
       SET IT TO A STRANGE BASE }
      THETIME.PACKEDTIME:=0;  {JWS 3/31/87}
      THETIME.PACKEDDATE:=0;  {JWS 3/31/87}
      SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);  {JWS 3/31/87}
      SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);  {JWS 3/31/87}

      INITA804X   := TRUE;
    RECOVER
      IF ESCAPECODE<>-12 THEN ESCAPE(ESCAPECODE);
  END; {INITA804X}

END; {MODULE}

IMPORT A804XDVR,LOADER;
BEGIN
  IF INITA804X THEN MARKUSER;
END. {PROGRAM}
@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 645
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 645
(*

 (c) Copyright Hewlett-Packard Company, 1986.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$SYSPROG$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$ALLOW_PACKED ON$  {JWS 3/31/87 }

PROGRAM A804XINIT(OUTPUT);
MODULE A804XDVR;

$SEARCH 'INITLOAD','ASM','SYSDEVS','INIT'$

IMPORT SYSGLOBALS,SYSDEVS,ISR,ASM;
EXPORT
TYPE
  DATAHOOKTYPE = PROCEDURE(DATA:BYTE);
VAR
  DATAHOOK : DATAHOOKTYPE;
  STATUS5HOOK : KBDHOOKTYPE;
  STATUS6HOOK : KBDHOOKTYPE;

  PROCEDURE SENDCMD(CMD:BYTE);
  PROCEDURE SENDDATA(DATA:BYTE);
  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);

  FUNCTION  INITA804X:BOOLEAN;

IMPLEMENT

CONST
  UP = TRUE; DOWN = FALSE;
TYPE
  STATUSTYPE = PACKED RECORD
		 CASE INTEGER OF
		 0:(PAD1  :0..63;
		    BUSY  :BOOLEAN;
		    READY :BOOLEAN);
		 1:(STATBYTE :CHAR);
	       END;
  STRING3 = STRING[3];

VAR
  DATAREG   [HEX('428001')] : CHAR;
  STATUSREG [HEX('428003')] : CHAR;
  CMDREG    [HEX('428003')] : CHAR;
  ISRREC        : ISRIB;
  MAXDATA       : SHORTINT;
  HAVEDATA      : SHORTINT;
  DATABUFFER    : WINDOWP;
  EXTLEFT,EXTRIGHT: BOOLEAN;
  MASK          : BYTE;
  BOBBATPRESENT : BOOLEAN;      {SFB 4/11/85}

  PROCEDURE DUMMYSTATUS56(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN END;

  PROCEDURE STATUS5ISR(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN { IF ANYTHING WRONG THEN RESET EXTENDCHAR BITS }
	{ OTHERWISE IGNORE IT}
    IF DATABYTE>127 THEN BEGIN EXTLEFT:=FALSE; EXTRIGHT:=FALSE; END;
  END;

  PROCEDURE DATAISR(DATA:BYTE);
  BEGIN
    IF HAVEDATA<MAXDATA THEN
    BEGIN DATABUFFER^[HAVEDATA]:=CHR(DATA);
	  HAVEDATA:=HAVEDATA+1;
    END;
  END;


  PROCEDURE A804XISR(ISRIBPTR : PISRIB);
  VAR
    STATUS,DATA : BYTE;
    DOIT        : BOOLEAN;
  BEGIN
    STATUS := ORD(STATUSREG);   { READ STATUS REG }
    DATA   := ORD(DATAREG);     { READ DATA REG }
    DOIT   := TRUE;
    CASE STATUS DIV 16 OF
    0,7    : { UN IMPLEMENTED OPERATIONS };
	     { 0 RESERVED; 7 REPORT ON POWERUP }
    1,2,3  : CALL(TIMERISRHOOK,STATUS,DATA,DOIT);
    4      : CALL(DATAHOOK,DATA);    { REQUESTED DATA OTHER THAN CARAVAN }
    5      : CALL(STATUS5HOOK,STATUS,DATA,DOIT); { CARAVAN STATUS CHANGE }
    6      : CALL(STATUS6HOOK,STATUS,DATA,DOIT); { CARAVAN RAW DATA }
    8..11  : BEGIN
	       CALL(KBDTRANSHOOK,STATUS,DATA,DOIT);
	       IF DOIT THEN CALL(KBDISRHOOK,STATUS,DATA,DOIT);
	     END;
    OTHERWISE CALL(RPGISRHOOK,STATUS,DATA,DOIT);
    END;
  END;


  PROCEDURE POLLISR(WAIT:BOOLEAN);
  VAR KBDSTATUS : STATUSTYPE;
      ISRIBPTR  : PISRIB;
  BEGIN
    IF INTLEVEL>0 THEN
    BEGIN { POLL FOR INTERUPT OR JUST LEAVE }
      REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
      UNTIL KBDSTATUS.READY OR NOT WAIT;
      IF KBDSTATUS.READY THEN
      BEGIN ISRIBPTR := ADDR(ISRREC); A804XISR(ISRIBPTR); END;
    END;
  END;

  PROCEDURE SETUPREAD(COUNT:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  BEGIN
    MAXDATA:=COUNT; HAVEDATA:=0; DATABUFFER:=ADDR(BUFFER,OFFSET);
  END;

  PROCEDURE WAIT4KBDREADY;
  VAR KBDSTATUS : STATUSTYPE;
  BEGIN
    REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
    UNTIL NOT KBDSTATUS.BUSY;
  END;

  PROCEDURE SENDCMD(CMD:BYTE);
  BEGIN WAIT4KBDREADY; CMDREG:=CHR(CMD);
  END;

  PROCEDURE SENDDATA(DATA:BYTE);
  BEGIN WAIT4KBDREADY; DATAREG:=CHR(DATA);
  END;

  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);
  BEGIN DATA := 0;      {set ALL 16 BITS TO 0 - SFB 5/1/85}
	SETUPREAD(1,DATA,1); SENDCMD(CMD);
	WHILE HAVEDATA<MAXDATA DO POLLISR(TRUE);
  END;

  PROCEDURE SENDBYTESLSF(N:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  VAR I : SHORTINT;      { SEND LEAST SIGNIFICANT BYTE FIRST }
  BEGIN
    FOR I:=N-1 DOWNTO 0 DO SENDDATA(ORD(BUFFER[I+OFFSET]));
  END;

  PROCEDURE BEEPOP(FREQUENCY,DURATION : BYTE);
  BEGIN
    SENDCMD(HEX('A3'));
    SENDDATA((256-DURATION) MOD 256); SENDDATA(FREQUENCY);
  END;

  PROCEDURE MASKOPS(ENABLE,DISABLE:BYTE);
  BEGIN
    MASK:=IOR(DISABLE,IAND(MASK,-1-ENABLE));
    SENDCMD(HEX('40')+MASK);
  END;

  PROCEDURE DO_RPGOPS(CMD : BYTE; VAR DATA : BYTE);
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE RPG }
    1: MASKOPS(0,KBDMASK);      { DISABLE RPG }
    2: BEGIN SENDCMD(HEX('A6')); SENDDATA(DATA); END;    { SET RATE }
    3: BEGIN SENDCMD(HEX('26')); CMD_READ_1(HEX('17'),DATA) ; END;
				{FIX 4/12/84 SFB GET RATE}
    OTHERWISE
    END;
  END;

  PROCEDURE DO_KBDOPS(CMD: BYTE; VAR DATA: BYTE);
  TYPE
    LANGITF=ARRAY[0..31] OF LANGTYPE;
    LANGNONITF=ARRAY[0..5] OF LANGTYPE;
  CONST
    WHICHITFLANG=LANGITF[NO_KBD,NO_KBD,NO_KBD,SWISS_FR_KBD,NO_KBD,NO_KBD,
			  NO_KBD,CDN_ENG_KBD,NO_KBD,NO_KBD,NO_KBD,ITALIAN_KBD,
			  NO_KBD,DUTCH_KBD,SWEDISH_KBD,GERMAN_KBD,
			  NO_KBD,NO_KBD,
			  SWISS_FR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  SPANISH_EUR_KBD,
			  SWISS_GR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  BELGIAN_KBD,FINISH_KBD,UK_KBD,CDN_FR_KBD,
			  SWISS_GR_KBD,NORWEGIAN_KBD,FRENCH_KBD,DANISH_KBD,
			  KATAKANA_KBD,SPANISH_LATIN_KBD,US_KBD];
    WHICHNONITFLANG = LANGNONITF[US_KBD,FRENCH_KBD,GERMAN_KBD,SWEDISH_KBD,
			    SPANISH_KBD,KATAKANA_KBD];
  VAR C:BYTE;
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE KEYBOARD }
    1: MASKOPS(0,KBDMASK);      { DISABLE KEYBOARD }
    2,3: BEGIN
	 IF CMD=2 THEN C:=HEX('A0') { SET AUTO DELAY }
		  ELSE C:=HEX('A2'); { SET REPEAT RATE }
	 SENDCMD(C); SENDDATA(256-DATA);
       END;
    4,5: BEGIN
	 IF CMD=4 THEN C:=HEX('20')  {GET DELAY}
		  ELSE C:=HEX('22'); {GET REPEAT}
	 SENDCMD(C);                 { COPY DATA TO TIMER - SFB 3/20/84 }
	 CMD_READ_1(HEX('17'),DATA); DATA:=256-DATA; { READ byte from TIMER
						       SFB 3/20/84 }
       END;
    6: BEGIN    { SET_KBDTYPE }
	 CMD_READ_1(HEX('11'),KBDCONFIG);
	 IF ODD(KBDCONFIG DIV 32) THEN BEGIN
	   HIL_PRESENT:=TRUE;
	   IF ODD(KBDCONFIG DIV 2) THEN
	     KBDTYPE:=LARGEKBD
	   ELSE
	     KBDTYPE:=ITFKBD
	 END
	 ELSE BEGIN
	   HIL_PRESENT:=FALSE;
	   IF ODD(KBDCONFIG) THEN KBDTYPE:=SMALLKBD
			     ELSE KBDTYPE:=LARGEKBD;
	 END;
	 DATA:=KBDCONFIG;
       END;
     7:BEGIN    { SET_KBDLANG }
	 CMD_READ_1(HEX('12'),DATA);
	 CASE KBDTYPE OF
	   SMALLKBD,LARGEKBD : KBDLANG:=WHICHNONITFLANG[DATA];
	   ITFKBD            : KBDLANG:=WHICHITFLANG[DATA MOD 32];
	   OTHERWISE          KBDLANG:=NO_KBD;
	 END;
       END;
    OTHERWISE
    END;
  END;

  PROCEDURE SEND_WAIT(L:STRING3);
  VAR I,J : SHORTINT;    { SEND COMMANDS & WAIT FOR DATA }
  BEGIN
    FOR I:=1 TO STRLEN(L) DO
    BEGIN J:=HAVEDATA; SENDCMD(ORD(L[I])); WHILE J=HAVEDATA DO; END;
  END;


 {Bobcat battery backed clock support--SFB 4/11/85}

 function bobcatbatterybackedclock : boolean;
 var tmp : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  bobcatbatterybackedclock := false;
  cmd_read_1(hex('11'), tmp);
  if odd(tmp div 32) then
   begin
    cmd_read_1(hex('FE'),tmp);             {read extended ID reg on 8042}
    bobcatbatterybackedclock := odd(tmp div 32);
   end;
  setintlevel(oldlevel);
 end;


 function write_bobbat(data, reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(data*16 + reg);               {packed as nibbles}
  sendcmd(hex('C2'));                    {trigger write}
  cmd_read_1(hex('C3'), tmp);            {read back for confirmation}
  write_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 function read_bobbat(reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(reg);
  cmd_read_1(hex('C3'), tmp);            {trigger read and read}
  read_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 procedure readbobtimedate(var yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     readok : boolean;
     buf    : array[0..12] of shortint;
 begin
  repeat
   readok := true;
   for i := 0 to 12 do           {read the bobbat time}
    buf[i] := read_bobbat(i);
   for i := 0 to 12 do           {and read again to ensure not rippling}
    if buf[i] <> read_bobbat(i) then
     readok := false;            {at least 1 byte changed so it was rippling}
  until readok;

  sec := buf[1]*10  + buf[0];
  min := buf[3]*10  + buf[2];
  hr  := (buf[5] mod 4)*10 + buf[4];
  dd  := buf[8]*10  + buf[7];
  mm  := buf[10]*10 + buf[9];
  yr  := buf[12]*10 + buf[11];

  {RDQ 14MAR88 yr 0..27 cvt to 100..127
	       yr 28..69 illegal
	       yr 70..127 are ok}
  {patch for case where clock hardware rolled the year over}
  if (yr>=0) and (yr<=27) then yr := yr +100;
  {invalid date screening}
  if (sec > 59) or (min > 59) or (hr > 23) or (dd > 31) or (mm > 12) or
     (yr > 127) or (yr < 70) or (dd = 0) or (mm = 0) then
   {LAF 880211 default time changed to 1Jan70 from 1Mar00}
   begin         {no valid timedate in bobbat clock}
    sec := 0;    {so return default}
    min := 0;
    hr  := 0;
    dd  := 1;
    mm  := 1;
    yr  :=70;
   end;
 end;


 procedure setbobtimedate(yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     tmp    : byte;
     error  : boolean;
     buf    : array[0..12] of shortint;
 begin
  buf[0] := sec mod 10;          {format the data for bobcat battery clock}
  buf[1] := sec div 10;
  buf[2] := min mod 10;
  buf[3] := min div 10;
  buf[4] := hr  mod 10;
  buf[5] := (hr div 10) + 8;     {set "24-hour clock" bit}
  buf[6] := 0;                   {buf[6] is "don't care"}
  buf[7] := dd  mod 10;
  buf[8] := dd  div 10;
  buf[9] := mm  mod 10;
  buf[10]:= mm  div 10;
  buf[11]:= yr  mod 10;
  buf[12]:= yr  div 10;
  repeat                                 {try to send all 13 bytes of data}
   error := false;
   tmp := write_bobbat(15,13);   {reset prescaler}
   for i := 0 to 12 do
    begin
     tmp := write_bobbat(buf[i], i);     {tmp is readback of data sent}
     if tmp <> buf[i] then
      error := true;
    end;
  until not error;       {keep trying if error in transmission}
 end;

function cvt_bob_to_rtc(yr,mm,dd,hr,min,sec : integer): rtctime;
var ttime : rtctime;
    ldate: daterec;
    ltime: timerec;

begin
 with ldate, ltime do begin
   year:=yr {mod 100};   {LAF 880211 range is now 0..127}
   month:=mm;
   day:=dd;
   hour:=hr;
   minute:=min;
   centisecond:=sec*100;
 end;
 ttime.packedtime:=timedate_to_secs(ldate,ltime);
 ttime.packeddate:=ttime.packedtime div 86400;
 ttime.packedtime:=(ttime.packedtime mod 86400)*100;
 cvt_bob_to_rtc  := ttime;
end;

PROCEDURE CLOCKOPS(CMD:CLOCKOP; VAR THETIME:RTCTIME); {MODS SFB 4/11/85}
var yr,mm,dd,hr,min,sec : integer;
    TTIME : RTCTIME;
    LTIME : TIMEREC;
    LDATE : DATEREC;
    SECS: INTEGER;
  BEGIN
    CASE CMD OF
    CGET:
	  BEGIN         { READ THE TIME AND DATE }
	   THETIME.PACKEDTIME:=0; SETUPREAD(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('31')); SEND_WAIT(#21#20#19);
	   THETIME.PACKEDDATE:=0; SETUPREAD(2,THETIME.PACKEDDATE,2);
	   SEND_WAIT(#23#22);
	  END;
    CSET:
	  BEGIN         { SET THE TIME AND DATE }
	   SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);
	   IF BOBBATPRESENT THEN        { UPDATE IT ALSO--SFB 4/11/85 }
	    BEGIN
	     TTIME.PACKEDTIME:=THETIME.PACKEDDATE*86400
			       +(THETIME.PACKEDTIME+50) DIV 100;
	     TTIME.PACKEDTIME:=TTIME.PACKEDTIME+TIMEZONE;
	     SECS_TO_TIMEDATE(TTIME.PACKEDTIME, LDATE, LTIME);
	     WITH LTIME,LDATE DO       {ADDED 4/17/86 JWS -- TIMEZONE FIX}
	       {LAF 880211 year range is now 0..127}
	       SETBOBTIMEDATE(YEAR {MOD 100}, MONTH, DAY, HOUR, MINUTE,
			       CENTISECOND DIV 100);
	    END; {IF }
	  END;

    CUPDATE:            { SFB 4/11/85 } {UPDATE RTC FROM BOBBAT, AND COPY
					 TO THETIME AS SIDE EFFECT}
	  BEGIN         { COPY BOBCAT BATTERY BACKED CLOCK TO 8042 RTC }
	   IF BOBBATPRESENT THEN        { COPY IT TO RTC }
	    BEGIN
	     READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	     TTIME := CVT_BOB_TO_RTC(YR, MM, DD, HR, MIN, SEC);
	     THETIME := TTIME;
	     CLOCKOPS(CSET, TTIME);
	    END;
	  END;

    CTZ:                {JWS 4/17/86 -- SET TIME ZONE, ADJUST LOCAL TIME}
	 BEGIN
	   IF BOBBATPRESENT THEN BEGIN  {SET LOCAL TIME TO BATTERY + TZ }
	     WITH LDATE, LTIME, TTIME DO BEGIN
	       READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	       YEAR:=YR {MOD 100};   {LAF 880211 range is now 0..127}
	       MONTH:=MM;
	       DAY:=DD;
	       HOUR:=HR;
	       MINUTE:=MIN;
	       CENTISECOND:=SEC*100;
	       PACKEDTIME:=TIMEDATE_TO_SECS(LDATE,LTIME);
	       PACKEDTIME:=TTIME.PACKEDTIME-TIMEZONE; {NOTE SUBTRACTION!}
	       PACKEDDATE:=PACKEDTIME DIV 86400;
	       PACKEDTIME:=(PACKEDTIME MOD 86400)*100;

	       {UPDATE THE 8042}
	       SENDCMD(HEX('AD')); SENDBYTESLSF(3,TTIME.PACKEDTIME,1);
	       SENDCMD(HEX('AF')); SENDBYTESLSF(2,TTIME.PACKEDDATE,2);
	     END; {WITH}
	   END; { IF BOBBATPRESENT }
	 END; {BEGIN}
    END;        {CASE}
  END;

  PROCEDURE TIMEROPS(TIMER:TIMERTYPES; OP:TIMEROPTYPE;
		     VAR TD:TIMERDATA);
  VAR TDATA:INTEGER;
      C    : BYTE;
  BEGIN
    CASE OP OF
    SETT:
      CASE TIMER OF
	DELAYT,CYCLICT:
	   BEGIN
	     IF TIMER=CYCLICT THEN C:=HEX('BA') ELSE C:=HEX('B7');
	     SENDCMD(C);
	     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
	     ELSE
	     BEGIN TDATA:=16777216-TD.COUNT; SENDBYTESLSF(3,TDATA,1); END;
	   END;
	PERIODICT:;     { DON'T DO ANY THING }
	DELAY7T:   BEGIN
		     SENDCMD(HEX('B2'));
		     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
		     ELSE
		     BEGIN TDATA:=65536-TD.COUNT; SENDBYTESLSF(2,TDATA,2); END;
		   END;
	MATCHT:    BEGIN
		     TDATA:=(TD.MATCH.HOUR*360000)+(TD.MATCH.MINUTE*6000)+
			     TD.MATCH.CENTISECOND;
		     SENDCMD(HEX('B4'));
		     IF TDATA=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
				ELSE SENDBYTESLSF(3,TDATA,1);
		   END;
	OTHERWISE
      END; { CASE TIMER }
    READT:
      BEGIN
	TDATA:=0;
	CASE TIMER OF
	  DELAYT,CYCLICT:
		   BEGIN
		     SETUPREAD(3,TDATA,1);
		     IF TIMER=CYCLICT THEN C:=HEX('3E') ELSE C:=HEX('3B');
		     SENDCMD(C); SEND_WAIT(#21#20#19);
		     TD.COUNT:=16777216-TDATA;
		   END;
	  PERIODICT: TD.COUNT:=1;
	  DELAY7T: BEGIN
		     SETUPREAD(2,TDATA,2);
		     SENDCMD(HEX('36')); SEND_WAIT(#20#19);
		     TD.COUNT:= 65536-TDATA;
		   END;
	  MATCHT:  BEGIN
		     SETUPREAD(3,TDATA,1);
		     SENDCMD(HEX('38')); SEND_WAIT(#21#20#19);
		     TD.MATCH.HOUR:=TDATA DIV 360000;
		    {TD.MATCH.MINUTE BUGFIX SFB 5/1/85}
		     TD.MATCH.MINUTE:=(TDATA-(TD.MATCH.HOUR*360000)) DIV 6000;
		     TD.MATCH.CENTISECOND:= TDATA MOD 6000;
		   END;
	  OTHERWISE
	END; { CASE TIMER }
      END;
    GETTINFO:
      BEGIN
	TD.RESOLUTION:=10000;
	IF TIMER=DELAY7T THEN TD.RANGE:=65535
	ELSE
	IF TIMER=PERIODICT THEN TD.RANGE:=1
			   ELSE TD.RANGE:=16777215;
      END;
    END; { CASE OP }
  END;


  PROCEDURE KEYTRANS(VAR STATBYTE,KEY: BYTE; VAR DOKEY: BOOLEAN);
  VAR EXTSTATE: BOOLEAN;

    PROCEDURE SSET(VAR K:BOOLEAN);
    BEGIN K:=TRUE; DOKEY:=TRANSMODE=KPASS_EXTC;
	  EXTSTATE:= DOKEY;
    END;
    PROCEDURE SCLEAR(VAR K:BOOLEAN);
    BEGIN K:=FALSE; DOKEY:=FALSE;
	  IF TRANSMODE=KPASS_EXTC THEN EXTSTATE:= TRUE
	  ELSE EXTSTATE:= NOT (EXTLEFT OR EXTRIGHT);
    END;

  BEGIN {KEYTRANS}
    STATBYTE := (STATBYTE DIV 16)*16; DOKEY:=TRUE;
    IF KBDTYPE=ITFKBD THEN
    BEGIN
      IF TRANSMODE=KPASSTHRU THEN EXTSTATE:= UP
      ELSE
      BEGIN     { NOT PASSTHRU }
	IF KEY=18 THEN SSET(EXTLEFT)
	ELSE
	 IF KEY=19 THEN SSET(EXTRIGHT)
	 ELSE
	  IF KEY=146 THEN SCLEAR(EXTLEFT)
	  ELSE
	   IF KEY=147 THEN SCLEAR(EXTRIGHT)
	   ELSE
	   BEGIN
	     IF KBDSYSMODE THEN
	     CASE KEY OF
	     27: KEY:=26;  {F1=K0}
	     28: KEY:=42;  {F2=RECALL}
	     29: KEY:=51;  {F5=STEP}
	     30: KEY:=49;  {F6=ALPHA}
	     31: KEY:=50;  {F7=GRAPHICS}
	     32: KEY:=45;  {F3=CLR->END}
	     33: KEY:=58;  {F4=CONTINUE}
	     34,35: ; { UP AND DOWN ARROW KEYS }
	     36: KEY:=37;  {F8=K9}
	     OTHERWISE
	     END; { CASE KEY }
	     IF TRANSMODE=KSHIFT_EXTC THEN EXTSTATE:= NOT(EXTLEFT OR EXTRIGHT)
				      ELSE EXTSTATE:= UP;
	   END;
      END;  { NOT PASSTHRU MODE }
      STATBYTE:=STATBYTE+(ORD(EXTSTATE)*8)+7; { INCLUDE EXTCHAR STATUS }
    END     { ITFKBD }
    ELSE STATBYTE:=STATBYTE+15; { TURN ON ALL LOW ORDER BITS }
  END;  {KEYTRANS}

  FUNCTION INITA804X:BOOLEAN;
  VAR
    i : integer;
    TEMP : BYTE;
    THETIME:RTCTIME; {JWS 3/31/87}
  BEGIN
    INITA804X:=FALSE;
    TRY
      TEMP := ORD(STATUSREG);   { IS THE 8041/8042 PRESENT ? }
      MASK := 0;          { INITIALIZE MASK }
      MASKOPS(0,KBDMASK+RESETMASK+TIMERMASK+PSIMASK+FHIMASK);
      PERMISRLINK(A804XISR,ADDR(STATUSREG),1,1,1,ADDR(ISRREC));
      HAVEDATA := 0;  MAXDATA := 0;
      BFREQUENCY:=8;  BDURATION:=8;
      BEEPERHOOK := BEEPOP;
      RPGREQHOOK := DO_RPGOPS;
      KBDREQHOOK := DO_KBDOPS;
      KBDPOLLHOOK:= POLLISR;
      CLOCKIOHOOK:= CLOCKOPS;
      TIMERIOHOOK:= TIMEROPS;
      DATAHOOK   := DATAISR;
      DO_KBDOPS(SET_KBDTYPE,TEMP);
      DO_KBDOPS(SET_KBDLANG,TEMP);
      KBDSYSMODE  :=TRUE;
      IF KBDTYPE=ITFKBD THEN SETSTATUS(6,'S');
      TRANSMODE   := KPASSTHRU;
      KBDALTLOCK  := FALSE; KBDCAPSLOCK:=TRUE;
      EXTLEFT     := FALSE; EXTRIGHT := FALSE;
      KBDTRANSHOOK:= KEYTRANS;
      MASKOPSHOOK := MASKOPS;
      STATUS5HOOK := DUMMYSTATUS56;
      STATUS6HOOK := DUMMYSTATUS56;

      BOBBATPRESENT := BOBCATBATTERYBACKEDCLOCK;      {SFB 4/11/85}

      {FIX TO CLEAR 804X CLOCK IN CASE OTHER OS
       SET IT TO A STRANGE BASE }
      THETIME.PACKEDTIME:=0;  {JWS 3/31/87}
      THETIME.PACKEDDATE:=0;  {JWS 3/31/87}
      SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);  {JWS 3/31/87}
      SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);  {JWS 3/31/87}

      INITA804X   := TRUE;
    RECOVER
      IF ESCAPECODE<>-12 THEN ESCAPE(ESCAPECODE);
  END; {INITA804X}

END; {MODULE}

IMPORT A804XDVR,LOADER;
BEGIN
  IF INITA804X THEN MARKUSER;
END. {PROGRAM}
@


55.3
log
@
pws2rcs automatic delta on Mon Nov  4 13:45:04 MST 1991
@
text
@@


55.2
log
@
pws2rcs automatic delta on Mon Nov  4 12:54:35 MST 1991
@
text
@d1 645
@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@a0 645
(*

 (c) Copyright Hewlett-Packard Company, 1986.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$SYSPROG$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$ALLOW_PACKED ON$  {JWS 3/31/87 }

PROGRAM A804XINIT(OUTPUT);
MODULE A804XDVR;

$SEARCH 'INITLOAD','ASM','SYSDEVS','INIT'$

IMPORT SYSGLOBALS,SYSDEVS,ISR,ASM;
EXPORT
TYPE
  DATAHOOKTYPE = PROCEDURE(DATA:BYTE);
VAR
  DATAHOOK : DATAHOOKTYPE;
  STATUS5HOOK : KBDHOOKTYPE;
  STATUS6HOOK : KBDHOOKTYPE;

  PROCEDURE SENDCMD(CMD:BYTE);
  PROCEDURE SENDDATA(DATA:BYTE);
  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);

  FUNCTION  INITA804X:BOOLEAN;

IMPLEMENT

CONST
  UP = TRUE; DOWN = FALSE;
TYPE
  STATUSTYPE = PACKED RECORD
		 CASE INTEGER OF
		 0:(PAD1  :0..63;
		    BUSY  :BOOLEAN;
		    READY :BOOLEAN);
		 1:(STATBYTE :CHAR);
	       END;
  STRING3 = STRING[3];

VAR
  DATAREG   [HEX('428001')] : CHAR;
  STATUSREG [HEX('428003')] : CHAR;
  CMDREG    [HEX('428003')] : CHAR;
  ISRREC        : ISRIB;
  MAXDATA       : SHORTINT;
  HAVEDATA      : SHORTINT;
  DATABUFFER    : WINDOWP;
  EXTLEFT,EXTRIGHT: BOOLEAN;
  MASK          : BYTE;
  BOBBATPRESENT : BOOLEAN;      {SFB 4/11/85}

  PROCEDURE DUMMYSTATUS56(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN END;

  PROCEDURE STATUS5ISR(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN { IF ANYTHING WRONG THEN RESET EXTENDCHAR BITS }
	{ OTHERWISE IGNORE IT}
    IF DATABYTE>127 THEN BEGIN EXTLEFT:=FALSE; EXTRIGHT:=FALSE; END;
  END;

  PROCEDURE DATAISR(DATA:BYTE);
  BEGIN
    IF HAVEDATA<MAXDATA THEN
    BEGIN DATABUFFER^[HAVEDATA]:=CHR(DATA);
	  HAVEDATA:=HAVEDATA+1;
    END;
  END;


  PROCEDURE A804XISR(ISRIBPTR : PISRIB);
  VAR
    STATUS,DATA : BYTE;
    DOIT        : BOOLEAN;
  BEGIN
    STATUS := ORD(STATUSREG);   { READ STATUS REG }
    DATA   := ORD(DATAREG);     { READ DATA REG }
    DOIT   := TRUE;
    CASE STATUS DIV 16 OF
    0,7    : { UN IMPLEMENTED OPERATIONS };
	     { 0 RESERVED; 7 REPORT ON POWERUP }
    1,2,3  : CALL(TIMERISRHOOK,STATUS,DATA,DOIT);
    4      : CALL(DATAHOOK,DATA);    { REQUESTED DATA OTHER THAN CARAVAN }
    5      : CALL(STATUS5HOOK,STATUS,DATA,DOIT); { CARAVAN STATUS CHANGE }
    6      : CALL(STATUS6HOOK,STATUS,DATA,DOIT); { CARAVAN RAW DATA }
    8..11  : BEGIN
	       CALL(KBDTRANSHOOK,STATUS,DATA,DOIT);
	       IF DOIT THEN CALL(KBDISRHOOK,STATUS,DATA,DOIT);
	     END;
    OTHERWISE CALL(RPGISRHOOK,STATUS,DATA,DOIT);
    END;
  END;


  PROCEDURE POLLISR(WAIT:BOOLEAN);
  VAR KBDSTATUS : STATUSTYPE;
      ISRIBPTR  : PISRIB;
  BEGIN
    IF INTLEVEL>0 THEN
    BEGIN { POLL FOR INTERUPT OR JUST LEAVE }
      REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
      UNTIL KBDSTATUS.READY OR NOT WAIT;
      IF KBDSTATUS.READY THEN
      BEGIN ISRIBPTR := ADDR(ISRREC); A804XISR(ISRIBPTR); END;
    END;
  END;

  PROCEDURE SETUPREAD(COUNT:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  BEGIN
    MAXDATA:=COUNT; HAVEDATA:=0; DATABUFFER:=ADDR(BUFFER,OFFSET);
  END;

  PROCEDURE WAIT4KBDREADY;
  VAR KBDSTATUS : STATUSTYPE;
  BEGIN
    REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
    UNTIL NOT KBDSTATUS.BUSY;
  END;

  PROCEDURE SENDCMD(CMD:BYTE);
  BEGIN WAIT4KBDREADY; CMDREG:=CHR(CMD);
  END;

  PROCEDURE SENDDATA(DATA:BYTE);
  BEGIN WAIT4KBDREADY; DATAREG:=CHR(DATA);
  END;

  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);
  BEGIN DATA := 0;      {set ALL 16 BITS TO 0 - SFB 5/1/85}
	SETUPREAD(1,DATA,1); SENDCMD(CMD);
	WHILE HAVEDATA<MAXDATA DO POLLISR(TRUE);
  END;

  PROCEDURE SENDBYTESLSF(N:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  VAR I : SHORTINT;      { SEND LEAST SIGNIFICANT BYTE FIRST }
  BEGIN
    FOR I:=N-1 DOWNTO 0 DO SENDDATA(ORD(BUFFER[I+OFFSET]));
  END;

  PROCEDURE BEEPOP(FREQUENCY,DURATION : BYTE);
  BEGIN
    SENDCMD(HEX('A3'));
    SENDDATA((256-DURATION) MOD 256); SENDDATA(FREQUENCY);
  END;

  PROCEDURE MASKOPS(ENABLE,DISABLE:BYTE);
  BEGIN
    MASK:=IOR(DISABLE,IAND(MASK,-1-ENABLE));
    SENDCMD(HEX('40')+MASK);
  END;

  PROCEDURE DO_RPGOPS(CMD : BYTE; VAR DATA : BYTE);
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE RPG }
    1: MASKOPS(0,KBDMASK);      { DISABLE RPG }
    2: BEGIN SENDCMD(HEX('A6')); SENDDATA(DATA); END;    { SET RATE }
    3: BEGIN SENDCMD(HEX('26')); CMD_READ_1(HEX('17'),DATA) ; END;
				{FIX 4/12/84 SFB GET RATE}
    OTHERWISE
    END;
  END;

  PROCEDURE DO_KBDOPS(CMD: BYTE; VAR DATA: BYTE);
  TYPE
    LANGITF=ARRAY[0..31] OF LANGTYPE;
    LANGNONITF=ARRAY[0..5] OF LANGTYPE;
  CONST
    WHICHITFLANG=LANGITF[NO_KBD,NO_KBD,NO_KBD,SWISS_FR_KBD,NO_KBD,NO_KBD,
			  NO_KBD,CDN_ENG_KBD,NO_KBD,NO_KBD,NO_KBD,ITALIAN_KBD,
			  NO_KBD,DUTCH_KBD,SWEDISH_KBD,GERMAN_KBD,
			  NO_KBD,NO_KBD,
			  SWISS_FR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  SPANISH_EUR_KBD,
			  SWISS_GR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  BELGIAN_KBD,FINISH_KBD,UK_KBD,CDN_FR_KBD,
			  SWISS_GR_KBD,NORWEGIAN_KBD,FRENCH_KBD,DANISH_KBD,
			  KATAKANA_KBD,SPANISH_LATIN_KBD,US_KBD];
    WHICHNONITFLANG = LANGNONITF[US_KBD,FRENCH_KBD,GERMAN_KBD,SWEDISH_KBD,
			    SPANISH_KBD,KATAKANA_KBD];
  VAR C:BYTE;
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE KEYBOARD }
    1: MASKOPS(0,KBDMASK);      { DISABLE KEYBOARD }
    2,3: BEGIN
	 IF CMD=2 THEN C:=HEX('A0') { SET AUTO DELAY }
		  ELSE C:=HEX('A2'); { SET REPEAT RATE }
	 SENDCMD(C); SENDDATA(256-DATA);
       END;
    4,5: BEGIN
	 IF CMD=4 THEN C:=HEX('20')  {GET DELAY}
		  ELSE C:=HEX('22'); {GET REPEAT}
	 SENDCMD(C);                 { COPY DATA TO TIMER - SFB 3/20/84 }
	 CMD_READ_1(HEX('17'),DATA); DATA:=256-DATA; { READ byte from TIMER
						       SFB 3/20/84 }
       END;
    6: BEGIN    { SET_KBDTYPE }
	 CMD_READ_1(HEX('11'),KBDCONFIG);
	 IF ODD(KBDCONFIG DIV 32) THEN BEGIN
	   HIL_PRESENT:=TRUE;
	   IF ODD(KBDCONFIG DIV 2) THEN
	     KBDTYPE:=LARGEKBD
	   ELSE
	     KBDTYPE:=ITFKBD
	 END
	 ELSE BEGIN
	   HIL_PRESENT:=FALSE;
	   IF ODD(KBDCONFIG) THEN KBDTYPE:=SMALLKBD
			     ELSE KBDTYPE:=LARGEKBD;
	 END;
	 DATA:=KBDCONFIG;
       END;
     7:BEGIN    { SET_KBDLANG }
	 CMD_READ_1(HEX('12'),DATA);
	 CASE KBDTYPE OF
	   SMALLKBD,LARGEKBD : KBDLANG:=WHICHNONITFLANG[DATA];
	   ITFKBD            : KBDLANG:=WHICHITFLANG[DATA MOD 32];
	   OTHERWISE          KBDLANG:=NO_KBD;
	 END;
       END;
    OTHERWISE
    END;
  END;

  PROCEDURE SEND_WAIT(L:STRING3);
  VAR I,J : SHORTINT;    { SEND COMMANDS & WAIT FOR DATA }
  BEGIN
    FOR I:=1 TO STRLEN(L) DO
    BEGIN J:=HAVEDATA; SENDCMD(ORD(L[I])); WHILE J=HAVEDATA DO; END;
  END;


 {Bobcat battery backed clock support--SFB 4/11/85}

 function bobcatbatterybackedclock : boolean;
 var tmp : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  bobcatbatterybackedclock := false;
  cmd_read_1(hex('11'), tmp);
  if odd(tmp div 32) then
   begin
    cmd_read_1(hex('FE'),tmp);             {read extended ID reg on 8042}
    bobcatbatterybackedclock := odd(tmp div 32);
   end;
  setintlevel(oldlevel);
 end;


 function write_bobbat(data, reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(data*16 + reg);               {packed as nibbles}
  sendcmd(hex('C2'));                    {trigger write}
  cmd_read_1(hex('C3'), tmp);            {read back for confirmation}
  write_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 function read_bobbat(reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(reg);
  cmd_read_1(hex('C3'), tmp);            {trigger read and read}
  read_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 procedure readbobtimedate(var yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     readok : boolean;
     buf    : array[0..12] of shortint;
 begin
  repeat
   readok := true;
   for i := 0 to 12 do           {read the bobbat time}
    buf[i] := read_bobbat(i);
   for i := 0 to 12 do           {and read again to ensure not rippling}
    if buf[i] <> read_bobbat(i) then
     readok := false;            {at least 1 byte changed so it was rippling}
  until readok;

  sec := buf[1]*10  + buf[0];
  min := buf[3]*10  + buf[2];
  hr  := (buf[5] mod 4)*10 + buf[4];
  dd  := buf[8]*10  + buf[7];
  mm  := buf[10]*10 + buf[9];
  yr  := buf[12]*10 + buf[11];

  {RDQ 14MAR88 yr 0..27 cvt to 100..127
	       yr 28..69 illegal
	       yr 70..127 are ok}
  {patch for case where clock hardware rolled the year over}
  if (yr>=0) and (yr<=27) then yr := yr +100;
  {invalid date screening}
  if (sec > 59) or (min > 59) or (hr > 23) or (dd > 31) or (mm > 12) or
     (yr > 127) or (yr < 70) or (dd = 0) or (mm = 0) then
   {LAF 880211 default time changed to 1Jan70 from 1Mar00}
   begin         {no valid timedate in bobbat clock}
    sec := 0;    {so return default}
    min := 0;
    hr  := 0;
    dd  := 1;
    mm  := 1;
    yr  :=70;
   end;
 end;


 procedure setbobtimedate(yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     tmp    : byte;
     error  : boolean;
     buf    : array[0..12] of shortint;
 begin
  buf[0] := sec mod 10;          {format the data for bobcat battery clock}
  buf[1] := sec div 10;
  buf[2] := min mod 10;
  buf[3] := min div 10;
  buf[4] := hr  mod 10;
  buf[5] := (hr div 10) + 8;     {set "24-hour clock" bit}
  buf[6] := 0;                   {buf[6] is "don't care"}
  buf[7] := dd  mod 10;
  buf[8] := dd  div 10;
  buf[9] := mm  mod 10;
  buf[10]:= mm  div 10;
  buf[11]:= yr  mod 10;
  buf[12]:= yr  div 10;
  repeat                                 {try to send all 13 bytes of data}
   error := false;
   tmp := write_bobbat(15,13);   {reset prescaler}
   for i := 0 to 12 do
    begin
     tmp := write_bobbat(buf[i], i);     {tmp is readback of data sent}
     if tmp <> buf[i] then
      error := true;
    end;
  until not error;       {keep trying if error in transmission}
 end;

function cvt_bob_to_rtc(yr,mm,dd,hr,min,sec : integer): rtctime;
var ttime : rtctime;
    ldate: daterec;
    ltime: timerec;

begin
 with ldate, ltime do begin
   year:=yr {mod 100};   {LAF 880211 range is now 0..127}
   month:=mm;
   day:=dd;
   hour:=hr;
   minute:=min;
   centisecond:=sec*100;
 end;
 ttime.packedtime:=timedate_to_secs(ldate,ltime);
 ttime.packeddate:=ttime.packedtime div 86400;
 ttime.packedtime:=(ttime.packedtime mod 86400)*100;
 cvt_bob_to_rtc  := ttime;
end;

PROCEDURE CLOCKOPS(CMD:CLOCKOP; VAR THETIME:RTCTIME); {MODS SFB 4/11/85}
var yr,mm,dd,hr,min,sec : integer;
    TTIME : RTCTIME;
    LTIME : TIMEREC;
    LDATE : DATEREC;
    SECS: INTEGER;
  BEGIN
    CASE CMD OF
    CGET:
	  BEGIN         { READ THE TIME AND DATE }
	   THETIME.PACKEDTIME:=0; SETUPREAD(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('31')); SEND_WAIT(#21#20#19);
	   THETIME.PACKEDDATE:=0; SETUPREAD(2,THETIME.PACKEDDATE,2);
	   SEND_WAIT(#23#22);
	  END;
    CSET:
	  BEGIN         { SET THE TIME AND DATE }
	   SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);
	   IF BOBBATPRESENT THEN        { UPDATE IT ALSO--SFB 4/11/85 }
	    BEGIN
	     TTIME.PACKEDTIME:=THETIME.PACKEDDATE*86400
			       +(THETIME.PACKEDTIME+50) DIV 100;
	     TTIME.PACKEDTIME:=TTIME.PACKEDTIME+TIMEZONE;
	     SECS_TO_TIMEDATE(TTIME.PACKEDTIME, LDATE, LTIME);
	     WITH LTIME,LDATE DO       {ADDED 4/17/86 JWS -- TIMEZONE FIX}
	       {LAF 880211 year range is now 0..127}
	       SETBOBTIMEDATE(YEAR {MOD 100}, MONTH, DAY, HOUR, MINUTE,
			       CENTISECOND DIV 100);
	    END; {IF }
	  END;

    CUPDATE:            { SFB 4/11/85 } {UPDATE RTC FROM BOBBAT, AND COPY
					 TO THETIME AS SIDE EFFECT}
	  BEGIN         { COPY BOBCAT BATTERY BACKED CLOCK TO 8042 RTC }
	   IF BOBBATPRESENT THEN        { COPY IT TO RTC }
	    BEGIN
	     READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	     TTIME := CVT_BOB_TO_RTC(YR, MM, DD, HR, MIN, SEC);
	     THETIME := TTIME;
	     CLOCKOPS(CSET, TTIME);
	    END;
	  END;

    CTZ:                {JWS 4/17/86 -- SET TIME ZONE, ADJUST LOCAL TIME}
	 BEGIN
	   IF BOBBATPRESENT THEN BEGIN  {SET LOCAL TIME TO BATTERY + TZ }
	     WITH LDATE, LTIME, TTIME DO BEGIN
	       READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	       YEAR:=YR {MOD 100};   {LAF 880211 range is now 0..127}
	       MONTH:=MM;
	       DAY:=DD;
	       HOUR:=HR;
	       MINUTE:=MIN;
	       CENTISECOND:=SEC*100;
	       PACKEDTIME:=TIMEDATE_TO_SECS(LDATE,LTIME);
	       PACKEDTIME:=TTIME.PACKEDTIME-TIMEZONE; {NOTE SUBTRACTION!}
	       PACKEDDATE:=PACKEDTIME DIV 86400;
	       PACKEDTIME:=(PACKEDTIME MOD 86400)*100;

	       {UPDATE THE 8042}
	       SENDCMD(HEX('AD')); SENDBYTESLSF(3,TTIME.PACKEDTIME,1);
	       SENDCMD(HEX('AF')); SENDBYTESLSF(2,TTIME.PACKEDDATE,2);
	     END; {WITH}
	   END; { IF BOBBATPRESENT }
	 END; {BEGIN}
    END;        {CASE}
  END;

  PROCEDURE TIMEROPS(TIMER:TIMERTYPES; OP:TIMEROPTYPE;
		     VAR TD:TIMERDATA);
  VAR TDATA:INTEGER;
      C    : BYTE;
  BEGIN
    CASE OP OF
    SETT:
      CASE TIMER OF
	DELAYT,CYCLICT:
	   BEGIN
	     IF TIMER=CYCLICT THEN C:=HEX('BA') ELSE C:=HEX('B7');
	     SENDCMD(C);
	     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
	     ELSE
	     BEGIN TDATA:=16777216-TD.COUNT; SENDBYTESLSF(3,TDATA,1); END;
	   END;
	PERIODICT:;     { DON'T DO ANY THING }
	DELAY7T:   BEGIN
		     SENDCMD(HEX('B2'));
		     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
		     ELSE
		     BEGIN TDATA:=65536-TD.COUNT; SENDBYTESLSF(2,TDATA,2); END;
		   END;
	MATCHT:    BEGIN
		     TDATA:=(TD.MATCH.HOUR*360000)+(TD.MATCH.MINUTE*6000)+
			     TD.MATCH.CENTISECOND;
		     SENDCMD(HEX('B4'));
		     IF TDATA=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
				ELSE SENDBYTESLSF(3,TDATA,1);
		   END;
	OTHERWISE
      END; { CASE TIMER }
    READT:
      BEGIN
	TDATA:=0;
	CASE TIMER OF
	  DELAYT,CYCLICT:
		   BEGIN
		     SETUPREAD(3,TDATA,1);
		     IF TIMER=CYCLICT THEN C:=HEX('3E') ELSE C:=HEX('3B');
		     SENDCMD(C); SEND_WAIT(#21#20#19);
		     TD.COUNT:=16777216-TDATA;
		   END;
	  PERIODICT: TD.COUNT:=1;
	  DELAY7T: BEGIN
		     SETUPREAD(2,TDATA,2);
		     SENDCMD(HEX('36')); SEND_WAIT(#20#19);
		     TD.COUNT:= 65536-TDATA;
		   END;
	  MATCHT:  BEGIN
		     SETUPREAD(3,TDATA,1);
		     SENDCMD(HEX('38')); SEND_WAIT(#21#20#19);
		     TD.MATCH.HOUR:=TDATA DIV 360000;
		    {TD.MATCH.MINUTE BUGFIX SFB 5/1/85}
		     TD.MATCH.MINUTE:=(TDATA-(TD.MATCH.HOUR*360000)) DIV 6000;
		     TD.MATCH.CENTISECOND:= TDATA MOD 6000;
		   END;
	  OTHERWISE
	END; { CASE TIMER }
      END;
    GETTINFO:
      BEGIN
	TD.RESOLUTION:=10000;
	IF TIMER=DELAY7T THEN TD.RANGE:=65535
	ELSE
	IF TIMER=PERIODICT THEN TD.RANGE:=1
			   ELSE TD.RANGE:=16777215;
      END;
    END; { CASE OP }
  END;


  PROCEDURE KEYTRANS(VAR STATBYTE,KEY: BYTE; VAR DOKEY: BOOLEAN);
  VAR EXTSTATE: BOOLEAN;

    PROCEDURE SSET(VAR K:BOOLEAN);
    BEGIN K:=TRUE; DOKEY:=TRANSMODE=KPASS_EXTC;
	  EXTSTATE:= DOKEY;
    END;
    PROCEDURE SCLEAR(VAR K:BOOLEAN);
    BEGIN K:=FALSE; DOKEY:=FALSE;
	  IF TRANSMODE=KPASS_EXTC THEN EXTSTATE:= TRUE
	  ELSE EXTSTATE:= NOT (EXTLEFT OR EXTRIGHT);
    END;

  BEGIN {KEYTRANS}
    STATBYTE := (STATBYTE DIV 16)*16; DOKEY:=TRUE;
    IF KBDTYPE=ITFKBD THEN
    BEGIN
      IF TRANSMODE=KPASSTHRU THEN EXTSTATE:= UP
      ELSE
      BEGIN     { NOT PASSTHRU }
	IF KEY=18 THEN SSET(EXTLEFT)
	ELSE
	 IF KEY=19 THEN SSET(EXTRIGHT)
	 ELSE
	  IF KEY=146 THEN SCLEAR(EXTLEFT)
	  ELSE
	   IF KEY=147 THEN SCLEAR(EXTRIGHT)
	   ELSE
	   BEGIN
	     IF KBDSYSMODE THEN
	     CASE KEY OF
	     27: KEY:=26;  {F1=K0}
	     28: KEY:=42;  {F2=RECALL}
	     29: KEY:=51;  {F5=STEP}
	     30: KEY:=49;  {F6=ALPHA}
	     31: KEY:=50;  {F7=GRAPHICS}
	     32: KEY:=45;  {F3=CLR->END}
	     33: KEY:=58;  {F4=CONTINUE}
	     34,35: ; { UP AND DOWN ARROW KEYS }
	     36: KEY:=37;  {F8=K9}
	     OTHERWISE
	     END; { CASE KEY }
	     IF TRANSMODE=KSHIFT_EXTC THEN EXTSTATE:= NOT(EXTLEFT OR EXTRIGHT)
				      ELSE EXTSTATE:= UP;
	   END;
      END;  { NOT PASSTHRU MODE }
      STATBYTE:=STATBYTE+(ORD(EXTSTATE)*8)+7; { INCLUDE EXTCHAR STATUS }
    END     { ITFKBD }
    ELSE STATBYTE:=STATBYTE+15; { TURN ON ALL LOW ORDER BITS }
  END;  {KEYTRANS}

  FUNCTION INITA804X:BOOLEAN;
  VAR
    i : integer;
    TEMP : BYTE;
    THETIME:RTCTIME; {JWS 3/31/87}
  BEGIN
    INITA804X:=FALSE;
    TRY
      TEMP := ORD(STATUSREG);   { IS THE 8041/8042 PRESENT ? }
      MASK := 0;          { INITIALIZE MASK }
      MASKOPS(0,KBDMASK+RESETMASK+TIMERMASK+PSIMASK+FHIMASK);
      PERMISRLINK(A804XISR,ADDR(STATUSREG),1,1,1,ADDR(ISRREC));
      HAVEDATA := 0;  MAXDATA := 0;
      BFREQUENCY:=8;  BDURATION:=8;
      BEEPERHOOK := BEEPOP;
      RPGREQHOOK := DO_RPGOPS;
      KBDREQHOOK := DO_KBDOPS;
      KBDPOLLHOOK:= POLLISR;
      CLOCKIOHOOK:= CLOCKOPS;
      TIMERIOHOOK:= TIMEROPS;
      DATAHOOK   := DATAISR;
      DO_KBDOPS(SET_KBDTYPE,TEMP);
      DO_KBDOPS(SET_KBDLANG,TEMP);
      KBDSYSMODE  :=TRUE;
      IF KBDTYPE=ITFKBD THEN SETSTATUS(6,'S');
      TRANSMODE   := KPASSTHRU;
      KBDALTLOCK  := FALSE; KBDCAPSLOCK:=TRUE;
      EXTLEFT     := FALSE; EXTRIGHT := FALSE;
      KBDTRANSHOOK:= KEYTRANS;
      MASKOPSHOOK := MASKOPS;
      STATUS5HOOK := DUMMYSTATUS56;
      STATUS6HOOK := DUMMYSTATUS56;

      BOBBATPRESENT := BOBCATBATTERYBACKEDCLOCK;      {SFB 4/11/85}

      {FIX TO CLEAR 804X CLOCK IN CASE OTHER OS
       SET IT TO A STRANGE BASE }
      THETIME.PACKEDTIME:=0;  {JWS 3/31/87}
      THETIME.PACKEDDATE:=0;  {JWS 3/31/87}
      SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);  {JWS 3/31/87}
      SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);  {JWS 3/31/87}

      INITA804X   := TRUE;
    RECOVER
      IF ESCAPECODE<>-12 THEN ESCAPE(ESCAPECODE);
  END; {INITA804X}

END; {MODULE}

IMPORT A804XDVR,LOADER;
BEGIN
  IF INITA804X THEN MARKUSER;
END. {PROGRAM}
@


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 10:27:27 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 645
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 645
(*

 (c) Copyright Hewlett-Packard Company, 1986.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$SYSPROG$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$ALLOW_PACKED ON$  {JWS 3/31/87 }

PROGRAM A804XINIT(OUTPUT);
MODULE A804XDVR;

$SEARCH 'INITLOAD','ASM','SYSDEVS','INIT'$

IMPORT SYSGLOBALS,SYSDEVS,ISR,ASM;
EXPORT
TYPE
  DATAHOOKTYPE = PROCEDURE(DATA:BYTE);
VAR
  DATAHOOK : DATAHOOKTYPE;
  STATUS5HOOK : KBDHOOKTYPE;
  STATUS6HOOK : KBDHOOKTYPE;

  PROCEDURE SENDCMD(CMD:BYTE);
  PROCEDURE SENDDATA(DATA:BYTE);
  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);

  FUNCTION  INITA804X:BOOLEAN;

IMPLEMENT

CONST
  UP = TRUE; DOWN = FALSE;
TYPE
  STATUSTYPE = PACKED RECORD
		 CASE INTEGER OF
		 0:(PAD1  :0..63;
		    BUSY  :BOOLEAN;
		    READY :BOOLEAN);
		 1:(STATBYTE :CHAR);
	       END;
  STRING3 = STRING[3];

VAR
  DATAREG   [HEX('428001')] : CHAR;
  STATUSREG [HEX('428003')] : CHAR;
  CMDREG    [HEX('428003')] : CHAR;
  ISRREC        : ISRIB;
  MAXDATA       : SHORTINT;
  HAVEDATA      : SHORTINT;
  DATABUFFER    : WINDOWP;
  EXTLEFT,EXTRIGHT: BOOLEAN;
  MASK          : BYTE;
  BOBBATPRESENT : BOOLEAN;      {SFB 4/11/85}

  PROCEDURE DUMMYSTATUS56(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN END;

  PROCEDURE STATUS5ISR(VAR STATBYTE,DATABYTE:BYTE; VAR DONE:BOOLEAN);
  BEGIN { IF ANYTHING WRONG THEN RESET EXTENDCHAR BITS }
	{ OTHERWISE IGNORE IT}
    IF DATABYTE>127 THEN BEGIN EXTLEFT:=FALSE; EXTRIGHT:=FALSE; END;
  END;

  PROCEDURE DATAISR(DATA:BYTE);
  BEGIN
    IF HAVEDATA<MAXDATA THEN
    BEGIN DATABUFFER^[HAVEDATA]:=CHR(DATA);
	  HAVEDATA:=HAVEDATA+1;
    END;
  END;


  PROCEDURE A804XISR(ISRIBPTR : PISRIB);
  VAR
    STATUS,DATA : BYTE;
    DOIT        : BOOLEAN;
  BEGIN
    STATUS := ORD(STATUSREG);   { READ STATUS REG }
    DATA   := ORD(DATAREG);     { READ DATA REG }
    DOIT   := TRUE;
    CASE STATUS DIV 16 OF
    0,7    : { UN IMPLEMENTED OPERATIONS };
	     { 0 RESERVED; 7 REPORT ON POWERUP }
    1,2,3  : CALL(TIMERISRHOOK,STATUS,DATA,DOIT);
    4      : CALL(DATAHOOK,DATA);    { REQUESTED DATA OTHER THAN CARAVAN }
    5      : CALL(STATUS5HOOK,STATUS,DATA,DOIT); { CARAVAN STATUS CHANGE }
    6      : CALL(STATUS6HOOK,STATUS,DATA,DOIT); { CARAVAN RAW DATA }
    8..11  : BEGIN
	       CALL(KBDTRANSHOOK,STATUS,DATA,DOIT);
	       IF DOIT THEN CALL(KBDISRHOOK,STATUS,DATA,DOIT);
	     END;
    OTHERWISE CALL(RPGISRHOOK,STATUS,DATA,DOIT);
    END;
  END;


  PROCEDURE POLLISR(WAIT:BOOLEAN);
  VAR KBDSTATUS : STATUSTYPE;
      ISRIBPTR  : PISRIB;
  BEGIN
    IF INTLEVEL>0 THEN
    BEGIN { POLL FOR INTERUPT OR JUST LEAVE }
      REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
      UNTIL KBDSTATUS.READY OR NOT WAIT;
      IF KBDSTATUS.READY THEN
      BEGIN ISRIBPTR := ADDR(ISRREC); A804XISR(ISRIBPTR); END;
    END;
  END;

  PROCEDURE SETUPREAD(COUNT:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  BEGIN
    MAXDATA:=COUNT; HAVEDATA:=0; DATABUFFER:=ADDR(BUFFER,OFFSET);
  END;

  PROCEDURE WAIT4KBDREADY;
  VAR KBDSTATUS : STATUSTYPE;
  BEGIN
    REPEAT KBDSTATUS.STATBYTE:=STATUSREG;
    UNTIL NOT KBDSTATUS.BUSY;
  END;

  PROCEDURE SENDCMD(CMD:BYTE);
  BEGIN WAIT4KBDREADY; CMDREG:=CHR(CMD);
  END;

  PROCEDURE SENDDATA(DATA:BYTE);
  BEGIN WAIT4KBDREADY; DATAREG:=CHR(DATA);
  END;

  PROCEDURE CMD_READ_1(CMD:BYTE; VAR DATA:BYTE);
  BEGIN DATA := 0;      {set ALL 16 BITS TO 0 - SFB 5/1/85}
	SETUPREAD(1,DATA,1); SENDCMD(CMD);
	WHILE HAVEDATA<MAXDATA DO POLLISR(TRUE);
  END;

  PROCEDURE SENDBYTESLSF(N:SHORTINT; ANYVAR BUFFER:WINDOW; OFFSET:SHORTINT);
  VAR I : SHORTINT;      { SEND LEAST SIGNIFICANT BYTE FIRST }
  BEGIN
    FOR I:=N-1 DOWNTO 0 DO SENDDATA(ORD(BUFFER[I+OFFSET]));
  END;

  PROCEDURE BEEPOP(FREQUENCY,DURATION : BYTE);
  BEGIN
    SENDCMD(HEX('A3'));
    SENDDATA((256-DURATION) MOD 256); SENDDATA(FREQUENCY);
  END;

  PROCEDURE MASKOPS(ENABLE,DISABLE:BYTE);
  BEGIN
    MASK:=IOR(DISABLE,IAND(MASK,-1-ENABLE));
    SENDCMD(HEX('40')+MASK);
  END;

  PROCEDURE DO_RPGOPS(CMD : BYTE; VAR DATA : BYTE);
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE RPG }
    1: MASKOPS(0,KBDMASK);      { DISABLE RPG }
    2: BEGIN SENDCMD(HEX('A6')); SENDDATA(DATA); END;    { SET RATE }
    3: BEGIN SENDCMD(HEX('26')); CMD_READ_1(HEX('17'),DATA) ; END;
				{FIX 4/12/84 SFB GET RATE}
    OTHERWISE
    END;
  END;

  PROCEDURE DO_KBDOPS(CMD: BYTE; VAR DATA: BYTE);
  TYPE
    LANGITF=ARRAY[0..31] OF LANGTYPE;
    LANGNONITF=ARRAY[0..5] OF LANGTYPE;
  CONST
    WHICHITFLANG=LANGITF[NO_KBD,NO_KBD,NO_KBD,SWISS_FR_KBD,NO_KBD,NO_KBD,
			  NO_KBD,CDN_ENG_KBD,NO_KBD,NO_KBD,NO_KBD,ITALIAN_KBD,
			  NO_KBD,DUTCH_KBD,SWEDISH_KBD,GERMAN_KBD,
			  NO_KBD,NO_KBD,
			  SWISS_FR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  SPANISH_EUR_KBD,
			  SWISS_GR_B_KBD, {CHANGED FOR 3.1--SFB--5/21/85}
			  BELGIAN_KBD,FINISH_KBD,UK_KBD,CDN_FR_KBD,
			  SWISS_GR_KBD,NORWEGIAN_KBD,FRENCH_KBD,DANISH_KBD,
			  KATAKANA_KBD,SPANISH_LATIN_KBD,US_KBD];
    WHICHNONITFLANG = LANGNONITF[US_KBD,FRENCH_KBD,GERMAN_KBD,SWEDISH_KBD,
			    SPANISH_KBD,KATAKANA_KBD];
  VAR C:BYTE;
  BEGIN
    CASE CMD OF
    0: MASKOPS(KBDMASK,0);      { ENABLE KEYBOARD }
    1: MASKOPS(0,KBDMASK);      { DISABLE KEYBOARD }
    2,3: BEGIN
	 IF CMD=2 THEN C:=HEX('A0') { SET AUTO DELAY }
		  ELSE C:=HEX('A2'); { SET REPEAT RATE }
	 SENDCMD(C); SENDDATA(256-DATA);
       END;
    4,5: BEGIN
	 IF CMD=4 THEN C:=HEX('20')  {GET DELAY}
		  ELSE C:=HEX('22'); {GET REPEAT}
	 SENDCMD(C);                 { COPY DATA TO TIMER - SFB 3/20/84 }
	 CMD_READ_1(HEX('17'),DATA); DATA:=256-DATA; { READ byte from TIMER
						       SFB 3/20/84 }
       END;
    6: BEGIN    { SET_KBDTYPE }
	 CMD_READ_1(HEX('11'),KBDCONFIG);
	 IF ODD(KBDCONFIG DIV 32) THEN BEGIN
	   HIL_PRESENT:=TRUE;
	   IF ODD(KBDCONFIG DIV 2) THEN
	     KBDTYPE:=LARGEKBD
	   ELSE
	     KBDTYPE:=ITFKBD
	 END
	 ELSE BEGIN
	   HIL_PRESENT:=FALSE;
	   IF ODD(KBDCONFIG) THEN KBDTYPE:=SMALLKBD
			     ELSE KBDTYPE:=LARGEKBD;
	 END;
	 DATA:=KBDCONFIG;
       END;
     7:BEGIN    { SET_KBDLANG }
	 CMD_READ_1(HEX('12'),DATA);
	 CASE KBDTYPE OF
	   SMALLKBD,LARGEKBD : KBDLANG:=WHICHNONITFLANG[DATA];
	   ITFKBD            : KBDLANG:=WHICHITFLANG[DATA MOD 32];
	   OTHERWISE          KBDLANG:=NO_KBD;
	 END;
       END;
    OTHERWISE
    END;
  END;

  PROCEDURE SEND_WAIT(L:STRING3);
  VAR I,J : SHORTINT;    { SEND COMMANDS & WAIT FOR DATA }
  BEGIN
    FOR I:=1 TO STRLEN(L) DO
    BEGIN J:=HAVEDATA; SENDCMD(ORD(L[I])); WHILE J=HAVEDATA DO; END;
  END;


 {Bobcat battery backed clock support--SFB 4/11/85}

 function bobcatbatterybackedclock : boolean;
 var tmp : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  bobcatbatterybackedclock := false;
  cmd_read_1(hex('11'), tmp);
  if odd(tmp div 32) then
   begin
    cmd_read_1(hex('FE'),tmp);             {read extended ID reg on 8042}
    bobcatbatterybackedclock := odd(tmp div 32);
   end;
  setintlevel(oldlevel);
 end;


 function write_bobbat(data, reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(data*16 + reg);               {packed as nibbles}
  sendcmd(hex('C2'));                    {trigger write}
  cmd_read_1(hex('C3'), tmp);            {read back for confirmation}
  write_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 function read_bobbat(reg : integer) : integer;
 var tmp : byte;
     oldmask : byte;
     oldlevel : integer;
 begin
  oldlevel := intlevel;
  setintlevel(2);
  tmp := 0;
  sendcmd(hex('E0'));                    {address 8042 buffer}
  senddata(reg);
  cmd_read_1(hex('C3'), tmp);            {trigger read and read}
  read_bobbat := tmp;
  setintlevel(oldlevel);
 end;


 procedure readbobtimedate(var yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     readok : boolean;
     buf    : array[0..12] of shortint;
 begin
  repeat
   readok := true;
   for i := 0 to 12 do           {read the bobbat time}
    buf[i] := read_bobbat(i);
   for i := 0 to 12 do           {and read again to ensure not rippling}
    if buf[i] <> read_bobbat(i) then
     readok := false;            {at least 1 byte changed so it was rippling}
  until readok;

  sec := buf[1]*10  + buf[0];
  min := buf[3]*10  + buf[2];
  hr  := (buf[5] mod 4)*10 + buf[4];
  dd  := buf[8]*10  + buf[7];
  mm  := buf[10]*10 + buf[9];
  yr  := buf[12]*10 + buf[11];

  {RDQ 14MAR88 yr 0..27 cvt to 100..127
	       yr 28..69 illegal
	       yr 70..127 are ok}
  {patch for case where clock hardware rolled the year over}
  if (yr>=0) and (yr<=27) then yr := yr +100;
  {invalid date screening}
  if (sec > 59) or (min > 59) or (hr > 23) or (dd > 31) or (mm > 12) or
     (yr > 127) or (yr < 70) or (dd = 0) or (mm = 0) then
   {LAF 880211 default time changed to 1Jan70 from 1Mar00}
   begin         {no valid timedate in bobbat clock}
    sec := 0;    {so return default}
    min := 0;
    hr  := 0;
    dd  := 1;
    mm  := 1;
    yr  :=70;
   end;
 end;


 procedure setbobtimedate(yr, mm, dd, hr, min, sec : integer);
 var i      : integer;
     tmp    : byte;
     error  : boolean;
     buf    : array[0..12] of shortint;
 begin
  buf[0] := sec mod 10;          {format the data for bobcat battery clock}
  buf[1] := sec div 10;
  buf[2] := min mod 10;
  buf[3] := min div 10;
  buf[4] := hr  mod 10;
  buf[5] := (hr div 10) + 8;     {set "24-hour clock" bit}
  buf[6] := 0;                   {buf[6] is "don't care"}
  buf[7] := dd  mod 10;
  buf[8] := dd  div 10;
  buf[9] := mm  mod 10;
  buf[10]:= mm  div 10;
  buf[11]:= yr  mod 10;
  buf[12]:= yr  div 10;
  repeat                                 {try to send all 13 bytes of data}
   error := false;
   tmp := write_bobbat(15,13);   {reset prescaler}
   for i := 0 to 12 do
    begin
     tmp := write_bobbat(buf[i], i);     {tmp is readback of data sent}
     if tmp <> buf[i] then
      error := true;
    end;
  until not error;       {keep trying if error in transmission}
 end;

function cvt_bob_to_rtc(yr,mm,dd,hr,min,sec : integer): rtctime;
var ttime : rtctime;
    ldate: daterec;
    ltime: timerec;

begin
 with ldate, ltime do begin
   year:=yr {mod 100};   {LAF 880211 range is now 0..127}
   month:=mm;
   day:=dd;
   hour:=hr;
   minute:=min;
   centisecond:=sec*100;
 end;
 ttime.packedtime:=timedate_to_secs(ldate,ltime);
 ttime.packeddate:=ttime.packedtime div 86400;
 ttime.packedtime:=(ttime.packedtime mod 86400)*100;
 cvt_bob_to_rtc  := ttime;
end;

PROCEDURE CLOCKOPS(CMD:CLOCKOP; VAR THETIME:RTCTIME); {MODS SFB 4/11/85}
var yr,mm,dd,hr,min,sec : integer;
    TTIME : RTCTIME;
    LTIME : TIMEREC;
    LDATE : DATEREC;
    SECS: INTEGER;
  BEGIN
    CASE CMD OF
    CGET:
	  BEGIN         { READ THE TIME AND DATE }
	   THETIME.PACKEDTIME:=0; SETUPREAD(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('31')); SEND_WAIT(#21#20#19);
	   THETIME.PACKEDDATE:=0; SETUPREAD(2,THETIME.PACKEDDATE,2);
	   SEND_WAIT(#23#22);
	  END;
    CSET:
	  BEGIN         { SET THE TIME AND DATE }
	   SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);
	   SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);
	   IF BOBBATPRESENT THEN        { UPDATE IT ALSO--SFB 4/11/85 }
	    BEGIN
	     TTIME.PACKEDTIME:=THETIME.PACKEDDATE*86400
			       +(THETIME.PACKEDTIME+50) DIV 100;
	     TTIME.PACKEDTIME:=TTIME.PACKEDTIME+TIMEZONE;
	     SECS_TO_TIMEDATE(TTIME.PACKEDTIME, LDATE, LTIME);
	     WITH LTIME,LDATE DO       {ADDED 4/17/86 JWS -- TIMEZONE FIX}
	       {LAF 880211 year range is now 0..127}
	       SETBOBTIMEDATE(YEAR {MOD 100}, MONTH, DAY, HOUR, MINUTE,
			       CENTISECOND DIV 100);
	    END; {IF }
	  END;

    CUPDATE:            { SFB 4/11/85 } {UPDATE RTC FROM BOBBAT, AND COPY
					 TO THETIME AS SIDE EFFECT}
	  BEGIN         { COPY BOBCAT BATTERY BACKED CLOCK TO 8042 RTC }
	   IF BOBBATPRESENT THEN        { COPY IT TO RTC }
	    BEGIN
	     READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	     TTIME := CVT_BOB_TO_RTC(YR, MM, DD, HR, MIN, SEC);
	     THETIME := TTIME;
	     CLOCKOPS(CSET, TTIME);
	    END;
	  END;

    CTZ:                {JWS 4/17/86 -- SET TIME ZONE, ADJUST LOCAL TIME}
	 BEGIN
	   IF BOBBATPRESENT THEN BEGIN  {SET LOCAL TIME TO BATTERY + TZ }
	     WITH LDATE, LTIME, TTIME DO BEGIN
	       READBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	       YEAR:=YR {MOD 100};   {LAF 880211 range is now 0..127}
	       MONTH:=MM;
	       DAY:=DD;
	       HOUR:=HR;
	       MINUTE:=MIN;
	       CENTISECOND:=SEC*100;
	       PACKEDTIME:=TIMEDATE_TO_SECS(LDATE,LTIME);
	       PACKEDTIME:=TTIME.PACKEDTIME-TIMEZONE; {NOTE SUBTRACTION!}
	       PACKEDDATE:=PACKEDTIME DIV 86400;
	       PACKEDTIME:=(PACKEDTIME MOD 86400)*100;

	       {UPDATE THE 8042}
	       SENDCMD(HEX('AD')); SENDBYTESLSF(3,TTIME.PACKEDTIME,1);
	       SENDCMD(HEX('AF')); SENDBYTESLSF(2,TTIME.PACKEDDATE,2);
	     END; {WITH}
	   END; { IF BOBBATPRESENT }
	 END; {BEGIN}
    END;        {CASE}
  END;

  PROCEDURE TIMEROPS(TIMER:TIMERTYPES; OP:TIMEROPTYPE;
		     VAR TD:TIMERDATA);
  VAR TDATA:INTEGER;
      C    : BYTE;
  BEGIN
    CASE OP OF
    SETT:
      CASE TIMER OF
	DELAYT,CYCLICT:
	   BEGIN
	     IF TIMER=CYCLICT THEN C:=HEX('BA') ELSE C:=HEX('B7');
	     SENDCMD(C);
	     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
	     ELSE
	     BEGIN TDATA:=16777216-TD.COUNT; SENDBYTESLSF(3,TDATA,1); END;
	   END;
	PERIODICT:;     { DON'T DO ANY THING }
	DELAY7T:   BEGIN
		     SENDCMD(HEX('B2'));
		     IF TD.COUNT=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
		     ELSE
		     BEGIN TDATA:=65536-TD.COUNT; SENDBYTESLSF(2,TDATA,2); END;
		   END;
	MATCHT:    BEGIN
		     TDATA:=(TD.MATCH.HOUR*360000)+(TD.MATCH.MINUTE*6000)+
			     TD.MATCH.CENTISECOND;
		     SENDCMD(HEX('B4'));
		     IF TDATA=0 THEN SENDCMD(HEX('31')) { TO CANCEL }
				ELSE SENDBYTESLSF(3,TDATA,1);
		   END;
	OTHERWISE
      END; { CASE TIMER }
    READT:
      BEGIN
	TDATA:=0;
	CASE TIMER OF
	  DELAYT,CYCLICT:
		   BEGIN
		     SETUPREAD(3,TDATA,1);
		     IF TIMER=CYCLICT THEN C:=HEX('3E') ELSE C:=HEX('3B');
		     SENDCMD(C); SEND_WAIT(#21#20#19);
		     TD.COUNT:=16777216-TDATA;
		   END;
	  PERIODICT: TD.COUNT:=1;
	  DELAY7T: BEGIN
		     SETUPREAD(2,TDATA,2);
		     SENDCMD(HEX('36')); SEND_WAIT(#20#19);
		     TD.COUNT:= 65536-TDATA;
		   END;
	  MATCHT:  BEGIN
		     SETUPREAD(3,TDATA,1);
		     SENDCMD(HEX('38')); SEND_WAIT(#21#20#19);
		     TD.MATCH.HOUR:=TDATA DIV 360000;
		    {TD.MATCH.MINUTE BUGFIX SFB 5/1/85}
		     TD.MATCH.MINUTE:=(TDATA-(TD.MATCH.HOUR*360000)) DIV 6000;
		     TD.MATCH.CENTISECOND:= TDATA MOD 6000;
		   END;
	  OTHERWISE
	END; { CASE TIMER }
      END;
    GETTINFO:
      BEGIN
	TD.RESOLUTION:=10000;
	IF TIMER=DELAY7T THEN TD.RANGE:=65535
	ELSE
	IF TIMER=PERIODICT THEN TD.RANGE:=1
			   ELSE TD.RANGE:=16777215;
      END;
    END; { CASE OP }
  END;


  PROCEDURE KEYTRANS(VAR STATBYTE,KEY: BYTE; VAR DOKEY: BOOLEAN);
  VAR EXTSTATE: BOOLEAN;

    PROCEDURE SSET(VAR K:BOOLEAN);
    BEGIN K:=TRUE; DOKEY:=TRANSMODE=KPASS_EXTC;
	  EXTSTATE:= DOKEY;
    END;
    PROCEDURE SCLEAR(VAR K:BOOLEAN);
    BEGIN K:=FALSE; DOKEY:=FALSE;
	  IF TRANSMODE=KPASS_EXTC THEN EXTSTATE:= TRUE
	  ELSE EXTSTATE:= NOT (EXTLEFT OR EXTRIGHT);
    END;

  BEGIN {KEYTRANS}
    STATBYTE := (STATBYTE DIV 16)*16; DOKEY:=TRUE;
    IF KBDTYPE=ITFKBD THEN
    BEGIN
      IF TRANSMODE=KPASSTHRU THEN EXTSTATE:= UP
      ELSE
      BEGIN     { NOT PASSTHRU }
	IF KEY=18 THEN SSET(EXTLEFT)
	ELSE
	 IF KEY=19 THEN SSET(EXTRIGHT)
	 ELSE
	  IF KEY=146 THEN SCLEAR(EXTLEFT)
	  ELSE
	   IF KEY=147 THEN SCLEAR(EXTRIGHT)
	   ELSE
	   BEGIN
	     IF KBDSYSMODE THEN
	     CASE KEY OF
	     27: KEY:=26;  {F1=K0}
	     28: KEY:=42;  {F2=RECALL}
	     29: KEY:=51;  {F5=STEP}
	     30: KEY:=49;  {F6=ALPHA}
	     31: KEY:=50;  {F7=GRAPHICS}
	     32: KEY:=45;  {F3=CLR->END}
	     33: KEY:=58;  {F4=CONTINUE}
	     34,35: ; { UP AND DOWN ARROW KEYS }
	     36: KEY:=37;  {F8=K9}
	     OTHERWISE
	     END; { CASE KEY }
	     IF TRANSMODE=KSHIFT_EXTC THEN EXTSTATE:= NOT(EXTLEFT OR EXTRIGHT)
				      ELSE EXTSTATE:= UP;
	   END;
      END;  { NOT PASSTHRU MODE }
      STATBYTE:=STATBYTE+(ORD(EXTSTATE)*8)+7; { INCLUDE EXTCHAR STATUS }
    END     { ITFKBD }
    ELSE STATBYTE:=STATBYTE+15; { TURN ON ALL LOW ORDER BITS }
  END;  {KEYTRANS}

  FUNCTION INITA804X:BOOLEAN;
  VAR
    i : integer;
    TEMP : BYTE;
    THETIME:RTCTIME; {JWS 3/31/87}
  BEGIN
    INITA804X:=FALSE;
    TRY
      TEMP := ORD(STATUSREG);   { IS THE 8041/8042 PRESENT ? }
      MASK := 0;          { INITIALIZE MASK }
      MASKOPS(0,KBDMASK+RESETMASK+TIMERMASK+PSIMASK+FHIMASK);
      PERMISRLINK(A804XISR,ADDR(STATUSREG),1,1,1,ADDR(ISRREC));
      HAVEDATA := 0;  MAXDATA := 0;
      BFREQUENCY:=8;  BDURATION:=8;
      BEEPERHOOK := BEEPOP;
      RPGREQHOOK := DO_RPGOPS;
      KBDREQHOOK := DO_KBDOPS;
      KBDPOLLHOOK:= POLLISR;
      CLOCKIOHOOK:= CLOCKOPS;
      TIMERIOHOOK:= TIMEROPS;
      DATAHOOK   := DATAISR;
      DO_KBDOPS(SET_KBDTYPE,TEMP);
      DO_KBDOPS(SET_KBDLANG,TEMP);
      KBDSYSMODE  :=TRUE;
      IF KBDTYPE=ITFKBD THEN SETSTATUS(6,'S');
      TRANSMODE   := KPASSTHRU;
      KBDALTLOCK  := FALSE; KBDCAPSLOCK:=TRUE;
      EXTLEFT     := FALSE; EXTRIGHT := FALSE;
      KBDTRANSHOOK:= KEYTRANS;
      MASKOPSHOOK := MASKOPS;
      STATUS5HOOK := DUMMYSTATUS56;
      STATUS6HOOK := DUMMYSTATUS56;

      BOBBATPRESENT := BOBCATBATTERYBACKEDCLOCK;      {SFB 4/11/85}

      {FIX TO CLEAR 804X CLOCK IN CASE OTHER OS
       SET IT TO A STRANGE BASE }
      THETIME.PACKEDTIME:=0;  {JWS 3/31/87}
      THETIME.PACKEDDATE:=0;  {JWS 3/31/87}
      SENDCMD(HEX('AD')); SENDBYTESLSF(3,THETIME.PACKEDTIME,1);  {JWS 3/31/87}
      SENDCMD(HEX('AF')); SENDBYTESLSF(2,THETIME.PACKEDDATE,2);  {JWS 3/31/87}

      INITA804X   := TRUE;
    RECOVER
      IF ESCAPECODE<>-12 THEN ESCAPE(ESCAPECODE);
  END; {INITA804X}

END; {MODULE}

IMPORT A804XDVR,LOADER;
BEGIN
  IF INITA804X THEN MARKUSER;
END. {PROGRAM}
@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.4
log
@
Comment from auto synch of clock fix:
date: 88/03/15 14:19:09;  author: quist;  state: Exp;  lines added/del: 7/1
year range check fix
@
text
@@


26.3
log
@
Comment from auto synch of clock fix:
date: 88/03/02 17:13:00;  author: quist;  state: Exp;  lines added/del: 7/5
SYSDATE fixes. RDQ
@
text
@d330 6
d337 1
a337 1
     (yr > 99) or (dd = 0) or (mm = 0) then
@


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:40:14;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@d332 1
d338 2
a339 2
    mm  := 3;
    yr  := 0;
d382 1
a382 1
   year:=yr mod 100;
d421 2
a422 1
	       SETBOBTIMEDATE(YEAR MOD 100, MONTH, DAY, HOUR, MINUTE,
d444 1
a444 1
	       YEAR:=YR MOD 100;
@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.3
log
@Pws2unix automatic delta on Wed Apr  1 08:30:27 MST 1987
@
text
@@


13.2
log
@Fix to clear 804x RTC at boot time (other OS's may set to odd base)
@
text
@d27 1
@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@d588 1
d618 7
@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@actual check in:
date: 86/09/30 20:03:31; author: hal; state: Exp;
Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.2
log
@actual check in:
date: 86/09/13 10:25:37; author: hal; state: Exp;
Nimitz stuff from Scott Bayes and John Schmidt.
@
text
@@


3.1
log
@actual check in:
date: 86/09/01 12:13:49; author: hal; state: Exp;
Automatic bump of revision number for PWS version 3.2h
@
text
@d221 12
a232 4
	    IF ODD(KBDCONFIG DIV 32) THEN KBDTYPE:=ITFKBD
	    ELSE
	      IF ODD(KBDCONFIG) THEN KBDTYPE:=SMALLKBD
			   ELSE KBDTYPE:=LARGEKBD;
@


2.1
log
@actual check in:
date: 86/07/30 15:02:04; author: hal; state: Exp;
Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.2
log
@actual check in:
date: 86/06/30 16:14:13; author: danm; state: tmp;
Changes made by John Schmidt; timezone and new time converting routines.
@
text
@@


1.1
log
@Initial revision
@
text
@d3 1
a3 1
 (c) Copyright Hewlett-Packard Company, 1983.
a364 26

procedure cvt_rtc_to_bob(ltime : rtctime; var yr,mm,dd,hr,min,sec : integer);
var t: integer;
    k,k1,k2: integer;
begin
  k   := ltime.packeddate+1;
  k1  := k*4-1;
  yr  := k1 div 1461;
  dd  := (k1-(1461*yr)+4) div 4;
  k2  := (5*dd-3);
  mm  := k2 div 153;
  dd  := k2-153*mm;
  dd  := (dd+5) div 5;
  if  mm<10 then
   mm := mm+3
  else
    begin
     mm := mm-9;
     yr:=yr+1;
    end;
  yr  := yr mod 100;
  hr  := ltime.packedtime div 360000;
  min := (ltime.packedtime-(hr*360000)) div 6000;
  sec := (ltime.packedtime mod 6000 + 50) div 100; {round to seconds}
end;

d367 3
d371 11
a381 9
 if mm > 2 then
  mm := mm-3
 else
  begin
   mm := mm+9;
   yr := yr-1;
  end;
 ttime.packeddate:=((1461*yr) div 4 +(153*mm+2) div 5)+dd-1;
 ttime.packedtime:=((hr*3600) + min*60 + sec)*100;
d388 3
d406 8
a413 3
	     CVT_RTC_TO_BOB(THETIME, YR, MM, DD, HR, MIN, SEC);
	     SETBOBTIMEDATE(YR, MM, DD, HR, MIN, SEC);
	    END;
d415 1
d427 23
@
