; ;************************************************************************ ; ; Hydraulic winch power display Juha Niinikoski ; Reads data from ALDL display computeroutput stream. Output stream = ; ALDL data + pressure measurements ; ; Version 1.0 6.6.1999 ; ;************************************************************************ ; LIST P = 16F84, R = HEX ; _config H'3FFD' ; xt OSC, WDT ON, PWR UP DLY ON, CP OFF ; _config dont work with my assembler ??? Config bits have to be ; set rom programmer ; ;************************************************************************ ; RS-232 Communication With PIC16C54 changed to ; PIC16F84 code 2.2.1999/ JNI ; Half Duplex Asynchronous Communication ; This program has been tested at Bauds from 1200 to 19200 Baud ; ( @ 8,16,20 Mhz CLKIN ) ; As a test, this program will echo back the data that has been ; received. ; Program: HALF_DUP.ASM ; Revision Date: 12-12-95 Compatibility with MPASMWIN 1.30 ;************************************************************************ ; INCLUDE "p16f84.inc" ; ;************************************************************************ ; LCD I/O parameters ; LCDPORT EQU PORTB ; Port B - LCD LCDRS EQU 4 ; Lcd register select output LCDEN EQU 5 ; Lcd enable output ; LCD commands LCDCLER EQU b'00000001' ; Clears display, resets curcor LCDCM EQU b'10000000' ; Sets cursor using bits 0 - 6 ; Line 1 range - 0 to .15 ; Line 2 range - .40 to .55 ; NOTE that subroutine LCDCUR2 take the ; value in W in range 0 - 15 and adjusts for ; line 2 offset. ;***************** Communication Parameters ************************** ; X_MODE equ 1 ; If ( X_MODE==1) Then transmit LSB first ; if ( X_MODE==0) Then transmit MSB first ( CODEC like ) R_MODE equ 1 ; If ( R_MODE==1) Then receive LSB first ; if ( X_MODE==0) Then receive MSB first ( CODEC like ) X_Nbit equ 1 ; if (X_Nbit==1) # of data bits ( Transmission ) is 8 else 7 R_Nbit equ 1 ; if (R_Nbit==1) # of data bits ( Reception ) is 8 else 7 ; Sbit2 equ 1 ; if Sbit2 = 0 then 1 Stop Bit else 2 Stop Bits ; Inv_Tx equ 1 ; if inverted TX output signal b9600_8 equ 0 ; 9600 / 8 MHz clock b9600_4 equ 1 ; 9600 / 4 MHz clock b8192_4 equ 0 ; 8192 / 4 MHz clock special GM ALDL speed ; ;************************************************************************ carry equ 0 same equ 1 lsb equ 0 msb equ 7 ; ; PORT A = RS232 I/O ; DX equ 3 ; Transmit Pin ( Bit 3 of Port A ) DR equ 4 ; Reciive Pin ( Bit 4 of Port A ) ; if b9600_8 ;9600 / 8 Mhz kello BAUD_1 equ .68 ; 3+3X = CLKOUT/Baud BAUD_2 equ .67 ; 6+3X = CLKOUT/Baud BAUD_3 equ .34 ; 3+3X = 0.5*CLKOUT/Baud BAUD_4 equ .86 ; 3+3X = 1.25*CLKOUT/Baud BAUD_X equ .66 ; 11+3X = CLKOUT/Baud BAUD_Y equ .66 ; 9 +3X = CLKOUT/Baud endif if b9600_4 ;9600 / 4 Mhz kello BAUD_1 equ .30 ; 3+3X = CLKOUT/Baud BAUD_2 equ .30 ; 6+3X = CLKOUT/Baud BAUD_3 equ .15 ; 3+3X = 0.5*CLKOUT/Baud BAUD_4 equ .38 ; 3+3X = 1.25*CLKOUT/Baud BAUD_X equ .30 ; 11+3X = CLKOUT/Baud BAUD_Y equ .30 ; 9 +3X = CLKOUT/Baud endif if b8192_4 ;8192 / 8 Mhz kello BAUD_1 equ .38 ; 3+3X = CLKOUT/Baud BAUD_2 equ .38 ; 6+3X = CLKOUT/Baud BAUD_3 equ .20 ; 3+3X = 0.5*CLKOUT/Baud BAUD_4 equ .48 ; 3+3X = 1.25*CLKOUT/Baud BAUD_X equ .35 ; 11+3X = CLKOUT/Baud BAUD_Y equ .35 ; 9 +3X = CLKOUT/Baud endif ; ;************************ Data RAM Assignments ********************** ; ORG 0CH ; Dummy Origin for RAM ; ; Serial I/O variables RcvReg RES 1 ; Data received XmtReg RES 1 ; Data to be transmitted Count RES 1 ; Counter for #of Bits Transmitted DlyCnt RES 1 ; ; LCD I/O variables GP1 res 1 ; General purpose register STRNUM res 1 CHPT res 1 ; Character string pointer in string. LCDCH res 1 ; Saves byte to be sent to lcd while ; it is processed TABOFF res 1 ; Table ofset pointer in lcd string lookup apu res 1 ; anotger gp register ; ; Main program variables rcnt res 1 ;byte reject counter ts res 1 ;temp sign ; throtle res 1 ; #20 throtle pos ; ttemp res 1 ; #23 trans temp ; erpmhi res 1 ; #24 engine rpm hi erpmlo res 1 ; #25 lo ; irpmhi res 1 ; #26 input rpm hi irpmlo res 1 ; #27 lo ; trpmhi res 1 ; #28 turbine rpm hi trpmlo res 1 ; #29 lo ; ; also vechile speed ?? orpmhi res 1 ; #30 output rpm hi orpmlo res 1 ; #31 lo ; batt res 1 ; #38 battery voltage ; speed res 1 ; #30 ?? ; tsig res 1 ; #41 torque conv signal PSI ? ; gear res 1 ; #47 current gear tduty res 1 ; #48 TCC duty cycle ? ratio res 1 ; #50 gear ratio ? ; tsliphi res 1 ; #62 TCC slip rpm hi tsliplo res 1 ; #63 lo ; sfail res 1 ; #73 shift fail ? ; promhi res 1 ; #82 PROM ID hi promlo res 1 ; #83 lo ; bbit res 1 ; #84 bit 7 = brake applied bbit2 res 1 ; #85 bits 2 - 4 = gear selector ; 0 = ? selector bits decoded ; 1 = OD ; 2 = ? ; 3 = D ; 4 = R ; 5 = N/P ; 6 = 1 ; 7 = 2 ; press res 1 ; extra byte Winch hydraulic pressure ; barctr res 1 ; bar length counter = pressure / 8 ; ; B2_BCD Bin to BCD conversion variables ; count res 1 ; ! already defined temp res 1 ; H_byte res 1 ; 16-bit binary input L_byte res 1 ; R0 res 1 ; hi order R1 res 1 ; 5 digit BCD output R2 res 1 ; A4 res 1 ; hi orde value A3 res 1 ; 5 byte ASCII output A2 res 1 A1 res 1 A0 res 1 ; lo order value ; ; mult 8 * 8 multiply parameters mulcnd res 1 ; 8 bit multiplicand mulplr res 1 ; 8 bit multiplier ;H_byte res 1 ; High byte of the 16 bit result ;L_byte res 1 ; Low byte of the 16 bit result ; ;*********************************************************************** ; biglcd equ 0 ; size of lcd panel zsup equ 1 ; leading zero supress in 4 digit displays ; ; ORG 0 ; Restart vector goto main0 ; ORG 4 ; INT vector goto main0 ; main0 ; ;*********************************************************************** ; LCD (B) port setup & LCD INIT ; ; Outputs ; RA0 - 3 lcd data ; RA4 lcd register select ; RA5 lcd enable CLRF LCDPORT BSF STATUS,RP0 ; Select BANK 1 MOVLW b'00000000' ; Set port data directions MOVWF TRISB BCF STATUS,RP0 ; Select BANK 0 ;*********************************************************************** ; RS (A) port setup & init ; if Inv_Tx ; No glitch bcf porta, dx else bsf porta, dx endif clrf portb bsf status, rp0 ; select reg bank 1 bsf trisa, dr ; Bit DR (4) of Port A is Output pin # 3 bcf trisa, dx ; Set Port_A (3) as output ( DX ) pin # 2 bcf status, rp0 ; select bank 0 ; ;*********************************************************************** ; ; ;********************************************************************** ; call initlcd ;start LCD routines ; ; Display banner messages ; CALL LCDCLR ; Not really required here as display has ; just been set up! MOVLW .0 CALL CUR1 ; Position text on line 1 ; MOVLW .1 ; Hello message CALL STRING ; ROM at page 0X300. ; MOVLW .2 ; Version message CALL STRING ; BTFSC STATUS, NOT_TO ; Check if watchdog bite GOTO OK MOVLW .5 ; Show Fault message CALL STRING ; OK CLRWDT ; FEED WATCHDOG ; movlw .10 ;wait 1s call wait100 ; main1 CLRWDT ; FEED WATCHDOG ; main2 call rxbyte movlw 0xf5 ;wait for header bytes F5,AB subwf RcvReg, w bz main3 goto main2 ; main3 call rxbyte movlw 0xab ;wait for header bytes subwf RcvReg, w bz main4 ;match goto main2 ;Start reading data from TCM main4 movlw .20 movwf rcnt ;reject 20 bytes (#0-19) main5 call rxbyte decfsz rcnt, f goto main5 call rxbyte movf RcvReg, w ;get throtle byte #20 movwf throtle ; call rxbyte ; #21 call rxbyte ; #22 ; call rxbyte ;get temp byte #23 movf RcvReg, w movwf ttemp ; call rxbyte movf RcvReg, w ;get engine rpm hi byte #24 movwf erpmhi call rxbyte movf RcvReg, w ;get engine rpm lo byte #25 movwf erpmlo ; call rxbyte movf RcvReg, w ;get turbine rpm hi byte #26 movwf irpmhi call rxbyte movf RcvReg, w ;get turbine rpm lo byte #27 movwf irpmlo ; call rxbyte movf RcvReg, w ;get input rpm hi byte #28 movwf trpmhi call rxbyte movf RcvReg, w ;get input rpm lo byte #29 movwf trpmlo ; call rxbyte movf RcvReg, w ;get output rpm hi byte #30 movwf orpmhi movwf speed ;vechicle speed ? call rxbyte movf RcvReg, w ;get output rpm lo byte #31 movwf orpmlo ; movlw .06 movwf rcnt ;reject 6 bytes main6 call rxbyte decfsz rcnt, f goto main6 ; call rxbyte ;get battery voltage #38` movf RcvReg, w movwf batt ; call rxbyte ; #39 ; call rxbyte ;get vechicle speed #40 ?? movf RcvReg, w ; movwf speed ; ??? ; call rxbyte ;torque sig PSI #41 movf RcvReg, w movwf tsig ; movlw .05 movwf rcnt ;reject 5 bytes main7 call rxbyte decfsz rcnt, f goto main7 ; call rxbyte ;Current gear #47 movf RcvReg, w movwf gear ; call rxbyte ; #8 ; call rxbyte ;gear ratio #49 ? movf RcvReg, w movwf ratio ; movlw .05 movwf rcnt ;reject 5 bytes main8 call rxbyte decfsz rcnt, f goto main8 ; call rxbyte ;?? #55 movf RcvReg, w ; movwf gear ; movlw .6 movwf rcnt ;reject 6 bytes main9 call rxbyte decfsz rcnt, f goto main9 ; call rxbyte movf RcvReg, w ;get TCC slip value hi #62 movwf tsliphi call rxbyte movf RcvReg, w ;get TCC slip lo #63 movwf tsliplo ; movlw .9 movwf rcnt ;reject 9 bytes main91 call rxbyte decfsz rcnt, f goto main91 ; call rxbyte ;get shift fail ??? #73 movf RcvReg, w movwf sfail ; movlw .8 movwf rcnt ;reject 8 bytes main10 call rxbyte decfsz rcnt, f goto main10 ; call rxbyte movf RcvReg, w ;get PROM ID hi #82 movwf promhi call rxbyte movf RcvReg, w ;get PROM ID lo #83 movwf promlo ; call rxbyte ;get brake etc ?? bits #84 movf RcvReg, w movwf bbit ; call rxbyte ;get gear selector bits #85 movf RcvReg, w movwf bbit2 ; call rxbyte ; last byte should be #86 = checksum ; call rxbyte ;#87 extra byte #1 movf RcvReg, w movwf press ;Winch pressure ; andlw b'11111000' ; mask for division movwf barctr ;set bar display counter clrc rrf barctr, f ;divide by 8 rrf barctr, f rrf barctr, f ; ; ;************************************************************** ; CALL LCDCLR ; Clear first ;________________________________ CLRWDT ; FEED WATCHDOG ; First LCD line ; CALL LCDCLR ; Clear display MOVLW .0 CALL CUR1 ; Position text on line 1 ;___________ MOVLW .4 ; Winch Hydraulic pressure CALL STRING ; clrf h_byte movf press, w ; get pressure movwf l_byte ; call b2_bcd ; convert pressure to ASCII ; movf A2, w call putlcd movf A1, w call putlcd movf A0, w call putlcd ;_____________ MOVLW .3 ; RPM message CALL STRING ; movf erpmhi, w movwf h_byte movf erpmlo, w movwf l_byte ; call div8 ; first divide by 8 call b2_bcd ; convert rpm value to ASCII ; movf A3, w ; display it call putlcd movf A2, w call putlcd movf A1, w call putlcd movf A0, w call putlcd ; Second line ; Or visible part of second line ( 16 * 1 display) ; MOVLW .0 CALL CUR2 ; Position text on line 1 ; incf barctr, f ; adjust bar counter for loop ; bar1 decfsz barctr, f ; test how long goto bar2 goto bar3 ; stop drawing ; bar2 movlw 0x00 ; bar character call putlcd goto bar1 ; calculate how long bar ; bar3 goto main1 ;go to ask next frame ;*************************************************************** ; RXBYTE goto Talk ; ; User movlw BAUD_3 movwf DlyCnt redo_2 decfsz DlyCnt,Same goto redo_2 goto Talk ; Loop Until Start Bit Found ; Talk clrf RcvReg ; Clear all bits of RcvReg btfsc PortA,DR ; check for a Start Bit ; goto User ; delay for 104/2 uS call Delay4 ; delay for 104+104/4 ;*************************************************************** ; Receiver ; Rcvr IF R_Nbit movlw 8 ; 8 Data bits ELSE movlw 7 ; 7 data bits ENDIF ; movwf Count R_next bcf STATUS,CARRY IF R_MODE rrf RcvReg,Same ; to set if MSB first or LSB first ELSE rlf RcvReg,Same ENDIF btfsc PortA,DR ; IF R_MODE IF R_Nbit bsf RcvReg,MSB ; Conditional Assembly ELSE bsf RcvReg,MSB-1 ENDIF ELSE bsf RcvReg,LSB ENDIF ; call DelayY decfsz Count,Same goto R_next ; retlw 0 ; ;**************************************************** R_over movf RcvReg,0 ; Send back What is Just Received ; ; movwf XmtReg ;**************************************************** ; Transmitter ; Tx_w movwf xmtreg ;send byte from W ; TXBYTE ;send byte from xmtreg Xmtr IF X_Nbit movlw 8 ELSE movlw 7 ENDIF movwf Count ; IF X_MODE ELSE IF X_Nbit ELSE rlf XmtReg,Same ENDIF ENDIF ; if Inv_Tx ; Send Start bit bsf PortA,DX else bcf PortA,DX endif call Delay1 X_next bcf STATUS,CARRY ; IF X_MODE rrf XmtReg,Same ; Conditional Assembly ELSE ; to set if MSB first or LSB first rlf XmtReg,Same ENDIF ; btfsc STATUS,CARRY if Inv_Tx ; Send bit bcf PortA,DX else bsf PortA,DX endif btfss STATUS,CARRY if Inv_Tx bsf PortA,DX else bcf PortA,DX endif call DelayX decfsz Count,Same goto X_next if Inv_Tx ; Send Stop Bit bcf PortA,DX else bsf PortA,DX endif call Delay1 ; IF Sbit2 if Inv_Tx bcf PortA,DX else bsf PortA,DX endif call Delay1 ENDIF ; retlw 0 ; ; End of Transmission ; DelayY movlw BAUD_Y goto save DelayX movlw BAUD_X goto save Delay4 movlw BAUD_4 ;1.25 * baud goto save Delay1 movlw BAUD_1 ; 104 uS for 9600 baud goto save Delay2 movlw BAUD_2 ; save movwf DlyCnt redo_1 decfsz DlyCnt,Same goto redo_1 retlw 0 ; ;*********************************************************** ; ; LCD I/O routines ; ;****** ; CLKLCD clocks data/command to the lcd by making the EN line ; high then low. CLKLCD MACRO BSF LCDPORT,LCDEN ; Lcd enable LOW BCF LCDPORT,LCDEN ; Lcd enable HIGH ENDM ;****** ; TABSET sets up the lcd table offset pointer before string output ; starts TABSET MACRO MOVLW b'11111111' ; Offset is incremented on each call to ; table - first call must generate zero value ; offset. MOVWF TABOFF ENDM ;****** ; POINT increments the string pointer offset and adds it to the ; PLC ready for string lookup POINT MACRO INCF TABOFF MOVFW TABOFF ADDWF PCL ENDM ;****** ; POINT8 increments the string pointer offset and adds it to the ; PLC ready for string lookup. Sets PCLATH to 3 POINT8 MACRO MOVLW .3 ; Page 3xx MOVWF PCLATH INCF TABOFF MOVFW TABOFF ADDWF PCL ENDM ;****** ; POINT9 increments the string pointer offset and adds it to the ; PLC ready for string lookup. Sets PCLATH to 9 POINT9 MACRO MOVLW .3 MOVWF PCLATH INCF TABOFF MOVFW TABOFF ADDWF PCL ENDM ;****** ; PAGE0 selects rom page 0 PAGE0 MACRO BCF PCLATH,3 ; Select rom page 0 ENDM ;****** ; PAGE1 selects rom page 1 PAGE1 MACRO BSF PCLATH,3 ; Select rom page 1 ENDM ;-------------------------------------------------------------------------- ; Subroutines ;-------------------------------------------------------------------------- ;****** ; STRING sends the string with number in W register - to the lcd STRING MOVWF STRNUM TABSET ; Xero the offset PAGE1 CALL DOSTR ; Character from string PAGE0 ; Restore rom page RETURN ;****** ; BCDLCD sends the bcd character in W to lcd BCDLCD IORLW b'00110000' ; Convert to ascii ;****** ; PUTLCD sends the ASCII character in W to lcd PUTLCD MOVWF LCDCH PAGE1 CALL CHALCD ; Character to lcd PAGE0 ; Restore rom page RETURN ;****** ; CUR1 and CUR2 are indirect subroutine calls to LCDCUR1/2 ; Enter with character placement in W in range 0 - 15 CUR1 PAGE1 CALL LCDCUR1 ; Line 1 please PAGE0 RETURN CUR2 PAGE1 CALL LCDCUR2 ; Line 2 please PAGE0 RETURN CUR3 PAGE1 CALL LCDCUR3 PAGE0 RETURN ;****** ; LCDCLR is an indirect call to LCDCLR1 on page 1 LCDCLR PAGE1 CALL LCDCLR1 PAGE0 RETURN ;****** ; WAITGP waits for the number of ms in GP1 WAITGP MOVLW .74 ; 1ms DELAY CALL DL1 MOVLW .255 CALL DL1 DECF GP1 ; TOTAL DELAY N * 1 ms BNZ WAITGP ; Loop until delay is complete RETURN ; Exit from WAITGP ; wait100 movwf apu ; wait n * 100 ms W = delay wa101 MOVLW .100 MOVWF GP1 CALL WAITGP ; wait 100 ms decfsz apu goto wa101 return ;-------------------------------------------------------------------------- ; Setup ;-------------------------------------------------------------------------- ; INITLCD ;****** ; Reset the lcd INITA MOVLW .20 ; Delay for 20 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000011' ; Reset MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .6 ; Delay to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000011' ; Reset MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000011' ; Reset MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000010' ; 4 bit interface MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000010' ; 4 bit interface MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW b'00001000' ; 2 LINES, 5*7 MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000000' ; Display OFF MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW b'00001000' ; MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000000' ; Display clear MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW b'00000001' ; MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000000' ; Entry mode set MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW b'00000110' ; MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd MOVLW b'00000000' ; Display on MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW b'00001100' ; MOVWF LCDPORT ; Command to lcd port CLKLCD ; Clock the nibble to the lcd MOVLW .5 ; Delay for 5 ms to let lcd settle MOVWF GP1 CALL WAITGP ; Wait for lcd RETURN ; ;******************************************************************** ; Binary To BCD Conversion Routine ; The 16 bit binary number is input in locations H_byte and ; L_byte with the high byte in H_byte. ; The 5 digit BCD number is returned in R0, R1 and R2 with R0 ; containing the MSD in its right most nibble. ; B2_BCD bcf STATUS,0 ; clear the carry bit movlw .16 movwf count clrf R0 clrf R1 clrf R2 loop16 rlf L_byte, F rlf H_byte, F rlf R2, F rlf R1, F rlf R0, F ; decfsz count, F goto adjDEC goto bcdasc ; continue with ascii conv RETLW 0 ; adjDEC movlw R2 movwf FSR call adjBCD ; movlw R1 movwf FSR call adjBCD ; movlw R0 movwf FSR call adjBCD ; goto loop16 ; adjBCD movlw 3 addwf 0,W movwf temp btfsc temp,3 ; test if result > 7 movwf 0 movlw 30 addwf 0,W movwf temp btfsc temp,7 ; test if result > 7 movwf 0 ; save as MSD RETLW 0 ; ; continue with ASCII conversion bcdasc movf r2, w ; convert low order byte r0 movwf A1 andlw 0x0f addlw 0x30 ; low order nible = ASCII number movwf A0 swapf A1, w andlw 0x0f addlw 0x30 ; hi order nible = ASCII movwf A1 ; movf r1, w ; convert low order byte r1 movwf A3 andlw 0x0f addlw 0x30 ; low order nible = ASCII number movwf A2 swapf A3, w andlw 0x0f ; sets also Z-flag ; if zsup bz lzsup addlw 0x30 ; if non zero show number goto lz1 lzsup movlw 0x20 ; if zero replace with space lz1 movwf A3 else addlw 0x30 ; hi order nible = ASCII movwf A3 endif ; movf r0, w ; convert low order byte r2 andlw 0x0f addlw 0x30 ; hi order nible = ASCII movwf A4 ; save but dont care later ; RETLW 0 ; ;************************************************************** ; Divide H_byte & L_byte by 8 ; div8 movlw .3 ; 3 * shift right = div by 8 movwf temp div81 clrc rrf h_byte, f rrf l_byte, f decfsz temp, f goto div81 retlw 0 ; ;******************************************************************* ; 8x8 Software Multiplier ; ( Fast Version : Straight Line Code ) ;******************************************************************* ; ; The 16 bit result is stored in 2 bytes ; ; Before calling the subroutine " mpy ", the multiplier should ; be loaded in location " mulplr ", and the multiplicand in ; " mulcnd " . The 16 bit result is stored in locations ; H_byte & L_byte. ; ;**** Define a macro for adding & right shifting ** ; mult MACRO bit ; Begin macro btfsc mulplr,bit addwf H_byte,Same rrf H_byte,Same rrf L_byte,Same ENDM ; End of macro ; ; ***************************** Begin Multiplier Routine mpy_F clrf H_byte clrf L_byte movf mulcnd,w ; move the multiplicand to W reg. bcf STATUS,CARRY ; Clear the carry bit in the status Reg. mult 0 mult 1 mult 2 mult 3 mult 4 mult 5 mult 6 mult 7 ; retlw 0 ; ; ;-------------------------------------------------------------------------- ; 0x300 page of ROM ;-------------------------------------------------------------------------- ; Text strings and control subroutines must be stored on the correct ; page or this pcogram WILL NOT FUNCTION CORRECTLY. ; Only move code around if you are absoluteley clear as to what you ; are doing! ORG 0x300 ; Last page for messages LAST EQU b'10000000' ; Value to add to last character in a string ;****** ; DOSTR uses CALLSTR table to direct flow to the correct lookup table ; for lcd strings. Gets string characters and outputs to lcd DOSTR MOVLW .3 ; 3xx Page MOVWF PCLATH ; Keep the pageing ok MOVFW STRNUM ; Get the string number CALL CALLSTR MOVWF LCDCH CALL CHALCD ; Character to lcd BTFSS LCDCH,7 ; Test if end of string flagged - bit 7 set GOTO DOSTR ; Loop until all sent RETURN ;****** ; CALLSTR is the dispatch table for lcd string lookup ; CALLSTR ADDWF PCL NOP GOTO MSG1 ; 'Banner display' GOTO MSG2 ; 'version info' GOTO MSG3 ; 'Throttle ' GOTO MSG4 ; 'RPM ' GOTO MSG5 ; 'Fault ' GOTO MSG6 ; Tur Turbine GOTO MSG7 ; Tcs TCC slip GOTO MSG5 GOTO MSG5 GOTO MSG10 ; Gear selector messages GOTO MSG11 ; should be 10 - 17 GOTO MSG12 GOTO MSG13 GOTO MSG14 GOTO MSG15 GOTO MSG16 GOTO MSG17 GOTO MSG5 ;****** ; THE TEXT STRINGS! MSG1 POINT8 ; Use macro POINT8 when the string is in 0x200 ; address area RETLW 'J' RETLW 'N' RETLW ' ' RETLW 'W' RETLW 'i' RETLW 'n' RETLW 'c' RETLW 'h' RETLW ' '+LAST ; MSG2 POINT8 RETLW '1' RETLW '.' RETLW '0' RETLW ' '+LAST ; MSG3 POINT8 RETLW ' ' RETLW 'R' RETLW 'P' RETLW 'M' RETLW ' '+LAST ; MSG4 POINT8 RETLW 'B' RETLW 'a' RETLW 'r' RETLW ' '+LAST ; MSG5 POINT8 RETLW 'F' RETLW 'L' RETLW 'T' RETLW ' '+LAST ; MSG6 POINT8 RETLW 'T' RETLW 'r'+LAST ; MSG7 POINT8 RETLW ' ' RETLW 'R' RETLW 'p' RETLW '2'+LAST ; ; ; gear selector messages 10 - 17 ; should be in these positions MSG10 POINT8 RETLW '?' RETLW ' ' + LAST MSG11 POINT8 RETLW 'O' RETLW 'D' + LAST MSG12 POINT8 RETLW '?' RETLW ' ' + LAST MSG13 POINT8 RETLW 'D' RETLW ' ' + LAST MSG14 POINT8 RETLW 'R' RETLW ' ' + LAST MSG15 POINT8 RETLW 'N' RETLW 'P' + LAST MSG16 POINT8 RETLW '1' RETLW ' ' + LAST MSG17 POINT8 RETLW '2' RETLW ' ' + LAST ; ;-------------------------------------------------------------------------- ; Subroutines to handle the lcd ;-------------------------------------------------------------------------- ; CHALCD writes the character in W register to the lcd. ; On entry, the display character is in LCDCH. CHALCD ; Get the upper nibble and load to the lcd port SWAPF LCDCH,W ; Get the ms nibble to ls position ANDLW 07H ; Strip to ms nibble in ls position, ; and mask top bit in case this is the lset ; character in a string MOVWF LCDPORT ; Data to lcd port BSF LCDPORT,LCDRS ; Select lcd data ; Clock the ms nibble to the lcd CLKLCD ; Get the lower nibble and load to the lcd port MOVFW LCDCH ; Get back the character ANDLW 0FH ; Strip to ms nibble in ls position MOVWF LCDPORT ; Data to lcd port BSF LCDPORT,LCDRS ; Select lcd data ; Clock the ls nibble to the lcd. CLKLCD BCF LCDPORT,LCDRS GOTO LCD64 ; Delay then exit from CHALCD ;***** ; COMLCD writes the command in W register to the lcd ; On entry, the command character is in LCDCH. COMLCD ; Get the upper nibble and load to the lcd port SWAPF LCDCH,W ; Get the ms nibble to ls position ANDLW 0FH ; Strip to ms nibble in ls position MOVWF LCDPORT ; Command to lcd port ; Clock the ms nibble to the lcd CLKLCD ; Get the lower nibble and load to the lcd port MOVFW LCDCH ; Get back the character ANDLW 0FH ; Strip to ms nibble in ls position MOVWF LCDPORT ; Command to lcd port ; Clock the ls nibble to the lcd. CLKLCD GOTO LCD2 ; Delay then exit from COMLCD ;****** ; LCDCL1R clears the display and resets the cursor LCDCLR1 MOVLW LCDCLER ; LCD clear command MOVWF LCDCH GOTO COMLCD ;****** ; LCDCUR1 sets cursor to position on line 1 using value in W register LCDCUR1 IORLW LCDCM ; Cursor move command MOVWF LCDCH GOTO COMLCD ;****** ; LCDCUR2 sets cursor to position on line 2 using value in W register LCDCUR2 IORLW LCDCM ; Cursor move command MOVWF LCDCH BSF LCDCH,6 ; This bit set for line 2 GOTO COMLCD ;****** ; LCDCUR3 MOVLW .20 ; CURSOR POSITION ABSOLUTE 20 IORLW LCDCM MOVWF LCDCH GOTO COMLCD ;****** ; LCD64/2 gives a delay of 64us or 1.6ms while the lcd accepts the ; data or command. LCD64 MOVLW .22 ; Gives 65 us delay GOTO DL1 ; LCD2 MOVLW .65 ; Gives 1.6ms delay CALL DL1 MOVLW .255 CALL DL1 MOVLW .255 GOTO DL1 ; DL1 MOVWF DLYCNT DL11 DECF DLYCNT, F BTFSS STATUS, Z GOTO DL11 RETLW .0 ; Exit from CHA/COMLCD routines ; END