; ------ DS1990A program simulator ------ ; ------ Processor AT89C2051 24PC ------ ; ------ Clock 12 MHZ ------ ;#DEFINE DEBUG #INCLUDE "LIBREG.ASM" ;8051 SFR set ;Macros: #DEFINE LO(XXX) XXX & 0FFH #DEFINE HI(XXX) (XXX >> 8) & 0FFH CLK_KHZ = 12000 ;OSC frequency, KHZ RTC_MS = 2 ;System clock (display refresh), MS RTCV = -((CLK_KHZ*RTC_MS)/12) BAUD_RATE = 4800 ;Serial port baud rate, baud BAUD = (2565-((CLK_KHZ*10000)/(12*16*BAUD_RATE)))/10 #IFDEF DEBUG #INCLUDE "LIBDEF.ASM" #ENDIF ; ------ Constantes ------ STACK .EQU 050H ;stack location SMOD .EQU 080H ;serial port double baud rate I2C_ADDR .EQU 0A0H ;I2C address R_DEL .EQU 10000H-300 ;reset delay (300uS min) KEY_UP .EQU 002H ;key UP code KEY_DN .EQU 001H ;key DOWN code DBDEL .EQU 250 ;debounce delay (in main cycles) KEYD1 .EQU 250 ;key autorepeat delay (x2mS) KEYD2 .EQU 100 ;key autorepeat rate (x2mS) TMATMV .EQU 100 ;TM access delay time (x2mS) AENTMV .EQU 10 ;TM access enable delay (x2mS) MIN_NUM .EQU 1 ;min TM number MAX_NUM .EQU 30 ;max TM number ; ------ Debugger variables ------ #IFDEF DEBUG DBGVA .EQU STACK-1 ;debugger variable address in internal memory DBGVV .EQU STACK ;debugger variable value in internal memory DBGA .EQU 0FFFFH ;debugger address in external memory #ENDIF ; ------ Bit Addressing Memory ------ RXF .EQU M_20H.0 ;RX flag PRESS .EQU M_20H.1 ;keyboard press bit UPD .EQU M_20H.2 ;NUM update flag TXRDY .EQU M_20H.3 ;TX ready flag CD0 .EQU 021H ;display digit 1 (segments copy) CD1 .EQU 022H ;display digit 2 (segments copy) PHASE .EQU 023H ;indication phase NUM .EQU 024H ;current number INCODE .EQU 025H ;key code DEBNC .EQU 026H ;debounce counter KEYCD .EQU 027H ;debounce procedure key code KEYTM .EQU 028H ;key timer TMATM .EQU 029H ;touch memory access timer AENTM .EQU 02AH ;TM access enable timer TEMP .EQU 02BH ;CRC temporary value ; ------ Internal Memory ------ BUFF .EQU 030H ;buffer and command CHAN .EQU 031H ;NUM value FAM_CODE .EQU 032H ;DS1990 family code (01H) SER_NUM1 .EQU 033H ;DS1990 serial number, byte 1 SER_NUM2 .EQU 034H ;DS1990 serial number, byte 2 SER_NUM3 .EQU 035H ;DS1990 serial number, byte 3 SER_NUM4 .EQU 036H ;DS1990 serial number, byte 4 SER_NUM5 .EQU 037H ;DS1990 serial number, byte 5 SER_NUM6 .EQU 038H ;DS1990 serial number, byte 6 CRC_BYTE .EQU 039H ;DS1990 CRC byte TEMP1 .EQU 03AH ;temporary byte 1 TEMP2 .EQU 03BH ;temporary byte 2 TEMP3 .EQU 03CH ;temporary byte 3 TEMP4 .EQU 03DH ;temporary byte 4 TEMP5 .EQU 03EH ;temporary byte 5 TEMP6 .EQU 03FH ;temporary byte 6 TEMP7 .EQU 040H ;temporary byte 7 TEMP8 .EQU 041H ;temporary byte 8 ; ------ Ports Set ------ DATA .EQU INT0 ;serial port data line KEY_GO .EQU INT1 ;key GO line DDATA .EQU P1 ;display data port SCAN0 .EQU T1 ;display scan line 0 SCAN1 .EQU T0 ;display scan line 1 SDA .EQU SCAN1 ;I2C SDA line SCL .EQU SCAN0 ;I2C SCL line RETL .EQU P1.7 ;keyboard return line ; ------ Vectors Area ------ .ORG 0000H ;reset vector AJMP INIT ;program init .ORG 000BH ;INT TIMER 0 vector AJMP INDSCAN .ORG 0013H ;INT1 vector AJMP GOKEY .ORG 001BH ;INT TIMER 1 vector AJMP TIMER ;jump to the timer int. holder .ORG 0023H ;INT serial port vector AJMP SER ;serial port RX/TX ; ------ Main Program ------ INIT: MOV SP,#STACK ;stack init #IFDEF DEBUG DEBUGINIT ;debug init #ENDIF CLR A MOV PHASE,A ;indicaton phase clear MOV INCODE,A ;clear INCODE MOV KEYTM,A ;key timer clear MOV TMATM,A ;touch memory access timer clear MOV AENTM,A ;touch memory access delay timer clear MOV BUFF,A ;command clear CPL A MOV CD0,A ;segments copy clear MOV CD1,A CLR PRESS ;clear keyboard press bit MOV NUM,#MIN_NUM ;current number clear CLR UPD SETB TXRDY CLR TR0 ;timer 0 stop CLR TR1 ;timer 1 stop MOV SCON,#11010000B ;serial port init for mode 3, REN MOV TMOD,#00100001B ;timer 1 init for auto-reload mode ORL PCON,#SMOD ;set double baud rate MOV TH1,#BAUD ;timer 1 reload register load MOV TL1,#BAUD ;timer 1 load SETB TR1 ;timer 1 start MOV TL0,#LO(RTCV) ;timer 0 load MOV TH0,#HI(RTCV) SETB TR0 ;timer 0 start SETB PT0 ;timer 0 int high priority SETB ET0 ;timer 0 int enable SETB PT1 ;timer 1 int high priority SETB PX0 ;high INT0 priority SETB IT0 ;fall INT0 activating CLR PX1 ;low INT1 priority SETB IT1 ;fall INT1 activating CLR PS ;low serial port interrupt priority SETB ES ;serial port interrupt enable SETB EA MOV R0,#0 ;page 0 ACALL NVM_READ ;read NUM MOV NUM,FAM_CODE ACALL VAL_NUM ;validate NUM MOV R0,A ;load page number ACALL NVM_READ ;read page ;Main loop: MAIN: MOV A,INCODE ;local keyboard test JNZ MA10 ;jump if press CLR PRESS ;clear press flag MA12: MOV DEBNC,#0H ;debounce counter clear SJMP MA20 ;jump if no press MA10: MOV B,A ;save keyboard code MOV A,DEBNC ;debounce counter check JNZ MA11 ;jump if debounce procedure in progress MOV DEBNC,#DBDEL ;debounce procedure init, counter load MOV KEYCD,B ;key code save SJMP MA20 MA11: DEC DEBNC ;counter dec MOV A,KEYCD CJNE A,B,MA12 ;reset procedure if codes are differ MOV A,DEBNC ;new counter value check JNZ MA20 MOV R7,B ;procedure complete, get code ;Control Functions Analysis and Processing CJNE R7,#KEY_UP,$+5H ;KEY UP ACALL UP CJNE R7,#KEY_DN,$+5H ;KEY DOWN ACALL DN SETB PRESS ;set PRESS ;End of Control Functions Analysis MA20: MOV A,AENTM JNZ MA30 MOV AENTM,#AENTMV ACALL ACCESS90 ;touch memory read (and check code if PROG = 0) JNC MA30 ;jump if no touch or invalid code ACALL COPY #IFDEF DEBUG PRINT(FAM_CODE) PRINT(SER_NUM1) PRINT(SER_NUM2) PRINT(SER_NUM3) PRINT(SER_NUM4) PRINT(SER_NUM5) PRINT(SER_NUM6) PRINT(CRC_BYTE) #ENDIF MOV R0,NUM ;page number load ACALL NVM_SAVE MOV R1,#CH_P MOV R2,#CH_r ACALL IND ;indicate "Pr" ACALL DEL2000 ;delay 2 sec. MOV TMATM,#TMATMV ;disable repeat to read MA30: JB KEY_GO,MA40 ;key GO check ACALL DELAY JB KEY_GO,MA40 ;key GO check one more time AJMP SIM ;jump to simulate touch memory MA40: MOV R7,BUFF CJNE R7,#01H,MA41 ACALL SET_CH MA41: CJNE R7,#02H,MA50 ACALL SAV_CH MA50: ACALL DISPLAY ;CD0,CD1 load AJMP MAIN ;Return point from simulation mode: EDIT: CLR EX1 ;GO key interrupt disable CLR ET0 ;timer 0 interrupt disable CLR ET1 ;timer 1 interrupt disable CLR TR0 ;timer 0 stop CLR TR1 ;timer 1 stop MOV TMOD,#00100001B ;timer 1 init for auto-reload mode MOV TH1,#BAUD ;timer 1 reload register load MOV TL1,#BAUD ;timer 1 load SETB TR1 ;timer 1 start MOV TL0,#LO(RTCV) ;timer 0 load MOV TH0,#HI(RTCV) SETB TR0 ;timer 0 start SETB ET0 ;timer 0 interrupt enable SETB ES ;serial port interrupt enable RELS: JNB KEY_GO,$ ;key GO check ACALL DELAY JNB KEY_GO,RELS ;key GO check one more time AJMP MAIN ; ------ Subroutines Area ------ ;Up key processing: UP: JB PRESS,UPH MOV KEYTM,#KEYD1 SJMP UP_DO UPH: MOV A,KEYTM JNZ UP_RET MOV KEYTM,#KEYD2 UP_DO: MOV A,NUM XRL A,#MAX_NUM JZ UP_RET INC NUM MOV R0,NUM ACALL NVM_READ SETB UPD UP_RET: RET ;Down key processing: DN: JB PRESS,DNH MOV KEYTM,#KEYD1 SJMP DN_DO DNH: MOV A,KEYTM JNZ DN_RET MOV KEYTM,#KEYD2 DN_DO: MOV A,NUM XRL A,#MIN_NUM JZ DN_RET DEC NUM MOV R0,NUM ACALL NVM_READ SETB UPD DN_RET: RET ;RS-232C command "Set CH": SET_CH: MOV NUM,CHAN ACALL VAL_NUM MOV R0,NUM ACALL NVM_READ MOV BUFF,#0 MOV SBUF,R7 RET ;RS-232C command "Save CH": SAV_CH: MOV R0,NUM ACALL NVM_SAVE MOV BUFF,#0 MOV SBUF,R7 RET ;Validate NUM: VAL_NUM: MOV A,NUM CJNE A,#MIN_NUM,NV1 NV1: JNC NV2 MOV A,#MIN_NUM NV2: CJNE A,#MAX_NUM,NV3 NV3: JC NV4 MOV A,#MAX_NUM NV4: MOV NUM,A RET ;Calculate CRC of FAM_CODE, SER_NUM1 .. SER_NUM6 ;Out: CRC_BYTE = CRC GET_CRC: MOV R0,#FAM_CODE ;pointer init MOV R1,#7 ;number of bytes MOV TEMP,#0 ;CRC init CRCLOOP: MOV A,@R0 ;calculate CRC for FAM_CODE .. SER_NUM6 LCALL DOW_CRC INC R0 DJNZ R1,CRCLOOP MOV @R0,TEMP ;save CRC in CRC_BYTE RET ;Copy 8 bytes ;from TEMP1 .. TEMP8 ;to FAM_CODE, SER_NUM1 .. SER_NUM6 COPY: MOV R0,#TEMP1 ;source pointer MOV R1,#FAM_CODE ;destination pointer MOV R2,#8 ;bytes number DO_COPY: MOV A,@R0 MOV @R1,A INC R0 INC R1 DJNZ R2,DO_COPY RET ; Accesses to DALLAS DS1990A touch memory. ; Returns C=1 in case of success, else C=0. ; Touch memory port line called as DATA. ; Calls TRESET, TOUCHBY. ; Out: TEMP1 .. TEMP8 ACCESS90: MOV R0,#TEMP1 CLR C ;Assume failure. ACALL TRESET ;Issue reset pulse. JNC ACSRET ;Leave if no parts on bus. CLR C MOV A,TMATM JNZ N90 MOV A,#33H ;Get read rom command in ACC. ACALL TOUCHBY ;Send command byte. MOV B,#8 ;Prepare to read 8 bytes. MOV TEMP,#0 ;Initialize CRC variable. READMORE: MOV A,#0FFH ;Prepare to read a byte. ACALL TOUCHBY ;Read byte. MOV @R0,A ;Save byte. INC R0 ACALL DOW_CRC ;Calculate cummulative CRC. DJNZ B,READMORE ;Repeat until finished. MOV A,TEMP ;Get CRC value in ACC. JZ SUCCESS ;Jump if successful. CLR C ;Indicate failure. SJMP ACSRET SUCCESS: ACALL CHECK0 JNC ACSRET ;Invalid code N90: MOV TMATM,#TMATMV ACSRET: RET ;Return to caller. ; This procedure checks all bytes in temporary ; buffer and returns C=0 if all bytes = 0 CHECK0: MOV R0,#TEMP1 ;Pointer load. MOV B,#8 ;Prepare to check 8 bytes. CLR A CHMORE: ORL A,@R0 INC R0 DJNZ B,CHMORE JZ FAILURE ;Fail if all data bytes and CRC = 0 SETB C RET FAILURE: CLR C ;Indicate failure. RET ;Return to caller. ; This procedure transmits the Reset signal to the 1-Wire ; device and watches for a presence pulse. On return, ; the Carry bit is set if a presence pulse was detected, ; otherwise the Carry is cleared. The code is timed for ; a 12 MHz crystal. TRESET: CLR DATA ;Start the reset pulse. MOV B,#240 ; 2. Set time interval. DJNZ B,$ ;480. Wait with Data low. SETB DATA ; 1. Release Data line. MOV B,#120 ; 2. High wait delay. CLR C ; 1. Clear presence flag. WAITL1: JB DATA,WH1 ;Exit loop if line high. DJNZ B,WAITL1 ;Hang around if line is low. SJMP SHORT1 ;Line could not go high. WH1: MOV B,#120 ;Delay for presence detect. HL1: ORL C,/DATA ;240. Catch presence pulse. DJNZ B,HL1 ;240. Wait with Data high. SHORT1: RET ;Return. ; This procedure sends the byte in the accumulator ; to the 1-Wire device, and returns a byte from the ; 1-Wire device in the accumulator. For reading ; operation set accumulator to 0FFH. The code is ; timed for a 12 MHz crystal. TOUCHBY: PUSH B ;Save B register. MOV B,#8 ;Setup for 8 bits. B_LOOP1: RRC A ;1. Get bit in carry. LCALL TOUCHB1 ;2. Send bit. DJNZ B,B_LOOP1 ;2. Get next bit. RRC A ; Get final bit in ACC. POP B ;Restore B register. RET ;Return to caller. TOUCHB1: CLR EA CLR DATA ; 1. Start the time slot. NOP ; 1. Delay to make sure NOP ; 1. that the Touch Memory NOP ; 1. sees a low for at NOP ; 1. least 1 microsecond. MOV DATA,C ; 2. Send out the data bit. NOP ; 1. Delay to give the NOP ; 1. data returned from NOP ; 1. the Touch Memory NOP ; 1. time to settle NOP ; 1. before reading NOP ; 1. the bit. NOP ; 1. MOV C,DATA ; 1. Sample input data bit. SETB EA PUSH B ; 2. Save B register. MOV B,#20 ; 2. Delay until the end DJNZ B,$ ;40. of the time slot. POP B ; 2. Restore B register. SETB DATA ;Terminate time slot. RET ;Return to caller. ; The assembly language procedure DOW_CRC given below ; calculates the cumulative CRC of all the bytes passed ; to it in the accumulator. Before it is used to calculate ; the CRC of a data stream, it should be initialized by ; setting the variable TEMP to zero. Each byte of the data ; is then placed in the accumulator and DOW_CRC is called ; to update the CRC. After all the data has been passed ; to DOW_CRC, the variable TEMP will contain the result. DOW_CRC: PUSH ACC ;Save the Accumulator. PUSH B ;Save the B register. PUSH ACC ;Save bits to be shifted. MOV B,#8 ;Set to shift eight bits. CRC_LOOP: XRL A,TEMP ;Calculate DQIN xor CRCT0. RRC A ;Move it to the carry. MOV A,TEMP ;Get the last CRC value. JNC ZERO ;Skip if DQIN xor CRCT0 = 0. XRL A,#18H ;Update the CRC value. ZERO: RRC A ;Position the new CRC. MOV TEMP,A ;Store the new CRC. POP ACC ;Get the remaining bits. RR A ;Position next bit in LSB. PUSH ACC ;Save the remaining bits. DJNZ B,CRC_LOOP ;Repeat for eight bits. POP ACC ;Clean up the stack. POP B ;Restore the B register. POP ACC ;Restore the Accumulator. RET ;Return. ; I2C NVM memory 24C04 support ; I2C - bus supported subroutines: ; ; I2C_WR - Write byte from A via I2C bus, uses R0 ; I2C_RD - Read byte to A via I2C bus ; I2C_LRD - Read last byte to A via I2C bus (no ASK) ; I2C_STOP - Stop condition generation on I2C bus ;Write byte from A to I2C I2C_WR: PUSH B MOV B,#9H ;bit counter load SETB C ;set bit C for bit9=1 (when ACK) LCALL SDA0 ;SDA 1/0 - start I2CWR1: LCALL SCL0 ;SCL 1/0 RLC A JC OUTP1 ;jump if bit=1 LCALL SDA0 ;SDA=0 if bit=0 SJMP OUTP0 OUTP1: LCALL SDA1 ;SDA=1 if bit=1 OUTP0: LCALL SCL1 ;SCL 0/1 DJNZ B,I2CWR1 POP B RET ;Read byte from I2C to A I2C_RD: MOV A,#1H ;A init for 8 bit I2CRD1: LCALL SCL0 ;SCL 1/0 LCALL SDA1 ;SDA=1 - it makes SDA line free LCALL SCL1 ;SCL 0/1 MOV C,SDA ;bit from SDA to C RLC A ;bit from C to A JNC I2CRD1 LCALL SCL0 ;SCL 1/0 LCALL SDA0 ;SDA=0 - ACK LCALL SCL1 ;SCL 0/1 RET ;Read byte from I2C to A and no ACK (read last byte) I2C_LRD: MOV A,#1H I2CLRD1: LCALL SCL0 LCALL SDA1 LCALL SCL1 MOV C,SDA RLC A JNC I2CLRD1 LCALL SCL0 LCALL SCL1 ;SCL 0/1 when SDA=1 - no ACK RET ;Stop condition generation I2C_STOP: LCALL SCL0 LCALL SDA0 LCALL SCL1 LCALL SDA1 RET ;SDA and SCL lines drive SDA0: CLR SDA ;SDA 1/0 NOP ;delay RET SDA1: SETB SDA ;SDA 0/1 NOP ;delay RET SCL0: CLR SCL ;SCL 1/0 NOP ;delay RET SCL1: SETB SCL ;SCL 0/1 NOP ;delay RET ;Read page from NVM: ;Input: R0 - page number 0..31 (1 page = 8 bytes) ;Out: FAM_CODE, SER_NUM1 .. SER_NUM6, CRC_BYTE NVM_READ: CLR TR0 CLR ET0 MOV DDATA,#0FFH SETB SCL SETB SDA MOV A,#I2C_ADDR ;I2C device address and write mode ACALL I2C_WR ;transmission MOV A,R0 ;subaddress = R0 x 8 RL A RL A RL A ACALL I2C_WR ;transmission ACALL I2C_STOP MOV R1,#FAM_CODE ;pointer load MOV R2,#8 ;bytes count MOV A,#I2C_ADDR+1 ;I2C device address and read mode ACALL I2C_WR ;transmission RD_NEXT: ACALL I2C_RD ;receive byte MOV @R1,A ;save byte INC R1 ;next address DJNZ R2,RD_NEXT ACALL I2C_LRD ;terminate read ACALL I2C_STOP SETB ET0 SETB TR0 RET ;Save page to NVM: ;Input: R0 - page number 0..31 (1 page = 8 bytes) ;Out: FAM_CODE, SER_NUM1 .. SER_NUM6, CRC_BYTE NVM_SAVE: CLR TR0 CLR ET0 MOV DDATA,#0FFH SETB SCL SETB SDA MOV A,#I2C_ADDR ;I2C device address and write mode ACALL I2C_WR ;transmission MOV A,R0 ;subaddress = R0 x 8 RL A RL A RL A ACALL I2C_WR ;transmission MOV R1,#FAM_CODE ;pointer load MOV R2,#8 ;bytes count SV_NEXT: MOV A,@R1 ACALL I2C_WR ;transmission INC R1 ;next address DJNZ R2,SV_NEXT ACALL I2C_STOP ACALL DELAY SETB ET0 SETB TR0 RET ;Delay 2 sec. DEL2000: MOV B,#100 D2L: ACALL DELAY DJNZ B,D2L RET ;Delay 20mS DELAY: PUSH ACC PUSH B MOV A,#40 DEL05: MOV B,#CLK_KHZ/48 DJNZ B,$ DJNZ ACC,DEL05 POP B POP ACC RET ;Display DISPLAY: MOV A,NUM MOV B,#10 DIV AB JNZ NOT_Z MOV A,#BLANK NOT_Z: MOV R1,A MOV R2,B IND: MOV DPTR,#FONT0 MOV A,R1 MOVC A,@A+DPTR MOV CD0,A MOV DPTR,#FONT1 MOV A,R2 MOVC A,@A+DPTR MOV CD1,A RET ; ------ Touch Memory Simulation Part ------ ; If RX code is 33H or 0FH then TX byffer. ; The code is timed for a 12 MHz crystal. SIM: CLR ES ;serial port interrupt disable JNB UPD,IOFF PUSH FAM_CODE MOV FAM_CODE,NUM MOV R0,#0 ACALL NVM_SAVE ;NUM save POP FAM_CODE CLR UPD IOFF: CLR TR0 CLR TR1 CLR ET0 ;timer 0 interrupt disable MOV TMOD,#00010001B ;timer 0 and 1 init SETB SCAN0 ;indication off SETB SCAN1 MOV A,#CH_P MOV DPTR,#FONT1 MOVC A,@A+DPTR MOV DDATA,A ;display "P" CLR SCAN1 RELSM: JNB KEY_GO,$ ;key GO check ACALL DELAY JNB KEY_GO,RELSM ;key GO check one more time CLR IE1 ;INT1 flag clear SETB EX1 ;GO key interrupt enable SETB ET1 ;timer 1 interrupt enable TERM: CLR TR1 ;timer 1 stop JB DATA,$ MOV TH1,#HI(R_DEL) MOV TL1,#LO(R_DEL) SETB TR1 WAIT: JNB DATA,$ SJMP TERM RES: JNB DATA,$ MOV R3,#14 DJNZ R3,$ ;delay 30 uS CLR DATA ;presence pulse begin MOV R3,#58 DJNZ R3,$ ;delay 120 uS SETB DATA ;presence pulse end MOV R0,#FAM_CODE-1 ;pointer load MOV R1,#9 ;load number of bytes (1 RX + 8 TX) MOV R2,#8 ;load number of bits SETB RXF ;set RX flag MOV A,#0FFH ;perform RX RRC A ;C <- first TX bit CLR IE0 ;clear interrupt flag ;1-Wire RX-TX Loop: LOOPH: JNB IE0,$ ;wait for interrupt flag MOV DATA,C ;DATA <- C MOV TH1,#HI(R_DEL) MOV TL1,#LO(R_DEL) SETB TR1 ;start timer 1 (reset timeout) MOV R3,#9 DJNZ R3,$ ;delay MOV C,DATA ;receive data bit SETB DATA ;DATA <- 1 (30uS is over) RRC A ;save received bit in ACC CLR IE0 ;clear interrupt flag DJNZ R2,LOOP ;advance bit counter JNB RXF,NEXT ;jump if TX cycle CLR RXF CJNE A,#033H,MISM ;RX complete, check command code SJMP NEXT MISM: CJNE A,#00FH,TERM NEXT: INC R0 ;advance pointer MOV R2,#8 ;bits counter reload MOV A,@R0 RRC A DJNZ R1,LOOP SJMP TERM LOOP: JNB DATA,$ ;wait for DATA = 1 CLR TR1 SJMP LOOPH ;TIMER 1 Interrupt Holder: ;Timer terminates process if reset pulse detected TIMER: CLR TR1 ;timer 1 stop MOV SP,#STACK MOV A,#LO(RES) PUSH ACC MOV A,#HI(RES) PUSH ACC RETI ;return to RES ;INT1 Interrupt Holder: ;GO key terminates process GOKEY: MOV SP,#STACK MOV A,#LO(EDIT) PUSH ACC MOV A,#HI(EDIT) PUSH ACC RETI ;return to EDIT ;Serial Port Interrupt: ;RB8=1, D7=1, D6=1 : restart ;RB8=1, D7=0, D6=0 : address store address -> R0 ;RB8=1, D7=1, D6=0 : read data address -> R0, MOV @R0+BUFF -> data ;RB8=0 : write data data -> MOV @R0+BUFF SER: PUSH PSW SETB RS0 ;register bank 1 select CLR RS1 MOV R5,A ;ACC store JBC RI,RXISR ;go to RXISR if receiver flag is set CLR TI ;clear transmitter flag SJMP INRET ;return to the main program RXISR: MOV A,SBUF ;read serial buffer JB RB8,RXADDR ;go to store address if RB8=1 PUSH ACC MOV A,R0 ANL A,#0FH ADD A,#BUFF MOV R1,A POP ACC MOV @R1,A ;data write SJMP INRET ;return to the main program RXADDR: MOV R0,A ;address store JBC ACC.6,RXRST ;if RB8=1 and D6 =1 then restart JBC ACC.7,RXRD ;if RB8=1 and D7 =1 then read mode SJMP INRET ;return to the main program RXRD: MOV A,R0 ANL A,#0FH ADD A,#BUFF MOV R1,A MOV A,@R1 ;read data MOV SBUF,A ;load transmitter buffer SJMP INRET ;return to the main program RXRST: CLR EA ;do restart: disable all interrupts POP PSW CLR A PUSH ACC PUSH ACC RETI ;go to INIT: INRET: MOV A,R5 POP PSW RETI ;TIMER 0 Interrupt Holder: ;Indicators Scanning (2mS) INDSCAN: PUSH ACC PUSH PSW MOV A,KEYTM JZ TIM1 DEC KEYTM TIM1: MOV A,AENTM JZ TIM2 DEC AENTM TIM2: MOV A,TMATM JZ TIM3 DEC TMATM TIM3: MOV A,PHASE ;indication phase check JNZ PH1 PH0: SETB SCAN1 ;PHASE 0: indication off MOV INCODE,#0FFH ;init scan code MOV A,#0FEH ;init keyboard scan value SCAN: MOV DDATA,A ;scan keyboard SETB RETL MOV C,RETL XCH A,INCODE RRC A XCH A,INCODE RLC A JC SCAN XRL INCODE,#0FFH ;inverting INCODE MOV DDATA,CD0 ;load digit 0 segments copy CLR SCAN0 ;turn on scan line 0 SJMP EOPH PH1: SETB SCAN0 ;PHASE 3: indication off MOV DDATA,CD1 ;load digit 2 segments copy CLR SCAN1 ;turn on scan line 2 MOV PHASE,#0FFH ;perform new scan cycle EOPH: CLR TR0 ;timer 1 stop MOV TL0,#LO(RTCV) ;timer 1 load (2mS) MOV TH0,#HI(RTCV) SETB TR0 ;timer 1 start INC PHASE POP PSW POP ACC RETI ;Font table 1 ; SCDEFGAB FONT0 .DB 10000100B ;code 00H, character 0 .DB 10111110B ;code 01H, character 1 .DB 11001000B ;code 02H, character 2 .DB 10011000B ;code 03H, character 3 .DB 10110010B ;code 04H, character 4 .DB 10010001B ;code 05H, character 5 .DB 10000001B ;code 06H, character 6 .DB 10111100B ;code 07H, character 7 .DB 10000000B ;code 08H, character 8 .DB 10010000B ;code 09H, character 9 .DB 10100000B ;code 0AH, character A .DB 10000011B ;code 0BH, character b .DB 11000101B ;code 0CH, character C .DB 10001010B ;code 0DH, character d .DB 11000001B ;code 0EH, character E .DB 11100001B ;code 0FH, character F .DB 11001011B ;code 10H, character c .DB 10000101B ;code 11H, character G .DB 10100010B ;code 12H, character H .DB 10111110B ;code 13H, character I .DB 11000111B ;code 14H, character L .DB 11001111B ;code 15H, character l .DB 10101011B ;code 16H, character n .DB 10001011B ;code 17H, character o .DB 11100000B ;code 18H, character P .DB 11100101B ;code 19H, character R .DB 11101011B ;code 1AH, character r .DB 11000011B ;code 1BH, character t .DB 10000110B ;code 1CH, character U .DB 10001111B ;code 1DH, character u .DB 10010010B ;code 1EH, character Y .DB 11110000B ;code 1FH, character degree .DB 11111101B ;code 20H, character ~ .DB 11111011B ;code 21H, character - .DB 11011111B ;code 22H, character _ .DB 11111111B ;code 23H, character blank ;Font table 2 ; SEDGCBAF FONT1 .DB 10010000B ;code 00H, character 0 .DB 11110011B ;code 01H, character 1 .DB 10001001B ;code 02H, character 2 .DB 11000001B ;code 03H, character 3 .DB 11100010B ;code 04H, character 4 .DB 11000100B ;code 05H, character 5 .DB 10000100B ;code 06H, character 6 .DB 11110001B ;code 07H, character 7 .DB 10000000B ;code 08H, character 8 .DB 11000000B ;code 09H, character 9 .DB 10100000B ;code 0AH, character A .DB 10000110B ;code 0BH, character b .DB 10011100B ;code 0CH, character C .DB 10000011B ;code 0DH, character d .DB 10001100B ;code 0EH, character E .DB 10101100B ;code 0FH, character F .DB 10001111B ;code 10H, character c .DB 10010100B ;code 11H, character G .DB 10100010B ;code 12H, character H .DB 11110011B ;code 13H, character I .DB 10011110B ;code 14H, character L .DB 10011111B ;code 15H, character l .DB 10100111B ;code 16H, character n .DB 10000111B ;code 17H, character o .DB 10101000B ;code 18H, character P .DB 10111100B ;code 19H, character R .DB 10101111B ;code 1AH, character r .DB 10001110B ;code 1BH, character t .DB 10010010B ;code 1CH, character U .DB 10010111B ;code 1DH, character u .DB 11000010B ;code 1EH, character Y .DB 11101000B ;code 1FH, character degree .DB 11111101B ;code 20H, character ~ .DB 11101111B ;code 21H, character - .DB 11011111B ;code 22H, character _ .DB 11111111B ;code 23H, character blank ; ------ Characters codes table ------ BLANK .EQU 023H ;blank CH_P .EQU 018H ;character "P" code CH_r .EQU 01AH ;character "r" code #IFDEF DEBUG #INCLUDE "LIBDBG16.ASM" #ENDIF .END