please dont rip this site
Ken's computer

D:\PROJECTS\TIMEMON\SERMUX\SERMUX_S.ASM


;-----------------------------------------------------------------------------------------------------
; Serial port multiplexer
; Slave processor
;
; This is one of the PIC16C73s which act as smart buffered UARTs for the main PIC16C74 processor.
;
; Code developed 04/22/98 through 08/08/98
; Modified 09/02/98 to implement the "double unlisten" reset
;
;
;****************************************************************************************************
;  Overview:
;****************************************************************************************************
;
; The serial port multiplexer board is used to allow one RS-232 port on a PC to be shared among 7
; devices requiring simple (no handshake) serial I/O.  Any of these 7 devices may themselves be
; another (cascaded) multiplexer board.
;
; This processor is used as a smart buffered UART for one of those 7 ports.  It is controlled by
; the main processor via an 8-bit-wide bus.
;
; This processor does not have specific command sequences for setting up the RS232 port or
; returning error status, etc.  Instead it has indirect read and write cycles which may be
; used to read or write any register.  The master processor simply accepts commands from the
; host computer to read and write slave processor registers and the host computer's software
; is responsible for setting up the serial port, checking error statistics, etc.
;
; Although it is possible for the host computer to write to registers which would crash this MCU,
; it is preferable to keep this MCU's code simple and very low-level and build up the higher-
; level functions in the host computer's software since it is much easier to code in C++ than
; in assembly.  As long as the host software operates correctly there should be no problems since
; it is statistically extremely improbable for noise or garbage on the line to not only pass the
; checksum tests for a packet but also contain a command to write a slave processor register.
;
;****************************************************************************************************
;  Bus operation:
;****************************************************************************************************
;
; The master controls the bus.  It has 8 bits of bidirectional data connected to RB0..7 of each
; slave processor.  It also has the following control lines:
;
;
;  Name       Brief description                                 Driven by       port bit
; -----------------------------------------------------------------------------------
;  CID1       Cycle ID bit 1                                    Master          RA3
;  CID0       Cycle ID bit 0                                    Master          RA2
;  R/W        High for read cycle, Low for write cycle          Master          RA1
;  E          Enable -- active high strobe                      Master          RA0
;  Ack        Acknowledge -- active low, common-drain           Slave           RA4
;
;
; Each slave may either be addressed to respond to normal bus read/write cycles or
; to ignore normal bus cycles.  A special bus cycle is used to address a specific
; slave processor to "listen" or "unlisten" to normal bus cycles.  Only one slave
; processor at a time should be addressed to "listen".
;
;
; All bus cycles (including the special "listen" / "unlisten" one) fall into one
; of two categories:  read cycles or write cycles.  Note that "read" and "write"
; are from the master's point-of-view.
;
; Write cycle timing:
;     1). Master sets up CID1, CID0, and R/W
;     2). Master waits if Ack is being driven low (prior cycle not yet ended by slave)
;     3). Master drives data onto RB0..7
;     4). Master asserts E
;     5). The addressed slave samples RB0..7
;     6). The addressed slave drives Ack low
;     7). The master de-asserts E (and is then free to change any other signal)
;     8). The addressed slave stops driving Ack low
;
; Read cycle timing:
;     1). Master sets up CID1, CID0, and R/W
;     2). Master waits if Ack is being driven low (prior cycle not yet ended by slave)
;     3). Master asserts E
;     4). The addressed slave drives data onto RB0..7
;     5). The addressed slave drives Ack low
;     6). The master samples RB0..7
;     7). The master de-asserts E (and is then free to change any other signal)
;     8). The addressed slave stops driving RB0..7 and Ack
;     
;
; Types of bus cycles:
;
; CID1  CID0    R/W     Cycle name      Description
; -------------------------------------------------------------------------------------------------
;    0     0      0     Write Tx        Data is written to the Transmit Pipe
;    0     0      1     Read Rx         Data is read from the Receive Pipe
;    0     1      0     Write IAddr     Data is written to the indirect addressing register (IAddr)
;    0     1      1     Poll Tx         Reads the number of free bytes in the Transmit Pipe
;    1     0      0     Chip Select     Special cycle which addresses a slave to "listen" or "unlisten"
;    1     0      1     Poll Rx         Reads the number of bytes waiting in the Receive Pipe
;    1     1      0     Write Indirect  Writes the register pointed to by the IAddr register
;    1     1      1     Read Indirect   Reads the register pointed to by the IAddr register
;
;
; The Chip Select cycle requires further description:
;    Data bits 0..3 contain the address of the slave which should respond to this cycle (and assert Ack)
;    Data bit 7 is:
;       1 if the addressed slave should "listen" (respond) to all other types of bus cycle
;       0 if the addressed slave should "unlisten" to (ignore) all other types of bus cycle
;    Data bits 4..6 are unused
;
; If a slave is addressed to "unlisten" when it is already in the "unlistened" state then it will
; reset all internal registers (thus disabling the serial port receiver and flushing all buffers).
; This special double unlisten condition is sent by the master as part of its BREAK reset ...
; thus a BREAK sent to the master will reset the entire board to its power-up state.
;
;
; The Write IAddr cycle has special meaning for the following values:
;    0X00 -- Transfers a block of up to 4 registers into the word buffer (read transfer)
;    0X80 -- Transfers a block of up to 4 registers from the word buffer (write transfer)
;
; Prior to executing either of the above commands, the word buffer address and length registers
; should be written in the normal manner.  The word buffer itself should be written prior to
; executing a write transfer.  It is read to fetch the results of a read transfer.
;
; The data in the word buffer is right-justified (WordBuf3 is always filled, WordBuf2 is
; filled if 2 or more bytes are transfered, etc.)
;
; These special commands facilitate "snapshot" transfers of 32-bit words in order to avoid
; having the value modified by the operating program partway through a read or write.



