****************************************************
*                                                  *
* IR-routine for communication with                *
*   fischertechnik computing interface             *
*                                                  *
* last update:   19.11.87       23h00              *
*                                                  *
************************************************cmw*
*      MODULE HEAD FOR RTOS-UH                     *
*                                                  *
       DC.L   0              for loader            *
       DC.L   0              for loader            *
       DC     $10            Type: MDLE            *
       DC.B   'FISH  '       module name           *
*                                                  *
****************************************************
*      SYSTEM TRAPS                                *
*                                                  *
OFF    OPD    $4E4F          interrupts off        *
****************************************************
*      ADDRESS DEFINITIONS                         * 
*                                                  * 
*      interrupt vector definitions                * 
TAVEC  EQU    $134                                 * 
*      PSG YM 2149 definitions                     * 
PSG    EQU    $FF8800        PSG base address      * 
PSGD   EQU    $02            PSG write data        * 
*      MFP 68901 definitions                       * 
MFP    EQU    $FFFA01        MFP base address      * 
IERA   EQU    $06            MFP IR enable reg     * 
IERB   EQU    $08            MFP IR enable reg     * 
IMRA   EQU    $12            MFP IR mask reg       * 
IMRB   EQU    $14            MFP IR mask reg       * 
TACR   EQU    $18            MFP timer A ctrl reg  * 
TCDCR  EQU    $1C            MFP timer CD ctrl reg * 
TADR   EQU    $1E            MFP timer A data reg  * 
TCDR   EQU    $22            MFP timer C data reg  * 
**************************************************** 
*      SYSTEM VARIABLE DEFINITIONS                 * 
*                                                  * 
IID    EQU    $7FE           ID act. running IR    *
DPC    EQU    $800           dispatcher-call flag  *
TID    EQU    $802           ID act. running task  *
DPCJ   EQU    $906           jump to dispatcher    *
****************************************************
*      GLOBAL VARIABLES                            *
*                                                  *
IRbuf  DS     0                                    *
>ftin  DC.W   0              data read from interfa*
>ftout DC.W   0              data to write to inter*
>ftc1  DC.W   0              puls counter 1        *
>ftc2  DC.W   0              puls counter 2        *
>ftc3  DC.W   0              puls counter 3        *
>ftd1  DC.W   0              direction counter 1   *
>ftd2  DC.W   0              direction counter 2   *
>ftd3  DC.W   0              direction counter 3   *
lstval DC.W   0              last read data        *
oldvec DC.L   0              old IR vector         *
*      offset definitions                          *
Ftin   EQU    0              data read from interfa*
Ftout  EQU    Ftin+2         data to write to inter*
Ftc1   EQU    Ftout+2        puls counter 1        *
Ftc2   EQU    Ftc1+2         puls counter 2        *
Ftc3   EQU    Ftc2+2         puls counter 3        *
Ftd1   EQU    Ftc3+2         direction counter 1   *
Ftd2   EQU    Ftd1+2         direction counter 2   *
Ftd3   EQU    Ftd2+2         direction counter 3   *
Lstval EQU    Ftd3+2         last read data        *
****************************************************
*      MISCELLANEOUS DEFINITIONS                   *
*                                                  *
TIME   EQU    36             timer data for 3 ms   *
*                                                  *
*                                                  *
****************************************************
*                                                  *
*      INTERRUPT ROUTINE                           *
*                                                  *
****************************************************
*                                                  *
       DC     IRMAL-TIRQ     malfunction link      * 
TIRQ:  MOVE   IID,-(A7)      save old IR ID        * 
       MOVE   =TAVEC,IID     save own ID           * 
       MOVEM.L D0-D2/A0-A2,-(A7) save register     *
*                                                  *
       ORI    =$0700,SR      disable all IRs       *
       LEA    PSG,A0         get addr of soundchip *
       LEA    MFP,A1         get addr of MFP       *
       LEA    IRbuf,A2       get base addr of var  *
       MOVE.B =15,(A0)       select port B         *
       ADDQ.L =2,A0          addr of write data reg*
*                                                  *
*      write data to interface                     *
*                                                  *
       MOVE.B Ftout(A2),D1   get value to send     *
       MOVEQ  =7,D0          loop count            *
L1:    MOVEQ  =$30,D2        not LOAD_OUT, not CLK *
       ROL.B  =1,D1          get single bit        *
       BCC.S  L1a            '0' bit               *
       MOVEQ  =$34,D2        set DATA_OUT bit      *
L1a:   MOVE.B D2,(A0)        write to PSG          *
       BSR    WAIT                                 *&
       OR.B   =$08,D2        toggle CLK            *
       MOVE.B D2,(A0)        write to PSG          *
       BSR    WAIT                                 *&
       DBF    D0,L1          loop for 8 bit        *
       MOVE.B =$39,(A0)      LOAD_OUT high         *
       BSR    WAIT                                 *&
*                                                  *
*      read data from interface                    *
*                                                  *
L1b:   MOVEQ  =7,D0          loop count            *
       MOVEQ  =0,D1          for data to sample    *
       MOVE.B =$32,(A0)      LOAD_IN high          *
       BSR    WAIT                                 *&
       MOVE.B =$3A,(A0)      toggle CLK            *
       BSR    WAIT                                 *&
