( Pilote des bus CAN A et B.
  Version 0.10 du 17 Juin 2012.
  Ecrit par jpb.forth .
)

DECIMAL

( Identification de la carte:
  ---------------------------
)

129 CONSTANT CW_NUMERO

( Registres du bus CAN A:
  -----------------------
)

448 CONSTANT CW_CAN_A_CTRL
449 CONSTANT CW_CAN_A_BRPR
450 CONSTANT CW_CAN_A_BTR
451 CONSTANT CW_CAN_A_TEC
452 CONSTANT CW_CAN_A_REC
456 CONSTANT CW_CAN_A_AFMR1_H
457 CONSTANT CW_CAN_A_AFMR1_L
458 CONSTANT CW_CAN_A_AFIR1_H
459 CONSTANT CW_CAN_A_AFIR1_L
460 CONSTANT CW_CAN_A_AFMR2_H
461 CONSTANT CW_CAN_A_AFMR2_L
462 CONSTANT CW_CAN_A_AFIR2_H
463 CONSTANT CW_CAN_A_AFIR2_L
464 CONSTANT CW_CAN_A_AFMR3_H
465 CONSTANT CW_CAN_A_AFMR3_L
466 CONSTANT CW_CAN_A_AFIR3_H
467 CONSTANT CW_CAN_A_AFIR3_L
468 CONSTANT CW_CAN_A_AFMR4_H
469 CONSTANT CW_CAN_A_AFMR4_L
470 CONSTANT CW_CAN_A_AFIR4_H
471 CONSTANT CW_CAN_A_AFIR4_L
472 CONSTANT CW_CAN_A_ID_H
473 CONSTANT CW_CAN_A_ID_L
474 CONSTANT CW_CAN_A_RF
475 CONSTANT CW_CAN_A_DLC
476 CONSTANT CW_CAN_A_DATA_01
477 CONSTANT CW_CAN_A_DATA_23
478 CONSTANT CW_CAN_A_DATA_45
479 CONSTANT CW_CAN_A_DATA_67

( Registres du bus CAN B:
  -----------------------
)

480 CONSTANT CW_CAN_B_CTRL
481 CONSTANT CW_CAN_B_BRPR
482 CONSTANT CW_CAN_B_BTR
483 CONSTANT CW_CAN_B_TEC
484 CONSTANT CW_CAN_B_REC
488 CONSTANT CW_CAN_B_AFMR1_H
489 CONSTANT CW_CAN_B_AFMR1_L
490 CONSTANT CW_CAN_B_AFIR1_H
491 CONSTANT CW_CAN_B_AFIR1_L
492 CONSTANT CW_CAN_B_AFMR2_H
493 CONSTANT CW_CAN_B_AFMR2_L
494 CONSTANT CW_CAN_B_AFIR2_H
495 CONSTANT CW_CAN_B_AFIR2_L
496 CONSTANT CW_CAN_B_AFMR3_H
497 CONSTANT CW_CAN_B_AFMR3_L
498 CONSTANT CW_CAN_B_AFIR3_H
499 CONSTANT CW_CAN_B_AFIR3_L
500 CONSTANT CW_CAN_B_AFMR4_H
501 CONSTANT CW_CAN_B_AFMR4_L
502 CONSTANT CW_CAN_B_AFIR4_H
503 CONSTANT CW_CAN_B_AFIR4_L
504 CONSTANT CW_CAN_B_ID_H
505 CONSTANT CW_CAN_B_ID_L
506 CONSTANT CW_CAN_B_RF
507 CONSTANT CW_CAN_B_DLC
508 CONSTANT CW_CAN_B_DATA_01
509 CONSTANT CW_CAN_B_DATA_23
510 CONSTANT CW_CAN_B_DATA_45
511 CONSTANT CW_CAN_B_DATA_67

( Programmation des filtres d'acceptation :
  -----------------------------------------
  identifiant 11 bits ou 29 bits de poids faibles
  masque 11 bits ou 29 bits de poids faibles
  type : 1 pour message standard avec adresse standard
         2 pour message d'acquittement avec adresse standard
         3 pour message standard avec adresse etendue
         4 pour message d'acquittement avec adresse etendue
  numero du filtre 1 a 4        
)