;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;####################################################################################################
;****************************************************************************************************
; Definitions, macros, variables, constants
;****************************************************************************************************
;####################################################################################################
;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

                        LIST            P=PIC16C73A, R=DEC              ; PIC16C73A, radix = base 10
                        INCLUDE         <P16C73A.INC>




;-----------------------------------------------------------------------------
;Software registers (RAM) in bank0


        CBLOCK  0X20

;Word buffer registers
;These registers are used to facilitate "snapshot" transfers of 16 or 32 bit words so
;that the values can be read or written without danger of the value being modified by
;the operating program partway through a read or write.
                WordBufAddr     ;address base for word transfer
                WordBufLen      ;length, 1..4
                WordBuf0        ;low databyte of word
                WordBuf1        ;note that data is right-justified, i.e. a 16-bit word
                WordBuf2        ;   occupies WordBuf2 and WordBuf3              
                WordBuf3        ;high databyte of word

;Error/status statistics ... the host computer may read these registers to check status.
;These are placed near the start of this CBLOCK to simplify address calculations for
;accessing these registers from the host computer.

                LostCharCount0  ;number of characters lost due to receive pipe overruns
                LostCharCount1
                LostCharCount2
                LostCharCount3

                ferr_count0     ;Number of framing errors detected
                ferr_count1
                ferr_count2
                ferr_count3

        

                Flags1          ;miscellaneous flags -- see individual bit definitions below
                BusTestMask     ;contains the "Addressed" flag plus an AND mask for checking for bus cycles
                temp_bcs        ;temporary register used by bus cycle service subroutine
                temp            ;temporary register used by receive char and transmit char subroutines
                BusIaddr        ;indirect address for bus cycles
                


;Read and write pointers for Tx and Rx pipes (FIFO buffers for serial port data)

                TxPipeRptr      ;Read pointer for Transmit pipe
                TxPipeWptr      ;Write pointer for Transmit pipe
                RxPipeRptr      ;Read pointer for Receive pipe
                RxPipeWptr      ;Write pointer for Receive pipe

;Registers which track free or filled space in pipes to speed up poll cycles
                TxPipeFree      ;number of bytes free in the Tx pipe
                RxPipeCount     ;number of bytes buffered in the Rx pipe


                TxPipe          ;transmit pipe starts here and extends up to end of low page of registers
                
        ENDC






;------------------------------------------------------------------------------
; Flags contained in the Flags1 register:
        CBLOCK 0
                TxPipeEmpty     ;transmit pipe is empty
        ENDC
        

;------------------------------------------------------------------------------
; Bits contained in the BusTestMask register:
Addressed               EQU     4               ;this bit is set when this slave is addressed to respond to general bus cycles