L2:    ASL.B  =1,D1          shift old bits        *
       BTST   =0,(A1)        test BUSY bit at MFP  *
       BNE.S  L2a            '1' bit               *
       ADDQ.B =1,D1          set DATA_OUT bit      *
L2a:   MOVE.B =$30,(A0)      toggle CLK            *
       BSR    WAIT                                 *&
       MOVE.B =$38,(A0)      toggle CLK            *
       BSR    WAIT                                 *&
       DBF    D0,L2          loop for 8 bit        *
       MOVE.B D1,Ftin(A2)    data read from interfa*
*                                                  *
*      count edges of light barrier                *
*                                                  *
       MOVE.B Lstval(A2),D0  get old data          *
       EOR.B  D1,D0          compare with new data *
       BEQ.S  IRMAL          no change             *
       LSR.B  =2,D0          check for changed leve*
       BCC.S  L3             level didn't change   *
       MOVE   Ftc1(A2),D2    update counter        *
       ADD    Ftd1(A2),D2                          *
       MOVE   D2,Ftc1(A2)                          *
L3:    LSR.B  =2,D0          check for changed leve*
       BCC.S  L4             level didn't change   *
       MOVE   Ftc2(A2),D2    update counter        *
       ADD    Ftd2(A2),D2                          *
       MOVE   D2,Ftc2(A2)                          *
L4:    LSR.B  =2,D0          check for changed leve*
       BCC.S  L5             level didn't change   *
       MOVE   Ftc3(A2),D2    update counter        *
       ADD    Ftd3(A2),D2                          *
       MOVE   D2,Ftc3(A2)                          *
L5:    MOVE.B D1,Lstval(A2)  new data now old data *
*                                                  *
*      restore registers, leave IR routine         *
*                                                  *
IRMAL: MOVEM.L (A7)+,D0-D2/A0-A2 recover regs      *
       MOVE   (A7)+,IID      recover old IID       *
       ORI    =$0700,SR      all IR off            *
       TST    DPC            dispatcher call?      *
       BMI.S  EX1            b: no proc. switching *
       RTE                   normal exit           *
EX1:   JMP    DPCJ           call dispatcher       *
*                                                  *&
*      the following routine is only needed by     *&
*      the 68020 (it is to fast for CMOS)          *&
*                                                  *&
WAIT:  NOP                                         *&
       RTS                                         *&
*                                                  *&
*                                                  *
****************************************************
*                                                  *
*      Establish IR-routine                        *
*                                                  *
****************************************************
*                                                  *
>SetIR: V0                   Hyperproc. off        *
       OFF                   no irq allowed        *
*                                                  *
*      set IR vector                               *
*                                                  * 
       LEA    TAVEC,A1       addr timer A vector   *
       LEA    oldvec,A2      to save the old vector*
       MOVE.L (A1),(A2)      save old IR vector    *
       LEA    TIRQ,A3        get addr of IR routine*
       MOVE.L A3,(A1)        set new vector        *
       MOVE.B (A2),(A1)      recover MSB of vector *
*                                                  * 
*      initialize timer A                          *
*                                                  * 
       LEA    MFP,A1         get addr of MFP       *
       MOVE.B =$07,TACR(A1)  prescaler /200        *
       MOVE.B =TIME,TADR(A1) set timer A data reg  *
       MOVE.B IMRA(A1),D0    clear timer A IRQ mask*
       ORI.B  =$20,D0                              *
       MOVE.B D0,IMRA(A1)                          *
       MOVE.B IERA(A1),D0                          *
       ORI.B  =$20,D0        enable timer A IR     *
       MOVE.B D0,IERA(A1)                          *
       MOVE.B IERB(A1),D0                          *
       ANDI.B =$FE,D0        disable Centronics IR *
       MOVE.B D0,IERB(A1)                          *
       ANDI   =$D8FF,SR      enable interrupts     *
       JMP    2(A0)          return to caller      *
*                                                  * 
*                                                  *
****************************************************
*                                                  * 
*      Reset IR-routine                            *
*                                                  * 
****************************************************
*                                                  *
>RstIR: V0                   Hyperproc. off        *
       LEA    MFP,A1         get addr of MFP       *
       OFF                   no irq allowed        *
*                                                  * 
*      disable timer A                             *
*                                                  * 
       MOVE.B IERA(A1),D0                          *
       ANDI.B =$DF,D0        disable timer A IR    *
       MOVE.B D0,IERA(A1)                          *
       MOVE.B IERB(A1),D0                          *
       ORI.B  =$01,D0        enable Centroics IR   *
       MOVE.B D0,IERB(A1)                          * 
       MOVE.B IMRA(A1),D0    mask timer A IRQ      * 
       ANDI.B =$DF,D0                              * 
       MOVE.B D0,IMRA(A1)                          * 
       MOVE.B =0,TACR(A1)    stop timer A          * 
*                                                  * 
*      restore old IR vector                       * 
*                                                  * 
       LEA    TAVEC,A1       addr timer A vector   * 
       MOVE.L oldvec,(A1)    restore old IR vector * 
       ANDI   =$D8FF,SR      enable interrupts     * 
       JMP    2(A0)          return to caller      * 
*                                                  * 
*                                                  * 
**************************************************** 
       END    OF             JOY                   * 
****************************************************