: CAN_A_FILTRE ( identifiant,masque,type,numero --> erreur )
 DUP 0> OVER 5 < AND
 IF
  1- >R OVER
  IF
   DUP 0> OVER 5 < AND
   IF
    1- CW_CAN_A_CTRL CW@ 1 R@ LSH -1 XOR AND CW_CAN_A_CTRL CW! DUP >R 2 AND
    IF
     SWAP DUP 536608768 AND DUP 2* + + 786432+ 2* R@ 1 AND OR
     SWAP DUP 536608768 AND DUP 2* + + 786432+ 2* R> 1 AND OR
    ELSE
     SWAP 2047 AND 21 LSH R@ 1 AND OR SWAP 2047 AND 21 LSH R> 1 AND OR
    THEN
    DUP SWAB CW_CAN_A_AFMR1_H R@ 4* + DUP >R CW! R@ 1+ CW!
    DUP SWAB R@ 2+ CW! R> 3+ CW!
    CW_CAN_A_CTRL CW@ 1 R> LSH OR CW_CAN_A_CTRL CW! 0
   ELSE
    R> DROP DROP DROP DROP -2 ( erreur de type )
   THEN
  ELSE
   ( masque = 0 alors effacement du filtre )
   CW_CAN_A_CTRL CW@ 1 R@ LSH -1 XOR AND CW_CAN_A_CTRL CW!
   CW_CAN_A_AFMR1_H R> 4* + DUP >R 4+ R> DO
    0 I CW!
   LOOP
   DROP DROP DUP XOR
  THEN
 ELSE
  DROP DROP DROP DROP -1 ( erreur de numero )
 THEN
;

: CAN_B_FILTRE ( identifiant,masque,type,numero --> erreur )
 DUP 0> OVER 5 < AND
 IF
  1- >R OVER
  IF
   DUP 0> OVER 5 < AND
   IF
    1- CW_CAN_B_CTRL CW@ 1 R@ LSH -1 XOR AND CW_CAN_B_CTRL CW! DUP >R 2 AND
    IF
     SWAP DUP 536608768 AND DUP 2* + + 786432+ 2* R@ 1 AND OR
     SWAP DUP 536608768 AND DUP 2* + + 786432+ 2* R> 1 AND OR
    ELSE
     SWAP 2047 AND 21 LSH R@ 1 AND OR SWAP 2047 AND 21 LSH R> 1 AND OR
    THEN
    DUP SWAB CW_CAN_B_AFMR1_H R@ 4* + DUP >R CW! R@ 1+ CW!
    DUP SWAB R@ 2+ CW! R> 3+ CW!
    CW_CAN_B_CTRL CW@ 1 R> LSH OR CW_CAN_B_CTRL CW! 0
   ELSE
    R> DROP DROP DROP DROP -2 ( erreur de type )
   THEN
  ELSE
   ( masque = 0 alors effacement du filtre )
   CW_CAN_B_CTRL CW@ 1 R@ LSH -1 XOR AND CW_CAN_B_CTRL CW!
   CW_CAN_B_AFMR1_H R> 4* + DUP >R 4+ R> DO
    0 I CW!
   LOOP
   DROP DROP DUP XOR
  THEN
 ELSE
  DROP DROP DROP DROP -1 ( erreur de numero )
 THEN
;

( Routines d'emission d'un message :
  ----------------------------------
  adr pointe le premier octet du message
  id avec 11 bits ou 29 bits de poids faibles
  dlc est la longueur du message de 0 a 8
  type : 1 pour message standard avec adresse standard
         2 pour message d'acquittement avec adresse standard
         3 pour message standard avec adresse etendue
         4 pour message d'acquittement avec adresse etendue
)