;------------------------------------------------------------------------------
;Pipes for buffering serial port data
;
;The receive pipe ensures that no data is lost when characters come in while
;the main processor is busy.
;
;The transmit pipe helps keep data streaming out at the maximum rate allowed
;by the serial port.
;
;Since a receive pipe overflow will result in lost data whereas a transmit
;pipe underflow only results in a small delay, the receive buffer is larger
;than the transmit buffer.
;
;Receive buffer size = 96 bytes
;Transmit buffer size = 71 bytes (calculated when TxPipe was at 0X39 ... may need to recalculate if more variables have been added the the CBLOCK)

;TxPipe                 EQU     0X39            ;first byte within the buffer -- defined in CBLOCK above
TxPipeEnd               EQU     0X80            ;first byte past the end of the buffer
TxPipeSize              EQU     TxPipeEnd - TxPipe

RxPipe                  EQU     0XA0            ;first byte within the buffer
RxPipeEnd               EQU     0X00            ;first byte past the end of the buffer (buffer goes up through 0XFF)






;------------------------------------------------------------------------------
;Macros

Move                    MACRO           destination,source
                        MOVFW           source
                        MOVWF           destination
                        ENDM

Movlf                   MACRO           destination,source
                        MOVLW           source
                        MOVWF           destination
                        ENDM


