(************************************************************************)
(***     Programmierung und Betrieb des CAN-Controllers SJA 1000      ***)
(***                                                                  ***)
(***                                                                  ***)
(***     Version:  2.2,  07.2.00,  11:30                              ***)
(***     Programmierer: v.Bg.                                         ***)
(***                                                                  ***)
(***                                                                  ***)
(***                                                                  ***)
(************************************************************************)

program can;

(************************************************************************)
(*** Definition der Variablen *******************************************)
(************************************************************************)

var
  cs_can: integer;				(* CS#-CAN-Controller *)

  (* Register-Adressen *)
  cr,cdr,cmr,sr,ir,acr,amr,btr0,btr1,ocr: integer;
  idt1,idt2: integer;
  tb1,tb2,tb3,tb4,tb5,tb6,tb7,tb8: integer;
  rb1,rb2,rb3,rb4,rb5,rb6,rb7,rb8,rb9,rb10: integer;

  (* Empf„nger-Zwischen-Buffer *)
  rxb:array[1..10] of byte;

  (* Sender-Zwischen-Buffer *)
  txb:array[1..8] of byte;

  (* Z„hler *)
  tele_z,fe_z:integer;
  fe_nr:byte;

  (* F�r Parametrierungen *)
  dfl,id:byte;
  send_p:array[1..8] of byte;
  dfl_rtr:byte;
  send_rtr:array[1..8] of byte;

  (* Diverse *)
  i,k,zv: byte;
  c:char;

(************************************************************************)
(*** Unterprogramm-Sammlung *********************************************)
(************************************************************************)

(*** Initialisierung des CAN-Controllers: BasicCAN **********************)

procedure can_init_basic;

var
  zw:byte;

begin;

  (* Festlegung der Steuerregister-Adressen *)
  cr:=cs_can;		cmr:=cs_can+1;		sr:=cs_can+2;	
  ir:=cs_can+3;		acr:=cs_can+4; 		amr:=cs_can+5;		
  btr0:=cs_can+6;	btr1:=cs_can+7;		ocr:=cs_can+8;

  idt1:=cs_can+10;	idt2:=cs_can+11;

  tb1:=cs_can+12;	tb2:=cs_can+13;		tb3:=cs_can+14;
  tb4:=cs_can+15;	tb5:=cs_can+16;		tb6:=cs_can+17;
  tb7:=cs_can+18;	tb8:=cs_can+19;

  rb1:=cs_can+20;	rb2:=cs_can+21;		rb3:=cs_can+22;
  rb4:=cs_can+23;	rb5:=cs_can+24;		rb6:=cs_can+25;
  rb7:=cs_can+26;	rb8:=cs_can+27;		rb9:=cs_can+28;
  rb10:=cs_can+29;

  cdr:=cs_can+31;
  
  (* CR: Controller in Rest-Modus schalten *)
  writexby($01,cr);
  
  (* CR: šberpr�fen, ob Controller im Reset-Modus ist *)
  repeat
    zw:=xby(cr);
    zw:=zw and $01;
  until(zw=1);  
  
  (* CDR: Clock Divider Register setzen: 2 MHz meábar *)
  writexby($43,cdr);

  (* ACR: Acceptance-Code setzen *)
  writexby($00,acr);
  	  
  (* AMR: Acceptance Mask setzen *)
  writexby($ff,amr);			(*alle kommen durch*)

  (* BTR0, BTR1: Bus Timing Register setzen *)
  writexby($47,btr0);		(*50 Kbit/s*)
  writexby($2f,btr1);		(*50 Kbit/s*)
  
  (* OCR: Output Control Register setzen *)
  writexby($1a,ocr);
  
  (* CMR: Sleep Mode deaktivieren *)
  writexby($0e,cmr);
  
  (* CR: Reset zur�cksetzen *)
  writexby($00,cr);
  
  (* CR: šberpr�fen, ob Controller Reset-Mode verlassen hat *)
  repeat
    zw:=xby(cr);
    zw:=zw and $01;
  until (zw=0);

end;

(************************************************************************)

(*** Aussenden eines CAN-Telegramms *************************************)

procedure can_send(id:integer;dfl,rtr:byte);

var
  id1,id2,zw:byte;

begin

  (*** Nachrichten-Identifier aufbereiten ***)
  id1:=id div 8;
  id2:=id-(zw*8);
  id2:=id2*32;
 
  (* RTR-Bit setzen *) 
  if rtr<>0 then id2:=id2 or $10;

  (*****************************)
  (*** Datentransfer starten ***)
  (*****************************)

  (* šberpr�fung, ob Tx-Buffer neu beschrieben werden kann, Status-Reg. *)
  repeat
    zw:=xby(sr);
    zw:=zw and $04;
  until (zw=4);

  (* Transmit-Identifier setzen *)
  writexby(id1,idt1);			(* Identifier 1*)
  writexby(id2+dfl,idt2);		(* Identifier 2*)

  (* Tx-Buffer belegen *)
  writexby(txb[1],tb1);
  writexby(txb[2],tb2);
  writexby(txb[3],tb3);
  writexby(txb[4],tb4);
  writexby(txb[5],tb5);
  writexby(txb[6],tb6);    
  writexby(txb[7],tb7);    
  writexby(txb[8],tb8);    
    
  (* Start der Aussendung *)    
  writexby($0d,cmr);

end;

(************************************************************************)

(*** Eingabe der Sendeparameter *****************************************)

procedure send_param_eingabe;

begin

  (*** Nachrichten-Identifier angeben ***)
  write('  Nachrichten-Identifier eingeben (0..2047):    ');
  read(id);

  (*** L„nge des Datenfeldes festlegen ***)
  write('  L„nge des Datenfeldes (0..8):                 ');
  read(dfl);

  (*** Zeitverz”gerung eingeben ***)
  write('  Zeitverz”gerung zw. den Telegrammen (n*25ms): ');
  read(zv);
  
  writeln;  
  writeln('Start der Aussendungen mit Tastendruck .... ');
  write('(Anhalten mit System-Reset !)   ');
  read(c);
  writeln; writeln;

end;

(************************************************************************)

(*** Aussenden fester Datenwerte ****************************************)

procedure feste_daten_send;

var
  i,nr:byte;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Aussendung von festen Datenwerten');
  writeln('=================================');
  writeln;

  (*** Eingabe der Sendeparameter ***)
  send_param_eingabe;

  (*** Datentransfer starten ***)
  nr:=0;
  repeat

    (* Tx-Buffer belegen *)
    for i:=0 to 7 do txb[i+1]:=nr+i;

    (* Telegramm aussenden *)
    can_send(id,dfl,0);
    
    (* Zeitverz”gerung zw. den Telegrammen *)
    if zv<>0 then wait_25ms(zv);
    write('* ');

    nr:=nr+1;

  until false;  

end;

(************************************************************************)

(*** Aussendung der zuvor parametrierten Datenwerte **********************)

procedure param_daten_send;

var
  i:byte;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Aussendung der zuvor parametrierten Datenwerte');
  writeln('==============================================');
  writeln;

  (*** Eingabe der Sendeparameter ***)
  send_param_eingabe;

  (*** Parametrierte Werte in Tx-Vektor umspeichern ***)
  for i:=1 to 8 do txb[i]:=send_p[i];

  (* Endlos-Sende-Schleife *)
  repeat

    (* Telegramm senden *)
    can_send(id,dfl,0);

    (* Zeitverz”gerung zw. den Telegrammen *)
    if zv<>0 then wait_25ms(zv);
    write('* ');

  until false;  

end;

(************************************************************************)

(*** Aussenden eines RTR-Telegramms *************************************)

procedure rtr_send;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Aussendung eines RTR-Telegramms');
  writeln('===============================');
  writeln;

  (*** Eingabe der Sendeparameter ***)
  send_param_eingabe;

  repeat

    (*** Telegramm aussenden ***)
    can_send(id,dfl,1);

    (* Zeitverz”gerung zw. den Telegrammen *)
    if zv<>0 then wait_25ms(zv);
    write('* ');

  until false;  

end;

(************************************************************************)

(*** Aussenden von Telegrammen ******************************************)

procedure tele_send;

var
  nr,dfl,zw,zw1:byte;
  id: integer;

begin

repeat

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Aussenden von Telegrammen');
  writeln('=========================');
  writeln;

  (*** Auswahlmen� ***)
  writeln('  Bitte w„hlen Sie:');
  writeln;
  writeln('    1) Aussendung von festen Datenwerten');
  writeln('    2) Aussendung der zuvor parametrierten Datenwerte');
  writeln('    3) Aussendung eines RTR-Telegramms');
  writeln; writeln; writeln;
  writeln('    9) Zur�ck');
  writeln;
  write('  Ihre Wahl:  ');
  read(c);

  (*** Auswertung ***)
  case c of
    '1': feste_daten_send;
    '2': param_daten_send;
    '3': rtr_send;
    '9': exit;
  end;

until false;

end;

(************************************************************************)

(*** Aussenden der Antwort auf ein RTR-Telegramm ************************)

procedure rtr_antwort_send;

var
  zw:byte;

begin

  (*** Transmit-Identifier aufbereiten: �bernehmen aus empf. RTR-Telegr. ***)
  writexby(rxb[1],idt1);	(* Identifier 1*)
  (* Hier: RTR-Bit l”schen *)
  zw:=rxb[2] and $ef;
  writexby(zw,idt2);		(* Identifier 2*)

  (*** Datentransfer starten ***)
  (* šberpr�fung, ob Tx-Buffer neu beschrieben werden kann, Status-Reg. *)
  repeat
    zw:=xby(sr);
    zw:=zw and $04;
  until (zw=4);

  (* Tx-Buffer belegen *)
  writexby(send_rtr[1],tb1);
  writexby(send_rtr[2],tb2);
  writexby(send_rtr[3],tb3);
  writexby(send_rtr[4],tb4);
  writexby(send_rtr[5],tb5);
  writexby(send_rtr[6],tb6);
  writexby(send_rtr[7],tb7);
  writexby(send_rtr[8],tb8);
    
  (* Start der Aussendung *)    
  writexby($0d,cmr);

  writeln('  RTR-Antwort-Telegramm gesendet !');
  
end;

(************************************************************************)

(*** Auswertung der empfangenen Daten ***********************************)

procedure empf_dat_aw;

var
  rtr,dfl,i:byte;
  id:integer;
  

begin

  (* Berechnung des Identifiers *)
  id:=rxb[1]*8;
  id:=id+(rxb[2] div 32);
  
  (* Berechnung der Datenfeldl„nge *)
  dfl:=rxb[2] and $0f;

  (* šberpr�fung, ob ein RTR-Telegramm empfangen wurde *)
  rtr:=rxb[2] and $10;

  (* Ausgabe des Telegramms *)
  if rtr<>0 then
    begin			(* RTR-Telegramm empfangen *)
      writeln(tele_z,'  RTR empf. - ID: ',id,'  ',dfl,'    F: ',fe_z);
      (* Antwort senden *)
      rtr_antwort_send;
    end
   else
    begin			(* Normales Telegramm empfangen *) 
      write(tele_z,'  ',id,'  ',dfl,'   ');
      for i:=1 to dfl do
        begin
          write('  ',rxb[i+2]);
        end;
      write('     F: ',fe_z);
      writeln;
    end;

end;

(************************************************************************)

(*** Empfang von Telegrammen im Polling-Betrieb *************************)

procedure tele_empf;

var
  zw:byte;

begin
  (*** Bildschirm l”schen ***)
  write(chr($1a));

  writeln('Warten auf Telegramm ...... (Endlosschleife)');
  tele_z:=0;	fe_z:=0;

  (*** Empfangsschleife ***)
  repeat

    (* Fehlerauswertung: NUR Overrun-Error *)
    fe_nr:=0;
    fe_nr:=xby(sr);
    fe_nr:=fe_nr and $02;		(* NUR Overrun-Error *)
    if fe_nr<>0 then
      begin
        fe_z:=fe_z+1;
        writeln('F-Nr.: ',fe_nr,' / ',fe_z);
      end;
  
    (* NUR Overrun Error zur�cksetzen *)
    if fe_nr<>0 then writexby($08,cmr);

    (* Abfrage des Receive Buffer Status, Status Reg. *)
    zw:=xby(sr);
    zw:=zw and $01;
  
    (* Einlesen und Auswerten der empf. Daten *);
    if ((zw=1) and (fe_nr=0)) then
    begin

      (* Datenfeld in Zwischen-Vektor *)
      rxb[1]:=xby(rb1);	rxb[2]:=xby(rb2);	rxb[3]:=xby(rb3);
      rxb[4]:=xby(rb4);	rxb[5]:=xby(rb5);	rxb[6]:=xby(rb6);
      rxb[7]:=xby(rb7);	rxb[8]:=xby(rb8);	rxb[9]:=xby(rb9);
      rxb[10]:=xby(rb10);

      (* Rx-Buffer-Buffer freigeben, CMR Reg. *)
      writexby($0c,cmr);

      (* Telegrammz„hler erh”hen *)
      tele_z:=tele_z+1;
    
      (* Auswertung der empfangenen Daten *)
      empf_dat_aw;

    end;

  until false;

end;

(************************************************************************)

(*** Parametrierung der Dš-Rate *****************************************)

procedure due_param;

var
  b0,b1,zw:byte;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Parametrierung der Dš-Rate');
  writeln('==========================');
  writeln;

  (*** Auswahlmen� ***)
  writeln('  Bitte w„hlen Sie:');
  writeln;
  writeln('    1)   5 kBit/s     2)  10 kBit/s     3)  20 kBit/s');
  writeln;
  writeln('    4)  50 kBit/s     5) 100 kBit/s     6) 125 kBit/s');
  writeln;
  writeln('    7) 250 kBit/s     8) 500 kBit/s     9)   1 MBit/s');
  writeln;
  write('  Ihre Wahl:  ');
  read(c);

  (*** Auswertung ***)
  case c of
    '1': begin b0:=$7f;  b1:=$7f; end;
    '2': begin b0:=$67;  b1:=$2f; end;
    '3': begin b0:=$53;  b1:=$2f; end;
    '4': begin b0:=$47;  b1:=$2f; end;
    '5': begin b0:=$43;  b1:=$2f; end;
    '6': begin b0:=$03;  b1:=$1c; end;
    '7': begin b0:=$01;  b1:=$1c; end;
    '8': begin b0:=$00;  b1:=$1c; end;
    '9': begin b0:=$00;  b1:=$14; end;
  end;

  (* CR: Controller in Rest-Modus schalten *)
  writexby($01,cr);
  
  (* CR: šberpr�fen, ob Controller im Reset-Modus ist *)
  repeat
    zw:=xby(cr);
    zw:=zw and $01;
  until(zw=1);  

  (* BTR0, BTR1: Bus Timing Register setzen *)
  writexby(b0,btr0);
  writexby(b1,btr1);

  (* CR: Reset zur�cksetzen *)
  writexby($00,cr);
  
  (* CR: šberpr�fen, ob Controller Reset-Mode verlassen hat *)
  repeat
    zw:=xby(cr);
    zw:=zw and $01;
  until (zw=0);

end;

(************************************************************************)

(*** Paramtrierung des Sende-Telegramms *********************************)

procedure send_tele_param;

var
  i,dfl_p:byte;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Sende-Telegramm parametrieren');
  writeln('=============================');
  writeln;

  (*** L„nge des Datenfeldes festlegen ***)
  write('  L„nge des Datenfeldes (0..8):  ');
  read(dfl_p);

  (*** Eingabe der Datenwerte ***)
  if dfl_p>8 then dfl_p:=0;
  if dfl_p=0 then exit;
  writeln;
  writeln('  Bitte geben Sie die Werte des Datenfeldes ein (0 .. 255):');
  writeln;
  for i:=1 to dfl_p do
    begin
      write('    Feld ',i,' :   '); readln(send_p[i]);
    end;
  writeln;
  write('Eingabe beendet, bitte Taste dr�cken !'); read(c);

end;

(************************************************************************)

(*** Paramtrierung Acceptance Code / Mask *******************************)

procedure accept_param;

var
  zw,acc,acm:byte;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Acceptance Code / Mask parametrieren');
  writeln('====================================');
  writeln('Hiermit wird festgelegt, welche Telegramme bzw. Identifier durch das');
  writeln('Acceptance-Empfangsfilter gelangen. Es gilt hierbei:');
  writeln('Die jeweils 8 h”herwertigen Bits des Identifieres m�ssen mit den 8 Bits des');
  writeln('Acceptance-Codes �bereinstimmen, damit das Telegramm "durchgelassen" wird.');
  writeln('šber die Acceptance-Mask wird festgelegt, welche Bitstellen des');
  writeln('Acceptance-Codes relevant sind f�r den bitweisen Vergleich:');
  writeln('    Accept. Mask an Bitstelle i = 0 :  Bitstelle i ist relevant f�r');
  writeln('                                       den Vergleich');
  writeln('    Accept. Mask an Bitstelle i = 1 :  Bitstelle i ist nicht relevant f�r');
  writeln('                                       den Vergleich');
  writeln('Beispiel:');
  writeln('   Accept. Code:            11001011');
  writeln('   Accept. Mask:            01001010');
  writeln('                           ---------');
  writeln('   Zul„ssige Identifier:    1x00x0x1  xxx');
  writeln;
  writeln('D.h. alle Telegramme mit Identifiern der Form 1x00x0x1xxx gelangen');
  writeln('durch das Acceptance-Filter, werden also als empfangenes Telegramm in');
  writeln('den Empfangs-FIFO eingetragen. Telegramme, deren Identifier diese Form nicht');
  writeln('haben, werden verworfen.');
  writeln;

  (*** Acceptance-Code ***)
  write('Eingabe des Acceptance-Codes (0..255): ');
  read(acc);
  writeln;

  (*** Acceptance-Mask ***)
  write('Eingabe der Acceptance-Mask (0..255; alles Empfangen: Mask=255): ');
  read(acm);
  
  (*** Programmieren des CAN-Controllers ***)

  (* CR: Controller in Rest-Modus schalten *)
  writexby($01,cr);
  
  (* CR: šberpr�fen, ob Controller im Reset-Modus ist *)
  repeat
    zw:=xby(cr);
    zw:=zw and $01;
  until(zw=1);  
  
  (* ACR: Acceptance-Code setzen *)
  writexby(acc,acr);
  	  
  (* AMR: Acceptance Mask setzen *)
  writexby(acm,amr);

  (* CR: Reset zur�cksetzen *)
  writexby($00,cr);
  
  (* CR: šberpr�fen, ob Controller Reset-Mode verlassen hat *)
  repeat
    zw:=xby(cr);
    zw:=zw and $01;
  until (zw=0);

end;

(************************************************************************)

(*** RTR-Antwort-Telegramm parametrieren ********************************)

procedure rtr_antwort;

var
  i:byte;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('RTR-Antwort-Telegramm parametrieren');
  writeln('===================================');
  writeln;

  (*** L„nge des Datenfeldes festlegen ***)
  write('  L„nge des Datenfeldes (0..8):  ');
  read(dfl_rtr);

  (*** Eingabe der Datenwerte ***)
  if dfl_rtr>8 then dfl_rtr:=0;
  if dfl_rtr=0 then exit;
  writeln;
  writeln('  Bitte geben Sie die Werte des Datenfeldes ein (0 .. 255):');
  writeln;
  for i:=1 to dfl_rtr do
    begin
      write('    Feld ',i,' :   '); readln(send_rtr[i]);
    end;
  writeln;
  write('Eingabe beendet, bitte Taste dr�cken !'); read(c);

end;

(************************************************************************)

(*** Parametrierung im BasicCAN-Mode ************************************)

procedure param;

var
  b0,b1:byte;

begin

repeat

  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Meldungstext ***)
  writeln('Parametrierung im BasicCAN-Mode');
  writeln('===============================');
  writeln;

  (*** Auswahlmen� ***)
  writeln('  Bitte w„hlen Sie:');
  writeln;
  writeln('    1) Daten�bertragungsrate parametrieren');
  writeln('    2) Sende-Telegramm parametrieren');
  writeln('    3) Acceptance Code / Mask parametrieren');
  writeln('    4) RTR-Antwort-Telegramm parametrieren');
  writeln; writeln; writeln;
  writeln('    9) Zur�ck');
  writeln;
  write('  Ihre Wahl:  ');
  read(c);

  (*** Auswertung ***)
  case c of
    '1': due_param;
    '2': send_tele_param;
    '3': accept_param;
    '4': rtr_antwort;
    '9': exit;
  end;

