UNIT i2c_serial; {$project vt}
{ Steuert I²C-Bus Interface am seriellen Port des Amiga }

INTERFACE;

VAR i2c_status, busdelay: Integer;
PROCEDURE i2cbusIO(busaddr: byte; buffer: Ptr; data: Integer);
PROCEDURE setregister(addr,reg,value: Byte);
FUNCTION getregister(addr,reg: Byte): Byte;

{ ---------------------------------------------------------------------- }

IMPLEMENTATION;

{$opt q,s+,i+ - keine Laufzeitprüfungen außer Stack und Feldindizes }
{$incl "exec.lib", "intuition.lib", "hardware/cia.h", "resources/misc.h" }

CONST CLKHI =  CIAF_COMRTS; CLKLO =  NOT CLKHI;  CLKIN =  CIAF_COMCTS;
      DATAHI = CIAF_COMDTR; DATALO = NOT DATAHI; DATAIN = CIAF_COMCD;

VAR owner1,owner2: Ptr;
    ciab: ^CIA;

PROCEDURE getbus;
{ Zugriff auf Hardware sichern und CIA-Register initialisieren }
VAR rache: Boolean;
    zeile1,zeile2: String[80];
    buf: String[200];
    xpos, l1, l2: Integer;
CONST ich = 'I²C-bus';
BEGIN
  MiscBase := OpenResource(MISCNAME);
  { Resource braucht *nicht* wieder geschlossen zu werden! }
  owner1 := ptr(AllocMiscResource(MR_SERIALBITS, ich));
  owner2 := ptr(AllocMiscResource(MR_SERIALPORT, ich));
  IF (owner1 <> Nil) OR (owner2 <> Nil) THEN BEGIN
    { mit Alert nachfragen, etwas aufwendig }
    zeile1 := 'Serial ressources are owned by "';
    IF owner1<>Nil THEN zeile1 := zeile1 + copy(str(owner1),1,16);
    zeile1 := zeile1 + '"/"';
    IF owner2<>Nil THEN zeile1 := zeile1 + copy(str(owner2),1,16);
    zeile1 := zeile1 + '"!';
    l1 := length(zeile1);
    zeile2 := 'LEFT BUTTON = NO, THEY''RE MINE!      '
             +'                RIGHT BUTTON = THANKS';
    l2 := length(zeile2);
    buf := '   '+zeile1+'     '+zeile2;
    xpos := 320 - 4*l1;
    buf[1] := chr(Hi(xpos)); buf[2] := chr(Lo(xpos));
    buf[3] := chr(16);
    buf[l1+4] := chr(0); buf [l1+5] := chr(1); { Fortsetzungsbyte }
    xpos := 320 - 4*l2;
    buf[l1+6] := chr(Hi(xpos)); buf[l1+7] := chr(Lo(xpos));
    buf[l1+8] := chr(32);
    buf [l1+l2+10] := chr(0); { Ende }
    rache := DisplayAlert(RECOVERY_ALERT,buf,44);
    IF rache THEN BEGIN
      owner1 := Nil;
      owner2 := Nil;
    END;
  END;
  IF (owner1 <> Nil) OR (owner2<>Nil) THEN
    Error('Cannot allocate serial port!');
  ciab := ptr(Adr_ciab);
  { CTS- und DCD-Bit auf Eingang, RTS und DTR auf Ausgang }
  ciab^.ciaddra := (ciab^.ciaddra AND NOT (CIAF_COMCD OR CIAF_COMCTS))
    OR CIAF_COMRTS OR CIAF_COMDTR;
END;

PROCEDURE releasebus;
{ Ressourcen zurückgeben, sofern sie nicht jemand anders gehörten. }
{ (Man kann nämlich auch fremde Ressourcen freigeben - sehr 'sinnvoll'!) }
BEGIN
  IF owner1 = Nil THEN FreeMiscResource(MR_SERIALBITS);
  IF owner2 = Nil THEN FreeMiscResource(MR_SERIALPORT);
END;

FUNCTION s_i2cbusIO(busaddr: byte; buffer: Ptr; data: Integer;
                    busdelay: Integer): Integer; IMPORT;
{$ulink "vt/s_i2cbusIO.o" }
{ Ich kann leider nicht direkt die Routine "i2cbusIO" importieren, da dann }
{ das Unit diesen Bezeichner sowohl importieren als auch exportieren müßte. }
{ Und das macht nicht viel Sinn, oder? }