;Clear global interrupt enable -- note that an IRQ may be acknowledged
;before the BCF instruction and the IRQ may be executed after the BCF
;instruction and leave gie set upon return (thus the BTFSC instruction
;to make sure this hasn't happened)
ClrI                    MACRO
                        LOCAL           lpclri
lpclri                  BCF             INTCON,GIE
                        BTFSC           INTCON,GIE
                        GOTO            lpclri
                        ENDM

;Set global interrupt enable
SetI                    MACRO
                        BSF             INTCON,GIE
                        ENDM



Bank0                   MACRO
                        BCF             STATUS,RP0
                        ENDM

Bank1                   MACRO
                        BSF             STATUS,RP0
                        ENDM

LowPage                 MACRO
                        BCF             PCLATH,3
                        ENDM

HighPage                MACRO
                        BSF             PCLATH,3
                        ENDM                    

LightTx                 MACRO
                        BSF             PORTC,4
                        ENDM

DouseTx                 MACRO
                        BCF             PORTC,4
                        ENDM

LightRx                 MACRO
                        BSF             PORTC,5
                        ENDM

DouseRx                 MACRO
                        BCF             PORTC,5
                        ENDM



;The CheckBus macro is frequently interspersed throughout the other code so that
;bus cycles can complete as quickly as possible and the master can get on to
;other business
;
;It is 9 words in length
CheckBus                MACRO

;Test for E * CID1 * CID0\ * WR   * Ack  to see if a chip-select cycle is started but not yet responded to
; =     RA0 * RA3  * RA2\  * RA1\ * RA4
                        
                        MOVFW           PORTA                   ;note that RA5 is unused and driven low, RA6..7 are unimplemented and read as zeros
                        XORLW           0X19
                        BTFSC           STATUS,Z
                        CALL            check_chip_select       ;subroutine must return with bit4 and/or bit0 of W set so that test below fails

;Test for E * addressed * Ack  (and not a chip select cycle since above test failed)
; =     RA0 * Flags1:4  * RA4
                        XORLW           0X19                    ;restore original PORTA value read above (don't reread since it may have changed and may be a chip select cycle)
                        ANDWF           BusTestMask,W           ;bit4 is "Addressed" flag, bit0 is set to 1 to mask the E bit, other bits are 0s
                        XORLW           0X11
                        BTFSC           STATUS,Z
                        CALL            bus_cycle

                        ENDM





;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
;####################################################################################################
;****************************************************************************************************
; Start of code
;****************************************************************************************************
;####################################################################################################
;||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||



;******************************************************************************
;Reset vector
                        ORG             0
restart

;-----------------------------------------------------------------------------
;Initialize all relevent special function registers to their reset states ...
;this is done incase a watchdog timer reset occurs and some SFRs have values
;which would otherwise impair normal operation
                        CLRF            STATUS          ;Clear RP0, RP1 and IRP bits
                        CLRF            PCLATH
                        MOVLW           0X10
                        MOVWF           PORTA           ;Ack is asserted by clearing bit 4 of PORTA .. other PORTA bits are inputs or unused outputs                    
                        CLRF            INTCON
                        CLRF            T1CON
                        CLRF            T2CON
                        CLRF            SSPCON
                        CLRF            CCP1CON
                        CLRF            RCSTA
                        CLRF            CCP2CON
                        CLRF            ADCON0
                Bank1
                        MOVLW           0XFF
                        MOVWF           0X81            ;OPTION register -- symbol not defined in stock header
                        MOVWF           TRISA
                        MOVWF           TRISB
                        MOVWF           TRISC
                        CLRF            PIE1
                        CLRF            PIE2
                        CLRF            SSPSTAT
                        CLRF            TXSTA
                        CLRF            SPBRG
                        CLRF            ADCON1


;-----------------------------------------------------------------------------
;Initialize software registers

                Bank0
                        MOVLW           (1 << TxPipeEmpty)
                        MOVWF           Flags1                  ;Transmit pipe is empty
                        MOVLW           1
                        MOVWF           BusTestMask             ;Not addressed to "listen", bit 0 is set so Ack can be masked
                        CLRF            BusIaddr
                        
                        CLRF            ferr_count0
                        CLRF            ferr_count1
                        CLRF            ferr_count2
                        CLRF            ferr_count3
                        CLRF            LostCharCount0
                        CLRF            LostCharCount1  
                        CLRF            LostCharCount2
                        CLRF            LostCharCount3
                        
                        Movlf           TxPipeRptr,TxPipe       ;Read pointer for Transmit pipe
                        Movlf           TxPipeWptr,TxPipe       ;Write pointer for Transmit pipe
                        Movlf           RxPipeRptr,RxPipe       ;Read pointer for Receive pipe
                        Movlf           RxPipeWptr,RxPipe       ;Write pointer for Receive pipe
                        
                        CLRF            RxPipeCount             ;number of bytes buffered in Receive pipe
                        Movlf           TxPipeFree,TxPipeSize   ;number of bytes available in Transmit pipe
                        DECF            TxPipeFree,F            ;can't write to n'th byte since this would lap the pointers

                        

;--------------------------------------------------------------------------
; Initialize special function registers (I/O port states, most peripherals)

                        MOVLW           0X10
                        MOVWF           PORTA           ;Ack is asserted by clearing bit 4 of PORTA .. other PORTA bits are inputs or unused outputs
                        MOVLW           0X40
                        MOVWF           PORTC           ;tx and rx LEDs doused, RS232 Tx output high (stopbit / idle state) for baud-rate detect algorithm (if implemented)

                Bank1
                        Movlf           ADCON1,6        ;configure RA0..5 as digital I/O rather than analog inputs
                        BCF             TRISC,6         ;configure RC6/Tx as output ... drive it high durring baud-rate detect algorithm (if implemented)
                        MOVLW           0X0F
                        MOVWF           TRISA           ;RA5 is unused and unconnected -- drive it low, RA4 is the open-drain Ack output
                Bank0








; Enable serial port for 38.4 kbaud (default baud rate)
; The rate may be changed via the bus later
                Bank1   
                        MOVLW           (1 << TXEN)
                        MOVWF           TXSTA           ;enable serial port transmit, not BRGH, asynchronous mode, 8 bit
                        movlw           7
                        movwf           SPBRG           ;38.4 kbaud
                Bank0
                        MOVLW           (1 << SPEN)     ;enable serial port, do not enable receiver (it will be enabled later by host)
                        MOVWF           RCSTA



                        Movlf           FSR,TRISB       ;This is the default FSR value in the main loop ... allows faster tri-state control of data bus






;#####################################################################################################################
;*********************************************************************************************************************
; Main loop
;*********************************************************************************************************************
;
; Everything occurs here.  There is no interrupt vector.
;
; Priority is given to responding to bus cycles quickly so that the master can go about its business.
; Responding to serial port I/O is a much lower priority since even at 115.2 kbaud there is an entire
; 86.8us (434 instruction cycles) per byte and the hardware contains a 2-level deep receive FIFO.
;
; FSR is expected (by bus cycle service subroutines) to point to TRISB ... if FSR is used for other
; purposes it should always be set back to TRISB
;
mainloop                CLRWDT
                        BTFSC           PIR1,RCIF               ;Received character?
                        CALL            receive_char
                        CheckBus                        
                        BTFSC           Flags1,TxPipeEmpty      ;no, anything to transmit?
                        GOTO            mainloop_c1
                        CheckBus                        
                        BTFSC           PIR1,TXIF               ;yes, transmit holding register empty?
                        CALL            transmit_char
mainloop_c1             CheckBus
                        GOTO            mainloop



                        


;#####################################################################################################################
; Bus interface subroutines

;---------------------------------------------------------------------------------------
;Master is asserting E, this chip is addressed, and the cycle is not a chip-select cycle
bus_cycle               BTFSS           PORTA,3                 ;Cycle ID bit1
                        GOTO            CID0X
                        BTFSC           PORTA,2                 ;Cycle ID bit0
                        GOTO            CID11

;CID10 -- no need to check RD/WR since a write cycle would be a Chip select (this case has already been eliminated by the CheckBus macro)
; ------ Poll Rx ------
;CID10R
                        MOVFW           RxPipeCount
bus_read                MOVWF           PORTB                   ;jump here with byte in W to complete a bus read cycle
                        CLRF            INDF
                        BCF             PORTA,4                 ;Ack
                        GOTO            wait_e_low_rd



CID11                   BTFSC           PORTA,1                 ;RD/WR
                        GOTO            CID11R
                        
; ------ Write indirect ------
;CID11W
                        BCF             PORTA,4                 ;assert Ack
                        MOVFW           PORTB                   ;it is ok to read data shortly after asserting ack since there is no way the master could respond that fast (and this processor doesn't use interrupts)
                        MOVWF           temp_bcs
                        MOVFW           BusIaddr
                        MOVWF           FSR
                        MOVFW           temp_bcs
                        MOVWF           INDF
                        
                        Movlf           FSR,TRISB
                        INCF            BusIaddr,F              ;post-increment BusIaddr
                        
wait_e_low_wr           BTFSC           PORTA,0                 ;wait for master to de-assert E
                        GOTO            wait_e_low_wr
                        BSF             PORTA,4                 ;release Ack
                        RETURN


; ------ Read indirect ------ 
CID11R                  Move            FSR,BusIaddr
                        Move            PORTB,INDF
                        Movlf           FSR,TRISB
                        CLRF            INDF
                        BCF             PORTA,4                 ;Ack
                        INCF            BusIaddr,F              ;post-increment BusIaddr
                        GOTO            wait_e_low_rd                   


CID0X                   BTFSC           PORTA,2                 ;Cycle ID bit0
                        GOTO            CID01

;CID00
                        BTFSS           PORTA,1                 ;RD/WR
                        GOTO            CID00W



; ------ Read from receive pipe ------ 
;CID00R
                        Move            FSR,RxPipeRptr
                        Move            PORTB,INDF              ;Move byte from receive pipe to PORTB
                        Movlf           FSR,TRISB
                        CLRF            INDF
                        BCF             PORTA,4                 ;Ack

;update pipe pointer and free space counter
;Note that master may de-assert E now and there will be a few cycles delay before Ack is de-asserted ... this
;is not a problem since the master will not wait for de-asserted Ack until it begins the next bus cycle and
;it too will have some processing to do before it can start another cycle
                        INCF            RxPipeRptr,F
                        MOVFW           RxPipeRptr
                        XORLW           RxPipeEnd
                        MOVLW           RxPipe
                        BTFSC           STATUS,Z
                        MOVWF           RxPipeRptr
                        DECF            RxPipeCount,F

wait_e_low_rd           BTFSC           PORTA,0                 ;wait for master to de-assert E
                        GOTO            wait_e_low_rd
                        DECF            INDF,F
                        BSF             PORTA,4
                        RETURN
                        


; ------ Write to transmit pipe ------ 
CID00W                  BCF             PORTA,4                 ;Ack
                        Move            temp_bcs,PORTB          ;Move databyte to TxPipe
                        Move            FSR,TxPipeWptr
                        Move            INDF,temp_bcs
                        Movlf           FSR,TRISB

;update pipe pointer, free space counter, and flag
;Note that master may de-assert E now and there will be a few cycles delay before Ack is de-asserted ... this
;is not a problem since the master will not wait for de-asserted Ack until it begins the next bus cycle and
;it too will have some processing to do before it can start another cycle
                        INCF            TxPipeWptr,F
                        MOVFW           TxPipeWptr
                        XORLW           TxPipeEnd
                        MOVLW           TxPipe
                        BTFSC           STATUS,Z
                        MOVWF           TxPipeWptr
                        DECF            TxPipeFree,F
                        BCF             Flags1,TxPipeEmpty

                        GOTO            wait_e_low_wr


CID01                   BTFSS           PORTA,1                 ;RD/WR
                        GOTO            CID01W

; ------ Poll Tx ------ 
;CID01R
                        MOVFW           TxPipeFree
                        GOTO            bus_read

; ------ Write to BusIaddr register ------ 
CID01W                  BCF             PORTA,4                 ;Ack
                        Move            BusIaddr,PORTB
                        ANDLW           0X7F                    ;Special command address?
                        BTFSS           STATUS,Z
                        GOTO            wait_e_low_wr           ;   no, simple BusIaddr write

                        MOVLW           5                       ;   yes, make sure operation is legal
                        SUBWF           WordBufLen,W
                        BTFSC           STATUS,C
                        GOTO            wait_e_low_wr           ;ignore illegal operation
                        Move            FSR,WordBufAddr         ;prepare to read/write block of registers
                        
                        BTFSC           BusIaddr,7              ;read or write?
                        GOTO            write_word_buf

;Word buffer read transfer
                        MOVLW           HIGH WBRTT              ;use jump-table to read n bytes from buffer in right-justified fashion
                        MOVWF           PCLATH
                        MOVF            WordBufLen,W
                        ADDLW           LOW WBRTT
                        BTFSC           STATUS,C
                        INCF            PCLATH,F
                        MOVWF           PCL

WBRTT                   GOTO            WBR0
                        GOTO            WBR1
                        GOTO            WBR2
                        GOTO            WBR3
;WBR4                   
                        Move            WordBuf0,INDF
                        INCF            FSR,F
WBR3                    Move            WordBuf1,INDF
                        INCF            FSR,F
WBR2                    Move            WordBuf2,INDF
                        INCF            FSR,F
WBR1                    Move            WordBuf3,INDF
WBR0                    Movlf           FSR,TRISB
                        GOTO            wait_e_low_wr

;Word buffer write transfer
write_word_buf          MOVLW           HIGH WBWTT              ;use jump-table to write n bytes to buffer in right-justified fashion
                        MOVWF           PCLATH
                        MOVF            WordBufLen,W
                        ADDLW           LOW WBWTT
                        BTFSC           STATUS,C
                        INCF            PCLATH,F
                        MOVWF           PCL

WBWTT                   GOTO            WBW0
                        GOTO            WBW1
                        GOTO            WBW2
                        GOTO            WBW3
;WBW4                   
                        Move            INDF,WordBuf0
                        INCF            FSR,F
WBW3                    Move            INDF,WordBuf1
                        INCF            FSR,F
WBW2                    Move            INDF,WordBuf2
                        INCF            FSR,F
WBW1                    Move            INDF,WordBuf3
WBW0                    GOTO            WBR0
                        



;--------------------------------------------------------------------------------------------------------------------
;Check to see if Chip Select cycle is targeting this chip .. if so then respond and set Addressed flag appropriately.
;This subroutine must return with bit4 of W set in order for the CheckBus macro to work properly
;
;This subroutine will jump to the reset vector if a "double unlisten" occurs (chip is addressed to "unlisten" when
;it is already in the "unlistened" state)
check_chip_select       MOVFW           PORTB
                        XORWF           PORTC,W                 ;PORTC 0..3 are this chip's address
                        ANDLW           0X0F
                        BTFSS           STATUS,Z
                        GOTO            return_ccs
                        
                        BCF             PORTA,4                 ;address matched -- assert Ack
                        BTFSS           PORTB,7                 ;ok to reread data shortly after asserting ack (no way master can respond within 1 cycle and change data bus value)
                        GOTO            ccs_unlisten
                        BSF             BusTestMask,Addressed
                        GOTO            wait_e_low_wr_ccs

ccs_unlisten            BTFSS           BusTestMask,Addressed
                        GOTO            wait_e_low_wr_rst       ;Double "unlisten" -- reset
                        BCF             BusTestMask,Addressed
                        
wait_e_low_wr_ccs       BTFSC           PORTA,0                 ;wait for master to de-assert E
                        GOTO            wait_e_low_wr_ccs
                        
                        BSF             PORTA,4                 ;release Ack

return_ccs              MOVLW           0X11                    ;bit 4 and/or bit 0 must be set for CheckBus macro to work properly
                        RETURN


;The bus cycle must still be completed before jumping to the RESET vector
wait_e_low_wr_rst       BTFSC           PORTA,0                 ;wait for master to de-assert E
                        GOTO            wait_e_low_wr_rst
                        
                        BSF             PORTA,4                 ;release Ack
                        GOTO            restart




;#####################################################################################################################
; Serial port I/O subroutines

;----------------------------------------------------------------------------------------
; Receive a character and write it to the receive pipe
receive_char            BTFSC           RCSTA,FERR
                        CALL            framing_err
                        
                        Move            FSR,RxPipeWptr
                        Move            INDF,RCREG
                        Movlf           FSR,TRISB
                        
                        CheckBus
                        
                        INCF            RxPipeWptr,W            ;tentatively increment the pipe write pointer
                        MOVWF           temp
                        XORLW           RxPipeEnd
                        MOVLW           RxPipe
                        BTFSC           STATUS,Z
                        MOVWF           temp

                        CheckBus
                        
                        MOVFW           temp                    ;check for full pipe
                        XORWF           RxPipeRptr,W
                        BTFSC           STATUS,Z
                        GOTO            rx_pipe_full
                        
                        INCF            RxPipeCount,F           ;pipe not full -- commit write
                        Move            RxPipeWptr,temp
                        RETURN


rx_pipe_full            INCF            LostCharCount0,F        ;keep track of how many characters were lost due to pipe overruns
                        BTFSC           STATUS,Z
                        INCF            LostCharCount1,F
                        BTFSC           STATUS,Z
                        INCF            LostCharCount2,F
                        BTFSC           STATUS,Z
                        INCF            LostCharCount3,F
                        RETURN

;keep track of how many framing errors occur (allows host computer to perform auto baud-rate detect)
framing_err             INCF            ferr_count0,F
                        BTFSC           STATUS,Z
                        INCF            ferr_count1,F
                        BTFSC           STATUS,Z
                        INCF            ferr_count2,F
                        BTFSC           STATUS,Z
                        INCF            ferr_count3,F
                        RETURN
                        
                        
                        


;----------------------------------------------------------------------------------------
; Transmit a character from the transmit pipe
transmit_char           Move            FSR,TxPipeRptr
                        Move            TXREG,INDF
                        Movlf           FSR,TRISB

                        CheckBus

                        INCF            TxPipeRptr,F            ;incrment pipe read pointer
                        MOVFW           TxPipeRptr
                        XORLW           TxPipeEnd
                        MOVLW           TxPipe
                        BTFSC           STATUS,Z
                        MOVWF           TxPipeRptr
                        INCF            TxPipeFree,F

                        CheckBus

                        MOVFW           TxPipeRptr              ;check for empty pipe -- set flag if so
                        XORWF           TxPipeWptr,W
                        BTFSC           STATUS,Z
                        BSF             Flags1,TxPipeEmpty
                        
                        RETURN



                        END

Source Code        Old Source Code        Older Source Code        Subtree        Local home        Home

file: /Techref/microchip/sermux_s.asm, 38KB, , updated: 2000/1/6 12:40, local time: 2024/3/28 09:41,
TOP NEW HELP FIND: 
54.205.238.173:LOG IN

 ©2024 These pages are served without commercial sponsorship. (No popup ads, etc...).Bandwidth abuse increases hosting cost forcing sponsorship or shutdown. This server aggressively defends against automated copying for any reason including offline viewing, duplication, etc... Please respect this requirement and DO NOT RIP THIS SITE. Questions?
Please DO link to this page! Digg it! / MAKE!

<A HREF="http://piclist.com/techref/microchip/sermux_s.asm"> Ken's Web Server -- /cgi-bin/tl.exe/Timemon/sermux/sermux_s.asm</A>

Did you find what you needed?

  PICList 2024 contributors:
o List host: MIT, Site host massmind.org, Top posters @none found
- Page Editors: James Newton, David Cary, and YOU!
* Roman Black of Black Robotics donates from sales of Linistep stepper controller kits.
* Ashley Roll of Digital Nemesis donates from sales of RCL-1 RS232 to TTL converters.
* Monthly Subscribers: Gregg Rew. on-going support is MOST appreciated!
* Contributors: Richard Seriani, Sr.
 

Welcome to piclist.com!

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

  .