until false;

end;

(************************************************************************)

(*** Betrieb im BasicCAN-Modus ******************************************)

procedure basic_can;

begin

  (*** Grundinitialisierung des CAN-Controllers: BasicCAN, 5 kBit/s ***)
  cs_can:=$fe00;			(* CS#-Adresse des CAN-Controllers*)
  can_init_basic;

  repeat

    (*** Bildschirm l”schen ***)
    write(chr($1a));

    (*** Meldungstext ***)
    writeln('Betrieb des SJA 1000 im  BasicCAN-Modus');
    writeln('=======================================');
    writeln;

    (*** Auswahlmen� ***)
    writeln('  Bitte w„hlen Sie:');
    writeln;
    writeln('    1)  Aussenden von Telegrammen');
    writeln('    2)  Empfang   von Telegrammen');
    writeln('    3)  Parametrierung');
    writeln; writeln; writeln;
    writeln('    9)  Zur�ck');
    writeln;
    write('  Ihre Wahl:  ');
    read(c);

    (*** Auswertung ***)
    case c of
      '1': tele_send;
      '2': tele_empf;
      '3': param;
      '9': exit;
    end;

  until false;

end;

(************************************************************************)

(*** Betrieb im PeilCAN-Modus *******************************************)

procedure peli_can;

var
  c:char;

begin

  (*** Bildschirm l”schen ***)
  write(chr($1a)); write(chr($07));

  writeln; writeln; writeln;
  writeln('   Leider ist zur Zeit nur der BasicCAN-Modus programmiert !');
  writeln;
  writeln;
  write('   Bitte Taste dr�cken .....  ');
  read(c);

end;

(************************************************************************)


(************************************************************************)
(************************************************************************)
(************************************************************************)

(************************************************************************)
(*** Hauptprogramm ******************************************************)
(************************************************************************)
begin

repeat
  (*** Bildschirm l”schen ***)
  write(chr($1a));

  (*** Parameter-Grundwerte ***)

  (*** Meldungstext ***)
  writeln('Betrieb des CAN-Controllers SJA 1000, V2.2:');
  writeln('===========================================');

  writeln;
  writeln('  Bitte w„hlen Sie:');
  writeln;
  writeln('    1) Betrieb im  BasicCAN-Mode');
  writeln('    2) Betrieb im  PeliCAN-Mode'); writeln;
  write('  Auswahl:  ');  read(c);

  (*** Auswertung der Auswahl ***)
  case c of
    '1': basic_can;
    '2': peli_can; 
  end;

until false;

end.