{$opt q,s+}
PROCEDURE i2cbusIO{(busaddr: byte; buffer: Ptr; data: Integer)};
{ Startet den I²C-Bus und spricht den Chip mit Nr. <busaddr> an. Ist <data> }
{ positiv, werden <data> Bytes ab Adresse <buffer> über den Bus abgeschickt, }
{ sonst werden <-data> Bytes vom Bus geholt und ab Adresse <buffer> im }
{ Speicher abgelegt. Anschließend wird der I²C-Bus wieder gestoppt. }
{ Setzt als zusätzliche Rückmeldung die globale Variable "i2c_status": 0 bei }
{ fehlerfreier Übertragung, 1 bei unquittierten Daten und 2, wenn überhaupt }
{ keine Reaktion vom Bus kommt. }
{ Anmerkungen: }
{ 1. Das unterste Bit in <busaddr> wird ignoriert und entsprechend der }
{   I²C-Bus-Konvention auf 0 für Schreiben bzw. 1 für Lesen gesetzt. }
{ 2. Mehr Bytes zum Lesen anzufordern, als der bereitgestellte Puffer fassen }
{   kann, ist ein Fehler, der nicht erkannt wird und wahrscheinlich mit einem }
{   GURU endet. }
{ Die Variable <busdelay> steuert eine Zählschleife (sic!) und sollte auf }
{ normalen Amigas 0 sein. Für beschleunigte Amigas sollte hier ein geeigneter }
{ Wert den Bus auf die erlaubten 100 kHz bremsen können. }
BEGIN
  i2c_status := s_i2cbusIO(busaddr,buffer,data,busdelay);
END;
{VAR buf: ^Array[1..MAXINT] of byte;
    i,bit,send,recv,l: integer;
    x: byte;
    myCIAport: Byte ABSOLUTE $BFD000;
LABEL panic;
BEGIN
  i2c_status := 0;
  buf := buffer;
  send := 0; recv := 0;
  IF data>0 THEN  send := data  else  recv := -data;
  busaddr := busaddr AND $FE;  IF recv>0 THEN busaddr := busaddr OR 1;
  { Bus starten: Protokollverletzung mit H->L }
  myCIAport := myCIAport OR CLKHI OR DATAHI; for l := 1 to busdelay DO;
  myCIAport := myCIAport AND DATALO;  for l := 1 to busdelay DO;
  myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  { Daten senden, mindestens ein Byte für die Adressierung: }
  for i := 0 to send DO BEGIN
    IF i=0 THEN  x := busaddr  else  x := buf^[i];
    for bit := 7 downto 0 DO BEGIN
      IF ((x shr bit) AND $01) = 0 THEN
        myCIAport := myCIAport AND DATALO
      else
        myCIAport := myCIAport OR DATAHI;
      myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
      myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
    END;
    { Quittierungsbit lesen }
    myCIAport := myCIAport OR DATAHI;
    myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
    IF (myCIAport AND DATAIN)<>0 THEN BEGIN
      { Quittierungsbit = H: bitte keine weiteren Daten, Abbruch. }
      { Falls das schon beim Senden der Adresse auftritt (i=0), hat überhaupt }
      { kein Busteilnehmer zugehört: falsche Adresse oder Hardwareproblem. }
      IF i=0 THEN  i2c_status := 2  else  i2c_status := 1;
      GOTO panic;
    END;
    myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  END;
  { Daten empfangen, sofern verlangt: }
  for i := 1 to recv DO BEGIN
    myCIAport := myCIAport OR DATAHI; { sonst liest man nur das eigene LO! }
    x := 0;
    for bit := 7 downto 0 DO BEGIN
      x := x shl 1;
      myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
      IF (myCIAport AND DATAIN)<>0 THEN
        Inc(x);
      myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
    END;
    { Quittierungsbit senden }
    IF i=recv THEN    { letztes Byte mit HI quittieren, sonst LO }
      myCIAport := myCIAport OR DATAHI
    else
      myCIAport := myCIAport AND DATALO;
    myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
    myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
    buf^[i] := x;
  END;
panic:
  { Bus stoppen: Protokollverletzung mit L->H }
  myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  myCIAport := myCIAport AND DATALO;  for l := 1 to busdelay DO;
  myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  myCIAport := myCIAport OR DATAHI;
END; }
{$opt i+}

PROCEDURE setregister{(addr,reg,value: Byte)};
{ Häufig benötigter Vorgang: ein einzelnes Register am I²C-Bus beschreiben. }
VAR bytes: array[1..2] of Byte;
BEGIN
  bytes[1] := reg; bytes[2] := value;
  i2cbusIO(addr,^bytes,2);
END;

FUNCTION getregister{(addr,reg: byte): Byte};
{ Etwas umständlicher, wird dafür auch seltener benötigt: ein einzelnes }
{ Register auslesen. NICHT schleifenweise aufrufen, um mehrere Bytes zu }
{ lesen! Das läßt sich direkt über i2cbusIO() eleganter regeln! }
VAR result: Byte;
BEGIN
  i2cbusIO(addr,^reg,1);
  i2cbusIO(addr,^result,-1);
  getregister := result;
END;

BEGIN  { Initialisierungsteil }
  busdelay := 0;
  OpenLib(IntuitionBase,'intuition.library',0)
  AddExitServer(releasebus); getbus;
END.