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

INTERFACE;

CONST maxerror=5;

VAR i2c_error: ARRAY[0..maxerror] OF Str;
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;
{$ulink "vt/s_i2cbusIO.o" }

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

IMPLEMENTATION;

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

CONST CLKHI =  CIAF_COMRTS; CLKLO =  NOT CLKHI;  CLKIN =  CIAF_COMCTS;
      DATAHI = CIAF_COMDTR; DATALO = NOT DATAHI; DATAIN = CIAF_COMCD;
      myname = 'I²C-bus';
      semname = 'i2c-serial';
      dummyname = 'i2c-sdummy';

TYPE sem_mem = RECORD
       size: Word;
       sem: SignalSemaphore;
       name: String[15];
     END;

VAR owner1,owner2: Ptr;
    ciab: ^CIA;
    mysem,dummysem: p_SignalSemaphore;
    mymem: ^sem_mem;

PROCEDURE retreat;
{ Semaphore abbauen, ggf. Resourcen freigeben }
BEGIN
  dummysem := FindSemaphore(dummyname);
  IF dummysem<>Nil THEN BEGIN  { ich bin nicht allein }
    RemSemaphore(dummysem);  { Dummy aus der Liste streichen }
    mymem := Ptr(Long(dummysem)-2);
    FreeMem(mymem,mymem^.size); { und Speicher freigeben }
    { Ich brauche keine Resources freizugeben! }
  END ELSE BEGIN  { es läuft KEIN Partnerprogramm }
    mysem := FindSemaphore(semname);
    IF mysem<>Nil THEN BEGIN
      RemSemaphore(mysem);
      mymem := Ptr(Long(mysem)-2);
      FreeMem(mymem,mymem^.size);
    END;
    IF owner1 = Nil THEN FreeMiscResource(MR_SERIALBITS);
    IF owner2 = Nil THEN FreeMiscResource(MR_SERIALPORT);
  END;
END;

PROCEDURE user_meinung;
{ mit Alert nachfragen, ob ein fremder Ressourceninhaber ignoriert werden soll }
VAR rache: Boolean;
    zeile1,zeile2: String[80];
    buf: String[200];
    xpos, l1, l2: Integer;
BEGIN
  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 = IGNORE                 '
           +'              RIGHT BUTTON = OOPS ...';
  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 }
  OpenLib(IntuitionBase,'intuition.library',0);
  rache := DisplayAlert(RECOVERY_ALERT,buf,44);
  CloseLib(IntuitionBase);
  IF rache THEN BEGIN
    owner1 := Nil; owner2 := Nil;
  END ELSE
    Error('cannot allocate serial port!');
END;

PROCEDURE setup;
{ Semaphor einrichten, CIA-Register initialisieren, ggf. Ressourcen anfordern }
BEGIN
  owner1 := Ptr(4); owner2 := Ptr(4); { Hauptsache <>Nil !!! }
  mymem := AllocMem(SizeOf(sem_mem),MEMF_PUBLIC);
  IF mymem=Nil THEN Error('no memory for semaphore');
  mymem^.size := SizeOf(sem_mem);
  dummysem := ^mymem^.sem;
  dummysem^.ss_Link.ln_Name := ^mymem^.name;
  dummysem^.ss_Link.ln_Type := NT_SEMAPHORE;
  mysem := FindSemaphore(semname);  { bereits ein Semaphor installiert? }
  IF mysem=Nil THEN BEGIN   { nein, ich bin allein }
    mymem^.name := semname;
    mysem := dummysem;
    AddSemaphore(mysem);
    { darum muß ich mich auch um die Resources kümmern }
    owner1 := ptr(AllocMiscResource(MR_SERIALBITS, myname));
    owner2 := ptr(AllocMiscResource(MR_SERIALPORT, myname));
    IF (owner1<>Nil) OR (owner2<>Nil) THEN
      user_meinung;
  END ELSE BEGIN  { Partnerprogramm hat Semaphor schon installiert, }
    { ich muß aber noch einen Dummy-Semaphor aufstellen. }
    mymem^.name := dummyname;
    AddSemaphore(dummysem);
    owner1 := Nil; owner2 := Nil;
  END;
  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;


{ *** Ende der Init-/Cleanup-Routinen. Es folgen die Anwenderroutinen. }


FUNCTION s_i2cbusIO(busaddr: byte; buffer: Ptr; data: Integer;
                    busdelay: Integer): Integer; IMPORT;

{ Ich kann leider nicht direkt eine Assembler-Routine namens "i2cbusIO" }
{ importieren, da dann das Unit diesen Bezeichner sowohl importieren als }
{ auch exportieren müßte, hähä. }

{$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 = fehlerfreie Übertragung }
{   1 = unquittierte Daten }
{   2 = angesprochener Chip antwortet nicht }
{   3 = gesendete Daten wurden zerstört }
{   4 = gesendete Daten zu Null verfälscht }
{   5 = gesendete Daten zu Einsen verfälscht }
{ 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
  ObtainSemaphore(mysem);
  i2c_status := s_i2cbusIO(busaddr,buffer,data,busdelay);
  ReleaseSemaphore(mysem);
END;
{VAR buf: ^Array[1..MAXINT] of byte;
    i,bit,send,recv,l: integer;
    x,y: byte;
    myCIAport: Byte ABSOLUTE $BFD000;
LABEL panic;
BEGIN
  ObtainSemaphore(mysem);
  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];
    y := 0; { sollte bei korrekter und ungestörter Hardware am Ende =x sein }
    for bit := 7 downto 0 DO BEGIN
      y := y SHL 1;
      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;
      IF (myCIAport AND DATAIN)<>0 THEN Inc(y);
      myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
    END;
    IF y<>x THEN BEGIN
      IF y=$FF THEN i2c_status := 5
      ELSE IF y=0 THEN i2c_status := 4
      ELSE i2c_status := 3;
      GOTO panic;
    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;
  ReleaseSemaphore(mysem);
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;
  i2c_error[0] := 'OK';
  i2c_error[1] := 'unquittierte Daten';
  i2c_error[2] := 'Chip antwortet nicht';
  i2c_error[3] := 'gesendete Daten zerstört';
  i2c_error[4] := 'SDA auf LO festgehalten';
  i2c_error[5] := 'SDA immer HI';
  MiscBase := OpenResource(MISCNAME);
  { Resource braucht *nicht* wieder geschlossen zu werden! }
  AddExitServer(retreat); setup;
END.