: CAN_A_TX ( adr,dlc,id,type --> erreur )
 DUP 0> OVER 5 < AND
 IF
  1- 3 PICK DUP >R 9 U< OVER 1 AND 0= AND OVER 1 AND R> 0= AND OR
  IF
   CW_CAN_A_CTRL CW@ 16384 AND
   IF
    DUP >R 2 AND
    IF
     DUP 536608768 AND DUP 2* + + 786432+ 2*
    ELSE
     21 LSH
    THEN
    R> 1 AND OR DUP SWAB CW_CAN_A_ID_H CW! CW_CAN_A_ID_L CW! CW_CAN_A_DLC CW!
    DUP @ CW_CAN_A_DATA_01 CW! 2+ DUP @ CW_CAN_A_DATA_23 CW! 2+
    DUP @ CW_CAN_A_DATA_45 CW! 2+ @ CW_CAN_A_DATA_67 CW! 0 ( message transmis )
   ELSE
    DROP DROP DROP DROP -1 ( erreur d'emission )
   THEN
  ELSE
   DROP DROP DROP DROP -2 ( erreur de dlc )
  THEN
 ELSE
  DROP DROP DROP DROP -3 ( erreur de type )
 THEN
;

: CAN_B_TX ( adr,dlc,id,type --> erreur )
 DUP 0> OVER 5 < AND
 IF
  1- 3 PICK DUP >R 9 U< OVER 1 AND 0= AND OVER 1 AND R> 0= AND OR
  IF
   CW_CAN_B_CTRL CW@ 16384 AND
   IF
    DUP >R 2 AND
    IF
     DUP 536608768 AND DUP 2* + + 786432+ 2*
    ELSE
     21 LSH
    THEN
    R> 1 AND OR DUP SWAB CW_CAN_B_ID_H CW! CW_CAN_B_ID_L CW! CW_CAN_B_DLC CW!
    DUP @ CW_CAN_B_DATA_01 CW! 2+ DUP @ CW_CAN_B_DATA_23 CW! 2+
    DUP @ CW_CAN_B_DATA_45 CW! 2+ @ CW_CAN_B_DATA_67 CW! 0 ( message transmis )
   ELSE
    DROP DROP DROP DROP -1 ( erreur d'emission )
   THEN
  ELSE
   DROP DROP DROP DROP -3 ( erreur de dlc )
  THEN
 ELSE
  DROP DROP DROP DROP -2 ( erreur de type )
 THEN
;

( Routines de reception d'un message :
  ------------------------------------
  adr pointe le premier octet du tampon de reception
  dlc est la longueur du message de 0 a 8
  id avec 11 bits ou 29 bits de poids faibles
  type : 1 pour message standard avec adresse standard
         2 pour message d'acquittement avec adresse standard
         3 pour message standard avec adresse etendue
         4 pour message d'acquittement avec adresse etendue
  Si aucun message n'est recu, dlc = id = type = 0.
)

: CAN_A_RX ( adr --> dlc,id,type )
 CW_CAN_A_CTRL CW@ 32768 AND
 IF
  >R CW_CAN_A_DLC CW@ CW_CAN_A_ID_H CW@ 16 LSH CW_CAN_A_ID_L CW@ 65535 AND +
  DUP 1 AND OVER 1572864 AND
  IF
   2+ >R 2/ DUP 262143 AND >R 4/ 536608768 AND R> +
  ELSE
   >R -21 LSH
  THEN
  R> 1+ CW_CAN_A_DATA_01 CW@ R@ ! CW_CAN_A_DATA_23 CW@ R@ 2+ !
  CW_CAN_A_DATA_45 CW@ R@ 4+ ! CW_CAN_A_DATA_67 CW@ R> 6+ !
 ELSE
  DUP XOR DUP DUP
 THEN
;

: CAN_B_RX ( adr --> dlc,id,type )
 CW_CAN_B_CTRL CW@ 32768 AND
 IF
  >R CW_CAN_B_DLC CW@ CW_CAN_B_ID_H CW@ 16 LSH CW_CAN_B_ID_L CW@ 65535 AND +
  DUP 1 AND OVER 1572864 AND
  IF
   2+ >R 2/ DUP 262143 AND >R 4/ 536608768 AND R> +
  ELSE
   >R -21 LSH
  THEN
  R> 1+ CW_CAN_B_DATA_01 CW@ R@ ! CW_CAN_B_DATA_23 CW@ R@ 2+ !
  CW_CAN_B_DATA_45 CW@ R@ 4+ ! CW_CAN_B_DATA_67 CW@ R> 6+ !
 ELSE
  DUP XOR DUP DUP
 THEN
;

( Routines d'initialisation:
  --------------------------
)

: CAN_A_INIT ( phseg2,phseg1,propseg,sjw,brtq )
 >R 25000000 ( Frequence du processeur ) R> / 1- CW_CAN_A_BRPR CW!
 3 AND 3 LSH >R 7 AND R> + 3 LSH >R 7 AND R> + 3 LSH >R 7 AND R> +
 CW_CAN_A_BTR CW!
;

: CAN_B_INIT ( phseg2,phseg1,propseg,sjw,brtq )
 >R 25000000 ( Frequence du processeur ) R> / 1- CW_CAN_B_BRPR CW!
 3 AND 3 LSH >R 7 AND R> + 3 LSH >R 7 AND R> + 3 LSH >R 7 AND R> +
 CW_CAN_B_BTR CW!
;

( FIN
)