; ; Original MCS-BASIC-52, with 1.31 revisions - reports suggest 1K XRAM is a minimum ; See also C:\Jim\TSim51\SuperBASIC52_F380\BASIC52_F380.ASM for older source, F380 version. ; V1.32 - Added controls for x2 and AT89LP51RD2 1T and 12T modes ; Other modern variants include SiLabs EFM8 series, with the EFM8LB1 having ADC and DAC that could be included. ; EFM8LB1 has choices of 16kF/32kF/64kF and 1.25,2.25,4.25k of XRAM, 2 UART, and clock up to 72MHz ; EFM8LB1 would be a good choice for mixed designs. ; ; Also new is the STC8F series, which can come with 4 UART and i2c/SPI, and has 8k RAM for larger RAM BASIC code ; A version that can put user routines in FLASH would extend the use significantly. ; ; Device Core MHz Vcc Ta Flash XRAM UART ADC SPI i2c IRC ; N76E885 1T 25 MHz 2.4V~5.5V -40~105°C 18kB 256B 2 10b x 10 1 1 22.1184MHz ; N76E003 1T 25 MHz 2.4V~5.5V -40~105°C 18kB 768B 2 10b x 10 1 1 16.000MHz ; N79E715 4T 25 MHz 2.4V~5.5V -40~105°C 16kB 256B 2 10b x 10 1 1 22.1184MHz ; ML51 to 64kF/4kR ; MS51 to 32kF/2KR Similar to N76E003, but newer parts released in 2019 ; ; STC8F8K64S4 24 MHz 2.0V~5.5V -40~85°C 64kB 8k 4 12b x 16 1 1 24.0MHz << Most XRAM ; ; EFM8LB1 72MHz 2.2V~3.6V -40~105°C 64kB 4k 2 14b x 20 1 1 72.0MHz << Most MHz, best ADC ; EFM8UB3 48MHz 40kB 3072 1 12b 1 1 48MHz ; AT89LP51RD2 24MHz 2.4V~5.5V -40~85°C 16kB 1152B 1 10b x 8 1 1 22.1184MHz ; ; LB1 is higher spec, but UB3 can load code via USB bootloader. ; ; ; TSim51 Tests, AT89LP51RD2 : ; Reset, then send a Space char, and 9600 Baud echo @ 11.0592MHz or 22.1184 or 33.1776 or 44.2368 is ;00000000> 0D 0A 2A 4D 43 53 2D 42 41 53 49 43 2D 35 32 20 ..*MCS-BASIC-52 ;00000010> 56 31 2E 33 31 2A 0D 0A 52 45 41 44 59 0D 0A 3E V1.31*..READY..> ;00000020> 07 ; or in ASCII mode: ; ;*MCS-BASIC-52 V1.32* ;READY ;><07> ; These VirtualTerminal controls added in TSim51 b648 ; Allows Source change of Terminal defaults define terminal mcu rx 'p3.0' define terminal mcu tx 'p3.1' define terminal baudrate 9600 define terminal parity none define terminal echo off define terminal hex off define terminal invisiblechars on ; ; ; ; There are a number of Single Chip Timer2 cores with >1K XRAM that could be used. ; Assembles with TAsmC51 and simulates under TSim51 ; V1.32 - Added controls for x2 and AT89LP51RD2 1T and 12T modes ; ; See ~ line#1415 where TSim51 measurements confirm the Baud margins ; ; ~~~~~~~~~~~~~~~~~~~ TSim51 b610b Tests (checked b653 OK ) ~~~~~~~~~~~~~~~~~~~~~~~ ; (AutoBAUD time 0x0237, RCAP2x 0xFFDC ) ; DLL.Core 11.0592MHz 77.4144MHz ; MCS-52 OK ; AT89S8253 OK ; AT89LP51RD2(not fast) OK OK LP51RD2_Slow = ON ; ; AT89LP51RD2(fast) OK. [LP51RD2_Fast = ON] below, Needed baud code revisions, samples with T2 /2, Bauds at /1 for same maths, & improved baud granularity. ; AT89LP52(not fast) tbf (would need external RAM) sets T0,T1 to /12, so any timer0.1 code should run unchanged. ; ; There is ~30 bytes available code of Higher-Baud smarts under IF (OldInfineon5xx = ON), for faster parts like ; AT89LP52Rx2(fast) (2KR) or EFM8BB2 (2KR) or EFM8LB1 (4KR) or C8051F5xx (2K/4K/8KR) ; - but most of these parts have > 8K CODE, so size is not a large issue. ; ; 1.32 Added x2 mode CLKREF 0x8F for AT89S8253, ** will also run timer0,1 faster, not changed yet. ; ; ; From below: ; Max XTAL is now 78.627473 MHz - default crystal value is still 11.059200 MHz ; ; ;***************************************************************************** ;* * ;* MCS-BASIC-52 V1.31 Source Listing * ;* 12/1986 till 11/2001 * ;* The original source code of V1.1 (BASIC.SRC and FP52.SRC) by * ;* Intel Corporation, Embedded Controller Operations * ;* is public donain * ;* * ;***************************************************************************** ; ;***************************************************************************** ;* General alterations made by D. Wulf, 12/1999. * ;* e-mail: Detlef.Wulf@onlinehome.de * ;***************************************************************************** ; ; The following general alterations are made to the original source code: ; ; - The original source code had 2 files BASIC.SRC and FP52.SRC those have ; been incorporated into this file for easy of assembly. ; ; - All absolute and relativ jumps and calls without labels were provided ; with labels. ; ; - All machine code in the original source, coded in databytes are replaced ; by the menomics. ; ; - One routine in the source was different to the ROM code and is replaced ; by the ROM code. ; ; - Some "ORG" statements between BASIC and floating point code are remarked ; out. ; ; - To get room for new code the "ego message" had to be disabled. ; (Remarked with "Sorry") ; ; - To get more room for new code the "FPROG" command had to be disabled. ; (Remarked with "get room") ; ;***************************************************************************** ;* Bugfixes for MCS-52-BASIC from D. Karmann, 8/1993. * ;* e-mail: dankarmann@lucent.com * ;***************************************************************************** ; ; - Corrected Intel bug to allow BASIC autoboot EPROM at 8000H with user ; command extensions to work. ; (Remarked as Karmann 1) ; ; - Corrected Intel bug to that discarded the 'F' in any variable ending in ; F, FP, FPR and FPRO and followed by a space. ; (Remarked as Karmann 2) ; ;***************************************************************************** ;* Bugfix and performance for MCS-52-BASIC from * ;* D. Mudric and Z. Stojsavljevic descipt in * ;* Elektor Electronics magazine german issue 3/1992. * ;***************************************************************************** ; ; - Modifications to the unprocess a BASIC line routine. ; (Remarked as Elektor 1) ; ; - Modifications to the floating point subtraction routine. ; (Remarked as Elektor 2) ; ; - HEX to BIN performance improvements. ; (Remarked as Elektor 3) ; ; The same article describes a fix for the multiplication underflow bug, but ; the fixes did not work. ; ; The multiplicaton underflow bug is now (V1.31) really fixed by D. Wulf! ; (Remarked as Wulf 1) ; ;***************************************************************************** ;* Change UV-EPROM to EEPROM programming from R. Skowronek, 4/1996 * ;* e-mail: r.skowronek@kfa-juelich.de * ;***************************************************************************** ; ; This altered section of code writes the ram resident Basic program to ; EEPROM just like the ROM resident Basic interpreter writes to UV-EPROMs. ; The EEPROM is connected just like a RAM, i.e. it uses /wr on pin 27 ; and gets it's adresses from the real address lines, i.e. the only ; difference from the normal setup is the use of the /wr line instead of ; P1.4, which supplies the program pulse for UV-EPROMs. Now MCS-BASIC-52 ; can be located in externally ROM and is non the less able to programm ; EEPROMs! ; (Remarked as Skowronek) ; ; The original code from R. Skowronek didn't support the "PGM" statement ; this feature is added by D. Wulf. ; Memory is now limited to 32K bytes RAM, because memory tests above it ; would change the EEPROM. ; ;***************************************************************************** ;* Change timer 0 from 13 bit to 16 bit counter mode to use XTAL up to 78MHz * ;* from D. Wulf 1/2000 * ;***************************************************************************** ; ; The max. value for XTAL is now 78627473 Hz, for use BASIC-52 with ; Dallas 80C320 high speed / low power microcontroller (33 MHz). ; The default crystal value is still 11059200 Hz. You can set it with ; XTAL or patch the souce code at ; ; 17F1H = 11 ; 17F0H = 05 ; 17EFH = 92 ; 17EEH = 00 ; ; with a new crystal value. ; (Remarket as Wulf 2) ; ;***************************************************************************** ;* New baudrate detection from D. Wulf 1/2000 * ;***************************************************************************** ; ; The new baudrate detection uses timer 2 for time measurement in state of ; the code loop timing. So the Dallas 80C320 and other controllers can be ; used. Also at higher clock speeds the baudrate will detect automaticly. ; (Remarked as Wulf 3) ; ;***************************************************************************** ;* New processor type detection from D. Wulf 2/2000 * ;***************************************************************************** ; ; A new reset routine detects the processor type. So BASIC-52 V1.3 can be ; used with the following controllers: ; ; 8032, 87C52#, Dallas 80C320, 80515*#, 80517*#, 80517A#, 80528, 80535*, ; 80537*, 80575 or similars. ; ; - On processor types marked with the "*" only two different autodetect ; baudrates, depending on the crystal are possible. ; - The processor types marked with the "#" have internal ROM, so BASIC-52 ; V1.3 can be located there, because it is still only 8K bytes long! ; ; (Remarked as Wulf 4) ; ;***************************************************************************** ;* OPBYTE 43H for POP from H.-J. Boehling 1/2000 * ;* e-mail: H-Boehling@gmx.de * ;***************************************************************************** ; ; A feature of BASIC-52 is the ability to add up to 16 custom keywords ; representing commands or instructions that you define with assembler ; routines. For using system routines in your assembler code there are ; operation bytes (for more information see Intels "MCS BASIC-52 MANUAL"). ; In the original souce code is no OPCODE to put a value from argument ; stack and store in a variable. ; With BASIC-52 V1.3 you can use OPBYTE 43H which does the same than the ; "POP" statement. ; (Remarked as Boehling 1) ; ;***************************************************************************** ;* Reset millisecond counter on "TIME=" from H.-J. Boehling 2/2000 * ;***************************************************************************** ; ; The command "TIME=0" now zeros the millisecond register so that TIME ; returns with zero. ; (Remarked as Boehling 2) ; ;***************************************************************************** ;* New command "ERASE" by H.-J. Boehling 2/2000 * ;***************************************************************************** ; ; To erase an EEPROM (fill 16K byte up to 8000H with 0FFH) the new command ; "ERASE" is implemented. It takes 2 min. and 45 sec. to erase the 16K bytes! ; (Remarked as Boehling 3) ; ;***************************************************************************** ;* Correct "ASC(x)" bug by D. Wulf 2/2000 * ;***************************************************************************** ; ; BASIC-51 V1.1 gives erroneous results for the "ASC(x)" funktion if "x" is ; one of the following signs : *, +, -, /, <, =, > or ?. ; BASIC-51 V1.3 returns the correct values. ; (Remarked as Wulf 5) ; ;***************************************************************************** ;***************************************************************************** ; To indicate the new version the start message is changed from ; *MCS-51(tm) BASIC V1.1* to ; *MCS-BASIC-52 V1.31* ; ; H.-J. Boehling, D. Wulf 11/26/2001 ;***************************************************************************** ; ON EQU 01 OFF EQU 00 ; ================================= Choose ONE Target Group for Test =============================== OldInfineon5xx EQU OFF ; add/remove old Infineon SAB80C5xx extras, ON for original WEB code. IF (OldInfineon5xx = OFF) UseX2 EQU OFF ; CLKREG =01 on Atmel parts with x2 eg AT89S8253 and up LP51RD2_Slow EQU OFF ; Slow mode, LP51Rx2, also ok on AT89S8253 LP51RD2_Fast EQU ON ; Fast Mode, LP51Rx2 - TSim51 tested OK ELSE UseX2 EQU OFF LP51RD2_Slow EQU OFF LP51RD2_Fast EQU OFF ENDIF T2CON SFR 0C8H ; This three lines are necessary for MS-DOS freeware TL2 SFR 0CCH ; MCS-51 Family Cross Assembler ASEM-51 V1.2 TH2 SFR 0CDH ; from W.W. Heinz (e-mail: ww@andiunx.m.isar.de) ; ;************************************************************** ; ; TRAP VECTORS TO MONITOR ; ; RESET TAG (0AAH) ---------2001H ; ; TAG LOCATION (5AH) ------ 2002H ; ; EXTERNAL INTERRUPT 0 ---- 2040H ; ; COMMAND MODE ENTRY ------ 2048H ; ; SERIAL PORT ------------- 2050H ; ; MONITOR (BUBBLE) OUTPUT - 2058H ; ; MONITOR (BUBBLE) INPUT -- 2060H ; ; MONITOR (BUBBLE) CSTS --- 2068H ; ; GET USER JUMP VECTOR ---- 2070H ; ; GET USER LOOKUP VECTOR -- 2078H ; ; PRINT AT VECTOR --------- 2080H ; ; INTERRUPT PWM ----------- 2088H ; ; EXTERNAL RESET ---------- 2090H ; ; USER OUTPUT-------------- 4030H ; ; USER INPUT -------------- 4033H ; ; USER CSTS --------------- 4036H ; ; USER RESET -------------- 4039H ; ; USER DEFINED PRINT @ --- 403CH ; ;*************************************************************** ; ;*************************************************************** ; ; MCS - 52 - 8K BASIC VERSION 1.3 ; ;*************************************************************** ; AJMP CRST ;START THE PROGRAM ADDC A,@R1 ; ORG 3H ; ;*************************************************************** ; ;EXTERNAL INTERRUPT 0 ; ;*************************************************************** ; JB DRQ,STQ ;SEE IF DMA IS SET PUSH PSW ;SAVE THE STATUS LJMP 4003H ;JUMP TO USER IF NOT SET (assumes user CODE exists @ 4000h) ; ORG 0BH ; ;*************************************************************** ; ;TIMER 0 OVERFLOW INTERRUPT ; ;*************************************************************** ; PUSH PSW ;SAVE THE STATUS JB C_BIT,STJ ;SEE IF USER WANTS INTERRUPT LJMP 400BH ;EXIT IF USER WANTS INTERRUPTS ; ORG 13H ; ;*************************************************************** ; ;EXTERNAL INTERRUPT 1 ; ;*************************************************************** ; JB INTBIT,STK PUSH PSW LJMP 4013H ; ; ORG 1BH ; ;*************************************************************** ; ;TIMER 1 OVERFLOW INTERRUPT ; ;*************************************************************** ; PUSH PSW LJMP CKS_I ; STJ: LJMP I_DR ;DO THE INTERRUPT ; ;*************************************************************** ; ;SERIAL PORT INTERRUPT ; ;*************************************************************** ; ORG 23H ; PUSH PSW JB SPINT,STU ;SEE IF MONITOR WANTS INTERRUPT LJMP 4023H ; ORG 2BH ; ;************************************************************** ; ;TIMER 2 OVERFLOW INTERRUPT ; ;************************************************************** ; PUSH PSW LJMP 402BH ; ;************************************************************** ; ;USER ENTRY ; ;************************************************************** ; ORG 30H ; LJMP IBLK ;LINK TO USER BLOCK ; STQ: JB I_T0,STS ;SEE IF MONITOR WANTS IT CLR DACK JNB P3.2,$ ;WAIT FOR DMA TO END SETB DACK RETI ; STS: LJMP 2040H ;GO TO THE MONITOR ; STK: SETB INTPEN ;TELL BASIC AN INTERRUPT WAS RECEIVED RETI ; STU: LJMP 2050H ;SERIAL PORT INTERRUPT ; ; ;************************************************************** ; ; This is the equate table for 8052 basic. ; ;************************************************************** ; ; The register to direct equates for CJNE instructions. ; R0B0 DATA 0 R1B0 DATA 1 R2B0 DATA 2 R3B0 DATA 3 R4B0 DATA 4 R5B0 DATA 5 R6B0 DATA 6 R7B0 DATA 7 ; ; Register bank 1 contains the text pointer ; and the arg stack pointer. ; TXAL DATA 8 ;R0 BANK 1 = TEXT POINTER LOW ASTKA DATA 9 ;R1 BANK 1 = ARG STACK TXAH DATA 10 ;R2 BANK 1 = TEXT POINTER HIGH ; ; Now five temporary locations that are used by basic. ; TEMP1 DATA 11 TEMP2 DATA 12 TEMP3 DATA 13 TEMP4 DATA 14 TEMP5 DATA 15 ; ; Register bank 2 contains the read text pointer ; and the control stack pointer. ; RTXAL DATA 16 ;R0 BANK 2 = READ TEXT POINTER LOW CSTKA DATA 17 ;R1 BANK 2 = CONTROL STACK POINTER RTXAH DATA 18 ;R2 BANK 2 = READ TEXT POINTER HIGH ; ; Now some internal system DATAates. ; BOFAH DATA 19 ;START OF THE BASIC PROGRAM, HIGH BYTE BOFAL DATA 20 ;START OF THE BASIC PROGRAM, LOW BYTE NULLCT DATA 21 ;NULL COUNT PHEAD DATA 22 ;PRINT HEAD POSITION FORMAT DATA 23 ; ; Register bank 3 is for the user and can be loaded ; by basic ; ; ; ; Now everything else is used by basic. ; First the bit locations, these use bytes 34, 35, 36, 37 and 38 ; OTS BIT 16 ;34.0-ON TIME INSTRUCTION EXECUTED INPROG BIT 17 ;34.1-INTERRUPT IN PROCESS INTBIT BIT 18 ;34.2-INTERRUPT SET BIT ON_ERR BIT 19 ;34.3-ON ERROR EXECUTED OTI BIT 20 ;34.4-ON TIME INTERRUPT IN PROGRESS LINEB BIT 21 ;34.5-LINE CHANGE OCCURED INTPEN BIT 22 ;34.6-INTERRUPT PENDING BIT CONB BIT 23 ;34.7-CAN CONTINUE IF SET GTRD BIT 24 ;35.0-READ GET LOCATION LPB BIT 25 ;35.1-PRINT TO LINE PRINTER PORT CKS_B BIT 26 ;35.2-FOR PWM INTERRUPT COB BIT 27 ;35.3-CONSOLE OUT BIT ; 0 = SERIAL PORT ; 1 = LINE PRINTER COUB BIT 28 ;35.4-USER CONSOLE OUT BIT ; 0 = SERIAL PORT ; 1 = USER DRIVER INBIT BIT 29 ;35.5-INITIALIZATION BIT CIUB BIT 30 ;35.6-USER CONSOLE IN BIT ; 0 = SERIAL PORT ; 1 = USER ROUTINE SPINT BIT 31 ;35.7-SERIAL PORT INTERRUPT STOPBIT BIT 32 ;36.0-PROGRAM STOP ENCOUNTERED U_IDL BIT 33 ;36.1-USER IDLE BREAK INP_B BIT 34 ;36.2-SET DURING INPUT INSTRUCTION ;DCMPXZ BIT 35 ;36.3-DCMPX ZERO FLAG ARGF BIT 36 ;36.4-ARG STACK HAS A VALUE RETBIT BIT 37 ;36.5-RET FROM INTERRUPT EXECUTED I_T0 BIT 38 ;36.6-TRAP INTERRUPT ZERO TO MON UPB BIT 39 ;36.7-SET WHEN @ IS VALID ; ;***************************************************************************** ;****** Sorry - but the ego message had to be disabled *********************** ; ;JKBIT BIT 40 ;37.0-WB TRIGGER We use the bit for detect ; mul_underflow BIT 40 ;37.0-mul_limit_case ; ;***************************************************************************** ; ENDBIT BIT 41 ;37.1-GET END OF PROGRAM UBIT BIT 42 ;37.2-FOR DIM STATEMENT ISAV BIT 43 ;37.3-SAVE INTERRUPT STATUS BO BIT 44 ;37.4-BUBBLE OUTPUT XBIT BIT 45 ;37.5-EXTERNAL PROGRAM PRESENT C_BIT BIT 46 ;37.6-SET WHEN CLOCK RUNNING DIRF BIT 47 ;37.7-DIRECT INPUT MODE NO_C BIT 48 ;38.0-NO CONTROL C DRQ BIT 49 ;38.1-DMA ENABLED BI BIT 50 ;38.2-BUBBLE INPUT ; ;***************************************************************************** ;****** Disable Intel programming for to get room **************************** ; ;INTELB BIT 51 ;38.3-INTELLIGENT PROM PROGRAMMING ; ;***************************************************************************** ; C0ORX1 BIT 52 ;38.4-PRINT FROM ROM OR RAM CNT_S BIT 53 ;38.5-CONTROL S ENCOUNTERED ZSURP BIT 54 ;38.6-ZERO SUPRESS HMODE BIT 55 ;38.7-HEX MODE PRINT LP BIT P1.7 ;SOFTWARE LINE PRINTER DACK BIT P1.6 ;DMA ACK ;***************************************************************************** ; ;PROMV BIT P1.5 ;TURN ON PROM VOLTAGE ;PROMP BIT P1.4 ;PROM PULSE ;ALED BIT P1.3 ;ALE DISABLE ; ;***************************************************************************** T_BIT BIT P1.2 ;I/O TOGGLE BIT ; ; ; The next location is a bit addressable byte counter ; BABC DATA 39 ; ; Now floating point and the other temps ; ; FP Uses to locations 03CH ; ; Now the stack designators. ; SPSAV DATA 3EH S_LEN DATA 3FH T_HH DATA 40H T_LL DATA 41H INTXAH DATA 42H INTXAL DATA 43H MT1 DATA 45H MT2 DATA 46H MILLIV DATA 47H ;Real Time Clock 5 millisec. TVH DATA 48H ;Real Time Clock high byte TVL DATA 49H ;Real Time Clock low byte SAVE_T DATA 4AH SP_H DATA 4BH ;SERIAL PORT TIME OUT SP_L DATA 4CH CMNDSP DATA 4DH ;SYSTEM STACK POINTER PCON0 DATA 87H ;PCON SFR IF (OldInfineon5xx = ON) S0RELL SFR 0AAH ;S0RELL 805x7A SFR S0RELH SFR 0BAH ;S0RELH 805x7A SFR ADCON SFR 0D8H ;ADCON 805xx SFR DAPR SFR 0DAH ;DAPR 805xx SFR BD BIT 0DFH ;Baudrategenerator 805x7,x5 ENDIF RCAPH2 SFR 0CBH ;RCAPH2 8052 SFR RCAPL2 SFR 0CAH ;RCAPL2 8052 SFR IRAMTOP SFR 0FFH ;TOP OF RAM STACKTP SFR 0FEH ;ARG AND CONTROL STACK TOPS ; ; The character equates ; CR EQU 0DH ;CARRIAGE RETURN LF EQU 0AH ;LINE FEED BELL EQU 07H ;BELL CHARACTER BS EQU 08H ;BACK SPACE CNTRLC EQU 03H ;CONTROL C CNTRLD EQU 04H ;CONTROL D NULL EQU 00H ;NULL ; ; The new baud rate constants ; B4800 EQU 0B2H ;Timervalue for 4800 baud B9600 EQU 0D9H ;Timervalue for 9600 baud ; ; ; The internal system equates ; LINLEN EQU 73 ;THE LENGTH OF AN INPUT LINE EOF EQU 01 ;END OF FILE CHARACTER ASTKAH EQU 01 ;ASTKA IS IN PAGE 1 OF RAM CSTKAH EQU 00 ;CSTKA IS IN PAGE 0 OF RAM FTYPE EQU 01 ;CONTROL STACK "FOR" GTYPE EQU 02 ;CONTROL STACK "GOSUB" DTYPE EQU 03 ;DO-WHILE/UNTIL TYPE ROMADR EQU 8000H ;LOCATION OF ROM ; ; The floating point equates ; FPSIZ EQU 6 ;NO. OF BYTES IN A FLOATING NUM DIGIT EQU FPSIZ-2 ;THE MANTISSA OF A FLOATING NUM STESIZ EQU FPSIZ+3 ;SIZE OF SYMBOL ADJUSTED TABLE ELEMENT ;FP_BASE EQU 1993H ;BASE OF FLOATING POINT ROUTINES PSTART EQU 512 ;START OF A PROGRAM IN RAM FSIZE EQU FPSIZ+FPSIZ+2+2+1 ; ;************************************************************** ; USENT: ; User entry jump table ; ;************************************************************** ; DW CMND1 ;(00, 00H)COMMAND MODE JUMP DW IFIX ;(01, 01H)CONVERT FP TO INT DW PUSHAS ;(02, 02H)PUSH VALUE ONTO ARG STACK DW POPAS ;(03, 03H)POP VALUE OFF ARG STACK DW PG1 ;(04, 04H)PROGRAM A PROM DW INLINE ;(05, 05H)INPUT A LINE DW UPRNT ;(06, 06H)PRINT A LINR DW CRLF ;(07, 07H)OUTPUT A CRLF ; ;************************************************************** ; ; This is the operation jump table for arithmetics ; ;************************************************************** ; OPTAB: DW ALPAR ;(08, 08H)LEFT PAREN DW AEXP ;(09, 09H)EXPONENTAION DW AMUL ;(10, 0AH)FP MUL DW AADD ;(11, 0BH)FLOATING POINT ADD DW ADIV ;(12, 0CH)FLOATING POINT DIVIDE DW ASUB ;(13, 0DH)FLOATING POINT SUBTRACTION DW AXRL ;(14, 0EH)XOR DW AANL ;(15, 0FH)AND DW AORL ;(16, 10H)OR DW ANEG ;(17, 11H)NEGATE DW AEQ ;(18, 12H)EQUAL DW AGE ;(19, 13H)GREATER THAN OR EQUAL DW ALE ;(20, 14H)LESS THAN OR EQUAL DW ANE ;(21, 15H)NOT EQUAL DW ALT ;(22, 16H)LESS THAN DW AGT ;(23, 17H)GREATER THAN ; ;*************************************************************** ; ; This is the jump table for unary operators ; ;*************************************************************** ; DW AABS ;(24, 18H)ABSOLUTE VALUE DW AINT ;(25, 19H)INTEGER OPERATOR DW ASGN ;(26, 1AH)SIGN OPERATOR DW ANOT ;(27, 1BH)ONE'S COMPLEMENT DW ACOS ;(28, 1CH)COSINE DW ATAN ;(29, 1DH)TANGENT DW ASIN ;(30, 1EH)SINE DW ASQR ;(31, 1FH)SQUARE ROOT DW ACBYTE ;(32, 20H)READ CODE DW AETOX ;(33, 21H)E TO THE X DW AATAN ;(34, 22H)ARC TANGENT DW ALN ;(35, 23H)NATURAL LOG DW ADBYTE ;(36, 24H)READ DATA MEMORY DW AXBYTE ;(37, 25H)READ EXTERNAL MEMORY DW PIPI ;(38, 26H)PI DW ARND ;(39, 27H)RANDOM NUMBER DW AGET ;(40, 28H)GET INPUT CHARACTER DW AFREE ;(41, 29H)COMPUTE #BYTES FREE DW ALEN ;(42, 2AH) COMPUTE LEN OF PORGRAM DW AXTAL ;(43, 2BH) CRYSTAL DW PMTOP ;(44, 2CH)TOP OF MEMORY DW ATIME ;(45, 2DH) TIME DW A_IE ;(46, 2EH) IE DW A_IP ;(47, 2FH) IP DW ATIM0 ;(48, 30H) TIMER 0 DW ATIM1 ;(49, 31H) TIMER 1 DW ATIM2 ;(50, 32H) TIMER 2 DW AT2CON ;(51, 33H) T2CON DW ATCON ;(52, 34H) TCON DW ATMOD ;(53, 35H) ATMOD DW ARCAP2 ;(54, 36H) RCAP2 DW AP1 ;(55, 37H) P1 DW APCON ;(56, 38H) PCON DW EXPRB ;(57, 39H) EVALUATE AN EXPRESSION DW AXTAL1 ;(58, 3AH) CALCULATE CRYSTAL DW LINE ;(59, 3BH) EDIT A LINE DW PP ;(60, 3CH) PROCESS A LINE DW UPPL0 ;(61, 3DH) UNPROCESS A LINE DW VAR ;(62, 3EH) FIND A VARIABLE DW GC ;(63, 3FH) GET A CHARACTER DW GCI ;(64, 40H) GET CHARACTER AND INCREMENT DW INCHAR ;(65, 41H) INPUT A CHARACTER DW CRUN ;(66, 42H) RUN A PROGRAM ; ;***************************************************************************** ;****** OPBYTE 43H for POP *************************************************** ;****** Boehling 1 *********************************************************** ; dw SPOP ;(67, 43H) POP a value to a variable ; ;***************************************************************************** ; OPBOL: DB 1 ; ; DB 15 ;LEFT PAREN DB 14 ;EXPONENTIAN ** DB 10 ;MUL DB 8 ;ADD DB 10 ;DIVIDE DB 8 ;SUB DB 3 ;XOR DB 5 ;AND DB 4 ;OR DB 12 ;NEGATE DB 6 ;EQ DB 6 ;GT DB 6 ;LT DB 6 ;NE DB 6 ;LE DB 6 ;GE ; UOPBOL: DB 15 ;AABS DB 15 ;AAINT DB 15 ;ASGN DB 15 ;ANOT DB 15 ;ACOS DB 15 ;ATAN DB 15 ;ASIN DB 15 ;ASQR DB 15 ;ACBYTE DB 15 ;E TO THE X DB 15 ;AATAN DB 15 ;NATURAL LOG DB 15 ;DBYTE DB 15 ;XBYTE ; ;*************************************************************** ; ; The ASCII printed messages. ; ;*************************************************************** ; STP: DB 'STOP"' ; IAN: DB 'TRY AGAIN"' ; RDYS: DB 'READY"' ; INS: DB ' - IN LINE "' ; ;************************************************************** ; ; This is the command jump table ; ;************************************************************** ; CMNDD: DW CRUN ;RUN DW CLIST ;LIST DW CNULL ;NULL DW CNEW ;NEW DW CCONT ;CONTINUE DW CPROG ;PROGRAM A PROM DW CXFER ;TRANSFER FROM ROM TO RAM DW CRAM ;RAM MODE DW CROM ;ROM MODE ; ;***************************************************************************** ;****** Disable Intel programming for to get room **************************** ; ; DW CIPROG ;INTELLIGENT PROM PROGRAMMING ; ;***************************************************************************** ; dw CERASE ;Erase an EEPROM ; ;*************************************************************** ; ; This is the statement jump table. ; ;************************************************************** ; STATD: ; DW SLET ;LET 80H DW SCLR ;CLEAR 81H DW SPUSH ;PUSH VAR 82H DW SGOTO ;GO TO 83H DW STONE ;TONE 84H DW SPH0 ;PRINT MODE 0 85H DW SUI ;USER INPUT 86H DW SUO ;USER OUTPUT 87H DW SPOP ;POP VAR 88H DW SPRINT ;PRINT 89H DW SCALL ;CALL 8AH DW SDIMX ;DIMENSION 8BH DW STRING ;STRING ALLO 8CH DW SBAUD ;SET BAUD 8DH DW SCLOCK ;CLOCK 8EH DW SPH1 ;PRINT MODE 1 8FH ; ; No direct mode from here on ; DW SSTOP ;STOP 90H DW SOT ;ON TIME 91H DW SONEXT ;ON EXT INT 92H DW SRETI ;RET FROM INT 93H DW S_DO ;DO 94H DW SRESTR ;RESTOR 95H DW WCR ;REM 96H DW SNEXT ;NEXT 97H DW SONERR ;ON ERROR 98H DW S_ON ;ON 99H DW SINPUT ;INPUT 9AH DW SREAD ;READ 9BH DW FINDCR ;DATA 9CH DW SRETRN ;RETURN 9DH DW SIF ;IF 9EH DW SGOSUB ;GOSUB 9FH DW SFOR ;FOR A0H DW SWHILE ;WHILE A1H DW SUNTIL ;UNTIL A2H DW CMND1 ;END A3H DW I_DL ;IDLE A4H DW ST_A ;STORE AT A5H DW LD_A ;LOAD AT A6H DW PGU ;PGM A7H DW RROM ;RUN A ROM A9H ; ;************************************************************** ; TOKTAB: ; This is the basic token table ; ;************************************************************** ; ; First the tokens for statements ; DB 80H ;LET TOKEN DB 'LET' ; DB 81H ;CLEAR TOKEN DB 'CLEAR' ; DB 82H ;PUSH TOKEN DB 'PUSH' ; T_GOTO EQU 83H ; DB 83H ;GO TO TOKEN DB 'GOTO' ; DB 84H ;TOGGLE TOKEN DB 'PWM' ; DB 85H ;PRINT HEX MODE 0 DB 'PH0.' ; DB 86H ;USER IN TOKEN DB 'UI' ; DB 87H ;USER OUT TOKEN DB 'UO' ; DB 88H ;POP TOKEN DB 'POP' ; DB 89H ;PRINT TOKEN DB 'PRINT' DB 89H DB 'P.' ;P. ALSO MEANS PRINT DB 89H ;? ALSO DB '?' ; DB 8AH ;CALL TOKEN DB 'CALL' ; DB 8BH ;DIMENSION TOKEN DB 'DIM' ; DB 8CH ;STRING TOKEN DB 'STRING' ; DB 8DH ;SET BAUD RATE DB 'BAUD' ; DB 8EH ;CLOCK DB 'CLOCK' ; DB 8FH ;PRINT HEX MODE 1 DB 'PH1.' ; T_STOP EQU 90H ;STOP TOKEN DB T_STOP DB 'STOP' ; T_DIR EQU T_STOP ;NO DIRECT FROM HERE ON ; DB T_STOP+1 ;ON TIMER INTERRUPT DB 'ONTIME' ; DB T_STOP+2 ;ON EXTERNAL INTERRUPT DB 'ONEX1' ; DB T_STOP+3 ;RETURN FROM INTERRUPT DB 'RETI' ; DB T_STOP+4 ;DO TOKEN DB 'DO' ; DB T_STOP+5 ;RESTORE TOKEN DB 'RESTORE' ; T_REM EQU T_STOP+6 ;REMARK TOKEN DB T_REM DB 'REM' ; DB T_REM+1 ;NEXT TOKEN DB 'NEXT' ; DB T_REM+2 ;ON ERROR TOKEN DB 'ONERR' ; DB T_REM+3 ;ON TOKEN DB 'ON' ; DB T_REM+4 ;INPUT DB 'INPUT' ; DB T_REM+5 ;READ DB 'READ' ; T_DATA EQU T_REM+6 ;DATA DB T_DATA DB 'DATA' ; DB T_DATA+1 ;RETURN DB 'RETURN' ; DB T_DATA+2 ;IF DB 'IF' ; T_GOSB EQU T_DATA+3 ;GOSUB DB T_GOSB DB 'GOSUB' ; DB T_GOSB+1 ;FOR DB 'FOR' ; DB T_GOSB+2 ;WHILE DB 'WHILE' ; DB T_GOSB+3 ;UNTIL DB 'UNTIL' ; DB T_GOSB+4 ;END DB 'END' ; T_LAST EQU T_GOSB+5 ;LAST INITIAL TOKEN ; T_TAB EQU T_LAST ;TAB TOKEN DB T_TAB DB 'TAB' ; T_THEN EQU T_LAST+1 ;THEN TOKEN DB T_THEN DB 'THEN' ; T_TO EQU T_LAST+2 ;TO TOKEN DB T_TO DB 'TO' ; T_STEP EQU T_LAST+3 ;STEP TOKEN DB T_STEP DB 'STEP' ; T_ELSE EQU T_LAST+4 ;ELSE TOKEN DB T_ELSE DB 'ELSE' ; T_SPC EQU T_LAST+5 ;SPACE TOKEN DB T_SPC DB 'SPC' ; T_CR EQU T_LAST+6 DB T_CR DB 'CR' ; DB T_CR+1 DB 'IDLE' ; DB T_CR+2 DB 'ST@' ; DB T_CR+3 DB 'LD@' ; DB T_CR+4 DB 'PGM' ; DB T_CR+5 DB 'RROM' ; ; Operator tokens ; T_LPAR EQU 0E0H ;LEFT PAREN DB T_LPAR DB '(' ; DB T_LPAR+1 ;EXPONENTIAN DB '**' ; DB T_LPAR+2 ;FP MULTIPLY DB '*' ; T_ADD EQU T_LPAR+3 DB T_LPAR+3 ;ADD TOKEN DB '+' ; DB T_LPAR+4 ;DIVIDE TOKEN DB '/' ; T_SUB EQU T_LPAR+5 ;SUBTRACT TOKEN DB T_SUB DB '-' ; DB T_LPAR+6 ;LOGICAL EXCLUSIVE OR DB '.XOR.' ; DB T_LPAR+7 ;LOGICAL AND DB '.AND.' ; DB T_LPAR+8 ;LOGICAL OR DB '.OR.' ; T_NEG EQU T_LPAR+9 ; T_EQU EQU T_LPAR+10 ;EQUAL DB T_EQU DB '=' ; DB T_LPAR+11 ;GREATER THAN OR EQUAL DB '>=' ; DB T_LPAR+12 ;LESS THAN OR EQUAL DB '<=' ; DB T_LPAR+13 ;NOT EQUAL DB '<>' ; DB T_LPAR+14 ;LESS THAN DB '<' ; DB T_LPAR+15 ;GREATER THAN DB '>' ; ; T_UOP EQU 0B0H ;UNARY OP BASE TOKEN ; DB T_UOP ;ABS TOKEN DB 'ABS' ; DB T_UOP+1 ;INTEGER TOKEN DB 'INT' ; DB T_UOP+2 ;SIGN TOKEN DB 'SGN' ; DB T_UOP+3 ;GET TOKEN DB 'NOT' ; DB T_UOP+4 ;COSINE TOKEN DB 'COS' ; DB T_UOP+5 ;TANGENT TOKEN DB 'TAN' ; DB T_UOP+6 ;SINE TOKEN DB 'SIN' ; DB T_UOP+7 ;SQUARE ROOT TOKEN DB 'SQR' ; DB T_UOP+8 ;CBYTE TOKEN DB 'CBY' ; DB T_UOP+9 ;EXP (E TO THE X) TOKEN DB 'EXP' ; DB T_UOP+10 DB 'ATN' ; DB T_UOP+11 DB 'LOG' ; DB T_UOP+12 ;DBYTE TOKEN DB 'DBY' ; DB T_UOP+13 ;XBYTE TOKEN DB 'XBY' ; T_ULAST EQU T_UOP+14 ;LAST OPERATOR NEEDING PARENS ; DB T_ULAST DB 'PI' ; DB T_ULAST+1 ;RND TOKEN DB 'RND' ; DB T_ULAST+2 ;GET TOKEN DB 'GET' ; DB T_ULAST+3 ;FREE TOKEN DB 'FREE' ; DB T_ULAST+4 ;LEN TOKEN DB 'LEN' ; T_XTAL EQU T_ULAST+5 ;CRYSTAL TOKEN DB T_XTAL DB 'XTAL' ; T_MTOP EQU T_ULAST+6 ;MTOP DB T_MTOP DB 'MTOP' ; T_IE EQU T_ULAST+8 ;IE REGISTER DB T_IE DB 'IE' ; T_IP EQU T_ULAST+9 ;IP REGISTER DB T_IP DB 'IP' ; TMR0 EQU T_ULAST+10 ;TIMER 0 DB TMR0 DB 'TIMER0' ; TMR1 EQU T_ULAST+11 ;TIMER 1 DB TMR1 DB 'TIMER1' ; TMR2 EQU T_ULAST+12 ;TIMER 2 DB TMR2 DB 'TIMER2' ; T_TIME EQU T_ULAST+7 ;TIME DB T_TIME DB 'TIME' ; TT2C EQU T_ULAST+13 ;T2CON DB TT2C DB 'T2CON' ; TTC EQU T_ULAST+14 ;TCON DB TTC DB 'TCON' ; TTM EQU T_ULAST+15 ;TMOD DB TTM DB 'TMOD' ; TRC2 EQU T_ULAST+16 ;RCAP2 DB TRC2 DB 'RCAP2' ; T_P1 EQU T_ULAST+17 ;P1 DB T_P1 DB 'PORT1' ; T_PC EQU T_ULAST+18 ;PCON DB T_PC DB 'PCON' ; T_ASC EQU T_ULAST+19 ;ASC TOKEN DB T_ASC DB 'ASC(' ; T_USE EQU T_ULAST+20 ;USING TOKEN DB T_USE DB 'USING(' DB T_USE DB 'U.(' ; T_CHR EQU T_ULAST+21 ;CHR TOKEN DB T_CHR DB 'CHR(' ; T_CMND EQU 0F0H ;COMMAND BASE ; DB 0F0H ;RUN TOKEN DB 'RUN' ; DB 0F1H ;LIST TOKEN DB 'LIST' ; DB 0F2H ;NULL TOKEN DB 'NULL' ; DB 0F3H ;NEW TOKEN DB 'NEW' ; DB 0F4H ;CONTINUE TOKEN DB 'CONT' ; DB 0F5H ;PROGRAM TOKEN DB 'PROG' ; DB 0F6H ;TRANSFER TOKEN DB 'XFER' ; DB 0F7H ;RAM MODE DB 'RAM' ; DB 0F8H ;ROM MODE DB 'ROM' ; ; ;***************************************************************************** ;****** Disable Intel programming for to get room **************************** ; ; DB 0F9H ;INTELLIGENT PROM PROGRAMMING ; DB 'FPROG' ; ;***************************************************************************** ;****** New command "ERASE" to fill an EEPROM with 0FFH ********************* ;****** Boehling 3 *********************************************************** ; db 0F9H ;Erase an EEPROM db 'ERASE' ; ;***************************************************************************** ;****** Karmann 2 Bugfix ***************************************************** ; db 0feh ;dummy token and db 07fh ;unused dummy char ; ;****** continue with original code: ***************************************** ; DB 0FFH ;END OF TABLE ; EIG: DB 'EXTRA IGNORED"' ; EXA: DB 'A-STACK"' ; EXC: DB 'C-STACK"' ; ;************************************************************** ; CRST: ; This performs system initialzation, it was moved here so the ; new power on reset functions could be tested in an 8751. ; ;************************************************************** ; ; First, initialize SFR's ; ;LP51RD2 CLKREG = AEH, Reset Value (slow) = 0101 XXXXB [TPS3 TPS2 TPS1 TPS0 — — — —] ;CKCON0 = 8FH Reset Value = 0000 000?B [TWIX2 WDX2 PCAX2 SIX2 T2X2 T1X2 T0X2 X2] ;- for T2BAUD want this 0000_1001B - CPU 1T and T2 1T, TPS then set for /12 for T0,T1 ;- DURING baud capture, MCS52 is /12 then /2, so we set LP51RD2 for /6 then /1 ; In Compatibility Mode, If SET T2 is then /TPS+1/2 Timer, CLR /TPS+1, BUT is /2 @ baud = Normal-52 ; In Fast Mode, set for /TPS+1 clocks per peripheral clock cycle, clear for one system clock period and for BOTH Timer & Baud!. IF (UseX2=ON) ; Std MCS52 and MCUs with x2 bit CLKREG_CLKCON0 SFR 8FH ; CLKREG.89S8253 CLKCON in LP51RD2 ; MOV CLKREG,#01010010B ;AT89LP52 01010010B in Compatibility mode MOV CLKREG_CLKCON0,#0000_1001B ;89S8253 RCAP2 0xFFB8 MCS-52 RCAP2 = 0xFFDC ; 2^16-0xffb8 = 72 2^16-0xffdc = 36 ELSEIF (LP51RD2_Slow=ON) CLKCON0 SFR 8FH ; CLKCON in LP51RD2 TPS_LP51RD2 SFR 0AEH MOV CLKCON0,#0000_1001B ; /TPS+1/2 for Timer , but uses /2 for Baud ; MOV TPS_LP51RD2,#(6-1)*16 ; Div6 during Baud RST default ELSEIF (LP51RD2_Fast=ON) ; Fast RCAP2 MCS-52 RCAP2 = 0xFFDC CLKCON0 SFR 8FH ; CLKCON in LP51RD2 TPS_LP51RD2 SFR 0AEH MOV CLKCON0,#0000_1001B ; Use /TPS+1 Timer then select /1 Baud MOV TPS_LP51RD2,#(6-1)*16 ; Div6 during Baud RST default ELSE MOV T2CON,#34H ;Baud Mode, but changed later so spare ENDIF MOV SCON,#5AH ;INITIALIZE SFR'S ; ;***************************************************************************** ;****** Use XTAL up to 47 MHz ************************************************ ;****** Wulf 2 *************************************************************** ; ; MOV TMOD,#10H ; mov TMOD,#11H ;Use 16 bit mode of timer 0 ; ;***************************************************************************** ; MOV TCON,#54H ; DB 75H ;MOV DIRECT, # OP CODE ; DB 0C8H ;T2CON LOCATION ; DB 34H ;CONFIGURATION BYTE ; MOV DPTR,#2001H ;READ CODE AT 2001H << Outside classic 8052 on-chip code CLR A MOVC A,@A+DPTR CJNE A,#0AAH,CRST1 ;IF IT IS AN AAH, DO USER RESET LCALL 2090H ; CRST1: MOV R0,#IRAMTOP ;PUT THE TOP OF RAM IN R0 CLR A ;ZERO THE ACC ; CRST2: MOV @R0,A ;CLEAR INTERNAL MEMORY DJNZ R0,CRST2 ;LOOP TIL DONE ; ; Now, test the external memory ; MOV SPSAV,#CMNDSP ;SET UP THE STACK MOV SP,SPSAV ; ;***************************************************************************** ;****** Karmann 1 Bugfix ***************************************************** ; lcall TEST_USER ;chek for user command extensions ; ;****** continue with original code: ***************************************** ; MOV BOFAH,#HIGH ROMADR MOV BOFAL,#LOW ROMADR+17 MOV DPTR,#ROMADR ;GET THE BYTE AT 8000H MOVX A,@DPTR CLR C SUBB A,#31H ;FOR BIAS MOV MT1,A ;SAVE IN DIRECT MATH LOC CLR ACC.2 ;SAVE FOR RESET MOV R7,A ;SAVE IT IN R7 INC DPTR ACALL L31DPI ;SAVE BAUD RATE LCALL RCL INC DPTR ;GET MEMTOP ACALL L31DPI MOV DPTR,#5FH ;READ THE EXTERNAL BYTE MOVX A,@DPTR MOV DPTR,#0 ;ESTABLISH BASE FOR CLEAR CJNE A,#0A5H,CRS ;Erase the memory MOV A,MT1 CLR ACC.0 ;CLEAR BIT ONE XRL A,#4H JZ CR2 ; CRS: CJNE R7,#2,CRS1 SJMP CRS2 CRS1: CJNE R7,#3,CR0 CRS2: ACALL CL_1 SJMP CR1 ; CR0: MOV R3,DPH ;SAVE THE DPTR MOV R1,DPL INC DPTR MOV A,#5AH MOVX @DPTR,A ;Test external memory MOVX A,@DPTR CJNE A,#5AH,CR1 CLR A MOVX @DPTR,A ; ;***************************************************************************** ;******* Skowronek alterations to programm EEPROM's in state of UV-EPROM's *** ; ; CJNE R3,#0E0H,CR0 ; ; CJNE R3,#03H,CR0 ;SimTest CJNE R3,#HIGH ROMADR-1,CR0 ;Stop the test at 8000H because CJNE R1,#LOW ROMADR-2,CR0 ;EEPROM starts here ; ;***************************************************************************** ; CR1: CJNE R3,#03H,CR11 ;NEED THIS MUCH RAM CR11: JC CRST MOV DPTR,#MEMTOP ;SAVE MEMTOP ACALL S31DP2 ;SAVE MEMTOP AND SEED RCELL ACALL CNEW ;CLEAR THE MEMORY AND SET UP POINTERS ; CR2: ACALL RC1 ;SET UP STACKS IF NOT DONE ; LCALL AXTAL0 ;DO THE CRYSTAL MOV A,MT1 ;GET THE RESET BYTE CJNE A,#5,CR20 LCALL 4039H CR20: JNC BG1 ;CHECK FOR 0,1,2,3, OR 4 JNB ACC.0,BG3 ;NO RUN IF WRONG TYPE MOV DPTR,#ROMADR+16 MOVX A,@DPTR ;READ THE BYTE CJNE A,#55H,BG3 LJMP CRUN ; ;***************************************************************************** ;******* New baudrate detection ********************************************** ;******* Wulf 3 alteration 1 ************************************************* ; ;BG1: CLR A ;DO BAUD RATE ; MOV R3,A ; MOV R1,A ; MOV R0,#4 ; JB RXD,$ ;LOOP UNTIL A CHARACTER IS RECEIVED ; ; ;BG2: DJNZ R0,$ ;FOUR CLOCKS, IN LOOP ; CALL DEC3211 ;NINE CLOCKS ; MOV R0,#2 ;ONE CLOCK ; JNB RXD,BG2 ;TWO CLOCKS, LOOP UNTIL DONE ; JB RXD,$ ;WAIT FOR STOP CHARACTER TO END ; JNB RXD,$ ; ;***************************************************************************** ;******* New processor type detection **************************************** ;******* Wulf 4 ************************************************************** ; LP51RD2 Fast = 1569802 Cycles, or 141.945ms to here ; Old code, std = 11824920 cycles, or 1069.2ms to here BG1: clr a ;autoBaud sense m Space = 0x20 =0b 0010 0000 = 6 low bits with Start mov t2con,a ; MCS-52 is /12 during polling, then /2 for T2.baud mov TH2,#0FFh mov TL2,#0F8h ; rounding pre-correction jb rxd,$ ; Wait for Start Bit mov t2con,#5 ;Timer2 start jnb rxd,$ mov t2con,a ;Timer2 stop jb rxd,$ jnb rxd,$ call sercalc ;r3=timer2 MSB default ; LP51RD2_Fast Tests :: T2W = 0x478 = 1144, (11.0592M/6)/(9600/6)-8 = 1144 ; RCAP2 = 0xFFB8 = 2^16-0xffb8 = 72 ( 11.0592M/16/9600) = 72 so want 72, with balanced margin on the timing ; Check Baud Boundary Margins TSim51 ; Baud T2W RCAP2W Term Maths ; 9900 0x461 -> 0xFFBA OK ; 9800 0x46C -> 0xFFB9 OK ; 9700 0x477 -> 0xFFB9 OK ; 9675 0x47B -> 0xFFB9 OK 9675/9600-1 = 0.0078125 1-9675/(11.0592M/(2^16-(0xffb9))/16) = 0.006184 ; 9660 0x47C -> 0xFFB8 OK 9660/9600-1 = 0.00625 ; 9650 0x47D -> 0xFFB8 OK ; 9600 0x484 -> 0xFFB8 OK ; 9540 0x48B -> 0xFFB8 OK 9540/9600-1 = -0.00625 ; 9520 0x48D -> 0xFFB7 OK 9520/9600-1 = -0.00833 1-9520/(11.0592M/(2^16-(0xffb7))/16)= -0.005439814815 ; 9500 0x48F -> 0xffb7 OK Extended_Baud_Start: IF (OldInfineon5xx = ON) cjne a,ADCON,BG10 ;jump if A/D processor like 805x5 BG14: mov a,S0RELL cjne a,#B9600,BG2 ;jump if not 805x7A mov a,r3 anl S0RELH,a mov S0RELL,r1 ;start Baudratetimer 805X7A sjmp BG11 ; BG10: cjne r1,#B9600,BG12 ;jump if wrong fast baud rate BG11: orl PCON0,#080h ;setb smod for fast mode sjmp BG13 ; BG12: cjne r1,#B4800,BG14 ;jump if wrong slow baudrate BG13: setb BD ;enable baudrategenerator sjmp BG15 ; Size_Extended_Baud_Start EQU $-Extended_Baud_Start ;packer needed for AJMPs 0x1e = 30 Bytes ELSE REPT 30-($-Extended_Baud_Start) NOP ENDM ENDIF BG2: mov t2con,#34h ;configure Timer2 as baudrate generator BG15: CALL RCL ;LOAD THE TIMER ; ;****** Original code from here ********************************************** ; BG3: MOV DPTR,#S_N ;GET THE MESSAGE ACALL CRP ;PRINT IT LJMP CRAM ; ;*************************************************************** ; ; CIPROG AND CPROG - Program a prom ; ;*************************************************************** ; PG8: MOV R7,#00H ;PROGRAM ONE BYTE AT A TIME MOV R6,#01H MOV R2,#HIGH ROMADR-1 MOV R0,#LOW ROMADR-1;LOAD PROM ADDRESS ACALL PG101 INC R6 MOV A,RCAPH2 ; DB 0E5H ;MOV A DIRECT OP CODE ; DB 0CBH ;ADDRESS OF R2CAP HIGH ACALL PG101 MOV A,RCAPL2 ; DB 0E5H ;MOV A, DIRECT OP CODE ; DB 0CAH ;R2CAP LOW MOV R6,#3 MOV R1,#LOW MEMTOP-1 MOV R3,#HIGH MEMTOP ACALL PG101 ;SAVE MEMTOP SJMP PGR ; ; ;***************************************************************************** ;****** Skowronek alterations to programm EEPROM's in state of UV-EPROM's **** ;****** Support the "PGM" statement was added by D. Wulf ********************* ;****** Disable Intel programming and code optimize by H.-J. Boehling ******** ; ;CIPROG: MOV DPTR,#IPROGS ;LOAD IPROG LOCATION ; SETB INTELB ; SJMP CPROG1 ;GO DO PROG ; ; ;CPROG: MOV DPTR,#PROGS ;LOAD PROG LOCATION ; CLR INTELB ; ; ;CPROG1: ACALL LD_T ;LOAD THE TIMER ; CLR PROMV ;TURN ON THE PROM VOLTAGE ; CALL DELTST ;SEE IF A CR ; JNZ PG8 ;SAVE TIMER IF SO ; MOV R4,#0FEH ; SETB INBIT ; ACALL ROMFD ;GET THE ROM ADDRESS OF THE LAST LOCATION ; CALL TEMPD ;SAVE THE ADDRESS ; MOV A,R4 ;GET COUNT ; CPL A ; CALL TWO_R2 ;PUT IT ON THE STACK ; CALL FP_BASE7 ;OUTPUT IT ; ACALL CCAL ;GET THE PROGRAM ; ACALL CRLF ;DO CRLF ; MOV R0,TEMP4 ;GET ADDRESS ; MOV R2,TEMP5 ; MOV A,#55H ;LOAD SIGNIFIER ; INC R6 ;LOAD LEN + 1 ; CJNE R6,#00,CPROG2 ; INC R7 ;CPROG2: ACALL PG102 ; ;PGR: SETB PROMV ; AJMP C_K ; ;PG1: MOV P2,R3 ;GET THE BYTE TO PROGRAM ; MOVX A,@R1 ;PG101: LCALL INC3210 ;BUMP POINTERS ;PG102: MOV R5,#1 ;SET UP INTELLIGENT COUMTER ; ;PG2: MOV R4,A ;SAVE THE BYTE IN R4 ; ACALL PG7 ;PROGRAM THE BYTE ; ACALL PG9 ; JB INTELB,PG4 ;SEE IF INTELLIGENT PROGRAMMING ; ;PG3: XRL A,R4 ; JNZ PG6 ;ERROR IF NOT THE SAME ; CALL DEC76 ;BUMP THE COUNTERS ; JNZ PG1 ;LOOP IF NOT DONE ; ANL PSW,#11100111B ;INSURE RB0 ;PG31: RET ; ;PG4: XRL A,R4 ;SEE IF PROGRAMMED ; JNZ PG5 ;JUMP IF NOT ; MOV A,R4 ;GET THE DATA BACK ; ACALL PG7 ;PROGRAM THE LOCATION ;PG41: ACALL ZRO ;AGAIN ; ACALL ZRO ;AND AGAIN ; ACALL ZRO ;AND AGAIN ; DJNZ R5,PG41 ;KEEP DOING IT ; ACALL PG9 ;RESET PROG ; SJMP PG3 ;FINISH THE LOOP ; ;PG5: INC R5 ;BUMP THE COUNTER ; MOV A,R4 ;GET THE BYTE ; CJNE R5,#25,PG2 ;SEE IF TRIED 25 TIMES ; ;PG6: SETB PROMV ;TURN OFF PROM VOLTAGE ; MOV PSW,#0 ;INSURE RB0 ; JNB DIRF,PG31 ;EXIT IF IN RUN MODE ; MOV DPTR,#E16X ;PROGRAMMING ERROR ; ;ERRLK: LJMP ERROR ;PROCESS THE ERROR ; ;PG7: MOV P0,R0 ;SET UP THE PORTS ; MOV P2,R2 ;LATCH LOW ORDER ADDRESS ; ACALL PG11 ;DELAY FOR 8748/9 ; CLR ALED ; MOV P0,A ;PUT DATA ON THE PORT ; ; ;ZRO: NOP ;SETTLEING TIME + FP ZERO ; NOP ; NOP ; NOP ; NOP ; NOP ; ACALL PG11 ;DELAY A WHILE ; CLR PROMP ;START PROGRAMMING ; ACALL TIMER_LOAD ;START THE TIMER ; JNB TF1,$ ;WAIT FOR PART TO PROGRAM ; RET ;EXIT ; ;PG9: SETB PROMP ; ACALL PG11 ;DELAY FOR A WHILE ; JNB P3.2,$ ;LOOP FOR EEPROMS ; MOV P0,#0FFH ; CLR P3.7 ;LOWER READ ; ACALL PG11 ; MOV A,P0 ;READ THE PORT ; SETB P3.7 ; SETB ALED ; RET ; ;PG11: MOV TEMP5,#12 ;DELAY 30uS AT 12 MHZ ; DJNZ TEMP5,$ ; RET ; ; ;************************************************************** ; ; ;PGU: ;PROGRAM A PROM FOR THE USER ; ; ; ;************************************************************** ; ; CLR PROMV ;TURN ON THE VOLTAGE ; MOV PSW,#00011000B ;SELECT RB3 ; ACALL PG1 ;DO IT ; SETB PROMV ;TURN IT OFF ; RET ; ;****** alteredet code starts here: ****************************************** ; CPROG: MOV DPTR,#PROGS ;LOAD PROG LOCATION ; CPROG1: ACALL LD_T ;LOAD THE TIMER CALL DELTST ;SEE IF A CR JNZ PG8 ;SAVE TIMER IF SO MOV R4,#0FEH SETB INBIT ACALL ROMFD ;GET THE ROM ADDRESS OF THE LAST LOCATION CALL TEMPD ;SAVE THE ADDRESS MOV A,R4 ;GET COUNT CPL A CALL TWO_R2 ;PUT IT ON THE STACK CALL FP_BASE7 ;OUTPUT IT ACALL CCAL ;GET THE PROGRAM ACALL CRLF ;DO CRLF MOV R0,TEMP4 ;GET ADDRESS MOV R2,TEMP5 MOV A,#55H ;LOAD SIGNIFIER INC R6 ;LOAD LEN + 1 INC R7 CPROG2: ACALL PG2 ; PGR: AJMP C_K ;Exit to command mode ; PG101: INC R7 CJNE R6,#0,PG4 DEC R7 SJMP PG4 ; PG10: INC R7 ; PG1: MOV P2,R3 ;GET THE BYTE TO PROGRAM MOVX A,@R1 PG4: LCALL INC3210 ;BUMP POINTERS ; PG2: ACALL PG7 ;Write the byte JNZ PG5 ;exit if error DJNZ R6,PG1 DJNZ R7,PG1 ;LOOP IF NOT DONE ; PG5: ANL PSW,#11100111B ;INSURE RB0 JZ PG31 ;Jump if none error ; PG6: JNB DIRF,PG31 ;EXIT IF IN RUN MODE MOV DPTR,#E16X ;PROGRAMMING ERROR ERRLK: LJMP ERROR ;PROCESS THE ERROR ; ; PG7: MOV R4,A ;SAVE THE BYTE IN R4 for error detect mov dph,r2 ;load data pointer with eeprom address mov dpl,r0 movx @dptr,a ;write the byte DB 07DH ;mov r5,#0 ; ZRO: NOP NOP ;SETTLEING TIME + FP ZERO NOP ;Atenttion. This 6 NOP's a not only NOP ;for settleing time, it is also the NOP ;floating point zero! NOP MOV TEMP5,#12 ;DELAY 30uS AT 12 MHZ DJNZ TEMP5,$ ACALL TIMER_LOAD ;START THE TIMER JNB TF1,$ ;WAIT FOR PART TO PROGRAM movx A,@DPTR ;Read back for error detect xrl A,R4 ;Test for error jz PG31 djnz r5,ZRO PG31: RET ; ;************************************************************** ; PGU: ;PROGRAM A PROM FOR THE USER (statement 'PGM') ; ;************************************************************** ; MOV PSW,#00011000B ;SELECT RB3 CJNE R6,#0,PG10 SJMP PG1 ; ;***************************************************************************** ;****** The new command "ERASE" to fill a EEPROM with 0FFH ******************* ;****** Boehling 3 *********************************************************** ; CERASE: mov R7,#40H ;Erase 16K byte mov R6,#00H mov R2,#HIGH ROMADR-1 ;Startaddress EEPROM mov R0,#LOW ROMADR-1 mov DPTR,#PROGS ;Point to EEPROM timeing acall LD_T ;Load the timer ; ERA1: lcall INC3210 ;Bump pointers mov A,#0FFH ;Fill the EEPROM with 0FFH acall PG7 ;Write the byte jnz PG6 ;Exit if error DJNZ R6,ERA1 DJNZ R7,ERA1 ;Do the loop ajmp C_K ;Exit to command mode ; ;***************************************************************************** ; ;****** continue with original code: ***************************************** ; ;************************************************************* ; CCAL: ; Set up for prom moves ; R3:R1 gets source ; R7:R6 gets # of bytes ; ;************************************************************* ; ACALL GETEND ;GET THE LAST LOCATION INC DPTR ;BUMP TO LOAD EOF MOV R3,BOFAH MOV R1,BOFAL ;RESTORE START CLR C ;PREPARE FOR SUBB MOV A,DPL ;SUB DPTR - BOFA > R7:R6 SUBB A,R1 MOV R6,A MOV A,DPH SUBB A,R3 MOV R7,A CCAL1: RET ; ;************************************************************** ; TIMER_LOAD:; Load the timer ; ;************************************************************* ; ACALL CCAL1 ;DELAY FOUR CLOCKS TIMER_LOAD1: CLR TR1 ;STOP IT WHILE IT'S LOADED MOV TH1,T_HH MOV TL1,T_LL CLR TF1 ;CLEAR THE OVERFLOW FLAG SETB TR1 ;START IT NOW RET ; ;*************************************************************** ; CROM: ; The command action routine - ROM - Run out of rom ; ;*************************************************************** ; CLR CONB ;CAN'T CONTINUE IF MODE CHANGE ACALL RO1 ;DO IT ; C_K: LJMP CL3 ;EXIT ; ;RO1: CALL INTGER ;SEE IF INTGER PRESENT ; MOV R4,R0B0 ;SAVE THE NUMBER ; JNC $+4 ; MOV R4,#01H ;ONE IF NO INTEGER PRESENT ; ACALL ROMFD ;FIND THE PROGRAM ; RO1: CALL DELTST MOV R4,#1 JNC RO11 CALL ONE MOV R4,A ; RO11: ACALL ROMFD CJNE R4,#0,RFX ;EXIT IF R4 <> 0 INC DPTR ;BUMP PAST TAG MOV BOFAH,DPH ;SAVE THE ADDRESS MOV BOFAL,DPL RET ; ROMFD: MOV DPTR,#ROMADR+16 ;START OF USER PROGRAM ; RF1: MOVX A,@DPTR ;GET THE BYTE CJNE A,#55H,RF3 ;SEE IF PROPER TAG DJNZ R4,RF2 ;BUMP COUNTER ; RFX: RET ;DPTR HAS THE START ADDRESS ; RF2: INC DPTR ;BUMP PAST TAG ACALL G5 INC DPTR ;BUMP TO NEXT PROGRAM SJMP RF1 ;DO IT AGAIN ; RF3: JBC INBIT,RFX ;EXIT IF SET ; NOGO: MOV DPTR,#NOROM AJMP ERRLK ; ;*************************************************************** ; L20DPI: ; load R2:R0 with the location the DPTR is pointing to ; ;*************************************************************** ; MOVX A,@DPTR MOV R2,A INC DPTR MOVX A,@DPTR MOV R0,A RET ;DON'T BUMP DPTR ; ;*************************************************************** ; X31DP: ; swap R3:R1 with DPTR ; ;*************************************************************** ; XCH A,R3 XCH A,DPH XCH A,R3 XCH A,R1 XCH A,DPL XCH A,R1 RET ; ;*************************************************************** ; LD_T: ; Load the timer save location with the value the DPTR is ; pointing to. ; ;**************************************************************** ; MOVX A,@DPTR MOV T_HH,A INC DPTR MOVX A,@DPTR MOV T_LL,A RET ; ; ;*************************************************************** ; ;GETLIN - FIND THE LOCATION OF THE LINE NUMBER IN R3:R1 ; IF ACC = 0 THE LINE WAS NOT FOUND I.E. R3:R1 ; WAS TOO BIG, ELSE ACC <> 0 AND THE DPTR POINTS ; AT THE LINE THAT IS GREATER THAN OR EQUAL TO THE ; VALUE IN R3:R1. ; ;*************************************************************** ; GETEND: SETB ENDBIT ;GET THE END OF THE PROGRAM ; GETLIN: CALL DP_B ;GET BEGINNING ADDRESS ; G1: CALL B_C JZ G3 ;EXIT WITH A ZERO IN A IF AT END INC DPTR ;POINT AT THE LINE NUMBER JB ENDBIT,G2 ;SEE IF WE WANT TO FIND THE END ACALL DCMPX ;SEE IF (DPTR) = R3:R1 ACALL DECDP ;POINT AT LINE COUNT MOVX A,@DPTR ;PUT LINE LENGTH INTO ACC JB UBIT,G3 ;EXIT IF EQUAL JC G3 ;SEE IF LESS THAN OR ZERO ; G2: ACALL ADDPTR ;ADD IT TO DPTR SJMP G1 ;LOOP ; G3: CLR ENDBIT ;RESET ENDBIT RET ;EXIT ; G4: MOV DPTR,#PSTART ;DO RAM ; G5: SETB ENDBIT SJMP G1 ;NOW DO TEST ; ;*************************************************************** ; ; LDPTRI - Load the DATA POINTER with the value it is pointing ; to - DPH = (DPTR) , DPL = (DPTR+1) ; ; acc gets wasted ; ;*************************************************************** ; LDPTRI: MOVX A,@DPTR ;GET THE HIGH BYTE PUSH ACC ;SAVE IT INC DPTR ;BUMP THE POINTER MOVX A,@DPTR ;GET THE LOW BYTE MOV DPL,A ;PUT IT IN DPL POP DPH ;GET THE HIGH BYTE RET ;GO BACK ; ;*************************************************************** ; ;L31DPI - LOAD R3 WITH (DPTR) AND R1 WITH (DPTR+1) ; ;ACC GETS CLOBBERED ; ;*************************************************************** ; L31DPI: MOVX A,@DPTR ;GET THE HIGH BYTE MOV R3,A ;PUT IT IN THE REG INC DPTR ;BUMP THE POINTER MOVX A,@DPTR ;GET THE NEXT BYTE MOV R1,A ;SAVE IT RET ; ;*************************************************************** ; ;DECDP - DECREMENT THE DATA POINTER - USED TO SAVE SPACE ; ;*************************************************************** ; DECDP2: ACALL DECDP ; DECDP: XCH A,DPL ;GET DPL JNZ DECDP1 ;BUMP IF ZERO DEC DPH DECDP1: DEC A ;DECREMENT IT XCH A,DPL ;GET A BACK RET ;EXIT ; ;*************************************************************** ; ;DCMPX - DOUBLE COMPARE - COMPARE (DPTR) TO R3:R1 ;R3:R1 - (DPTR) = SET CARRY FLAG ; ;IF R3:R1 > (DPTR) THEN C = 0 ;IF R3:R1 < (DPTR) THEN C = 1 ;IF R3:R1 = (DPTR) THEN C = 0 ; ;*************************************************************** ; DCMPX: CLR UBIT ;ASSUME NOT EQUAL MOVX A,@DPTR ;GET THE BYTE CJNE A,R3B0,D1 ;IF A IS GREATER THAN R3 THEN NO CARRY ;WHICH IS R3<@DPTR = NO CARRY AND ;R3>@DPTR CARRY IS SET INC DPTR ;BUMP THE DATA POINTER MOVX A,@DPTR ;GET THE BYTE ACALL DECDP ;PUT DPTR BACK CJNE A,R1B0,D1 ;DO THE COMPARE CPL C ;FLIP CARRY ; CPL UBIT ;SET IT D1: CPL C ;GET THE CARRY RIGHT RET ;EXIT ; ;*************************************************************** ; ; ADDPTR - Add acc to the dptr ; ; acc gets wasted ; ;*************************************************************** ; ADDPTR: ADD A,DPL ;ADD THE ACC TO DPL MOV DPL,A ;PUT IT IN DPL JNC ADDPTR1 ;JUMP IF NO CARRY INC DPH ;BUMP DPH ADDPTR1:RET ;EXIT ; ;************************************************************* ; LCLR: ; Set up the storage allocation ; ;************************************************************* ; ACALL ICLR ;CLEAR THE INTERRUPTS ACALL G4 ;PUT END ADDRESS INTO DPTR MOV A,#6 ;ADJUST MATRIX SPACE ACALL ADDPTR ;ADD FOR PROPER BOUNDS ACALL X31DP ;PUT MATRIX BOUNDS IN R3:R1 MOV DPTR,#MT_ALL ;SAVE R3:R1 IN MATRIX FREE SPACE ACALL S31DP ;DPTR POINTS TO MEMTOP ACALL L31DPI ;LOAD MEMTOP INTO R3:R1 MOV DPTR,#STR_AL ;GET MEMORY ALLOCATED FOR STRINGS ACALL LDPTRI CALL DUBSUB ;R3:R1 = MEMTOP - STRING ALLOCATION MOV DPTR,#VARTOP ;SAVE R3:R1 IN VARTOP ; ; FALL THRU TO S31DP2 ; ;*************************************************************** ; ;S31DP - STORE R3 INTO (DPTR) AND R1 INTO (DPTR+1) ; ;ACC GETS CLOBBERED ; ;*************************************************************** ; S31DP2: ACALL S31DP ;DO IT TWICE ; S31DP: MOV A,R3 ;GET R3 INTO ACC MOVX @DPTR,A ;STORE IT INC DPTR ;BUMP DPTR MOV A,R1 ;GET R1 MOVX @DPTR,A ;STORE IT INC DPTR ;BUMP IT AGAIN TO SAVE PROGRAM SPACE RET ;GO BACK ; ; ;*************************************************************** ; STRING: ; Allocate memory for strings ; ;*************************************************************** ; LCALL TWO ;R3:R1 = NUMBER, R2:R0 = LEN MOV DPTR,#STR_AL ;SAVE STRING ALLOCATION ACALL S31DP INC R6 ;BUMP MOV S_LEN,R6 ;SAVE STRING LENGTH AJMP RCLEAR ;CLEAR AND SET IT UP ; ;*************************************************************** ; ; F_VAR - Find the variable in symbol table ; R7:R6 contain the variable name ; If not found create a zero entry and set the carry ; R2:R0 has the address of variable on return ; ;*************************************************************** ; F_VAR: MOV DPTR,#VARTOP ;PUT VARTOP IN DPTR ACALL LDPTRI ACALL DECDP2 ;ADJUST DPTR FOR LOOKUP ; F_VAR0: MOVX A,@DPTR ;LOAD THE VARIABLE JZ F_VAR2 ;TEST IF AT THE END OF THE TABLE INC DPTR ;BUMP FOR NEXT BYTE CJNE A,R7B0,F_VAR1 ;SEE IF MATCH MOVX A,@DPTR ;LOAD THE NAME CJNE A,R6B0,F_VAR1 ; ; Found the variable now adjust and put in R2:R0 ; DLD: MOV A,DPL ;R2:R0 = DPTR-2 SUBB A,#2 MOV R0,A MOV A,DPH SUBB A,#0 ;CARRY IS CLEARED MOV R2,A RET ; F_VAR1: MOV A,DPL ;SUBTRACT THE STACK SIZE+ADJUST CLR C SUBB A,#STESIZ MOV DPL,A ;RESTORE DPL JNC F_VAR0 DEC DPH SJMP F_VAR0 ;CONTINUE COMPARE ; ; ; Add the entry to the symbol table ; F_VAR2: LCALL R76S ;SAVE R7 AND R6 CLR C ACALL DLD ;BUMP THE POINTER TO GET ENTRY ADDRESS ; ; Adjust pointer and save storage allocation ; and make sure we aren't wiping anything out ; First calculate new storage allocation ; MOV A,R0 SUBB A,#STESIZ-3 ;NEED THIS MUCH RAM MOV R1,A MOV A,R2 SUBB A,#0 MOV R3,A ; ; Now save the new storage allocation ; MOV DPTR,#ST_ALL CALL S31DP ;SAVE STORAGE ALLOCATION ; ; Now make sure we didn't blow it, by wiping out MT_ALL ; ACALL DCMPX ;COMPARE STORAGE ALLOCATION JC CCLR3 ;ERROR IF CARRY SETB C ;DID NOT FIND ENTRY RET ;EXIT IF TEST IS OK ; ;*************************************************************** ; ; Command action routine - NEW ; ;*************************************************************** ; CNEW: MOV DPTR,#PSTART ;SAVE THE START OF PROGRAM MOV A,#EOF ;END OF FILE MOVX @DPTR,A ;PUT IT IN MEMORY ; ; falls thru ; ;***************************************************************** ; ; The statement action routine - CLEAR ; ;***************************************************************** ; CNEW1: CLR LINEB ;SET UP FOR RUN AND GOTO ; RCLEAR: ACALL LCLR ;CLEAR THE INTERRUPTS, SET UP MATRICES MOV DPTR,#MEMTOP ;PUT MEMTOP IN R3:R1 ACALL L31DPI ACALL G4 ;DPTR GETS END ADDRESS ACALL CL_1 ;CLEAR THE MEMORY ; RC1: MOV DPTR,#STACKTP ;POINT AT CONTROL STACK TOP CLR A ;CONTROL UNDERFLOW ; RC2: MOVX @DPTR,A ;SAVE IN MEMORY MOV CSTKA,#STACKTP MOV ASTKA,#STACKTP CLR CONB ;CAN'T CONTINUE RET ; ;*************************************************************** ; ; Loop until the memory is cleared ; ;*************************************************************** ; CL_1: INC DPTR ;BUMP MEMORY POINTER CLR A ;CLEAR THE MEMORY MOVX @DPTR,A ;CLEAR THE RAM MOVX A,@DPTR ;READ IT JNZ CCLR3 ;MAKE SURE IT IS CLEARED MOV A,R3 ;GET POINTER FOR COMPARE CJNE A,DPH,CL_1 ;SEE TO LOOP MOV A,R1 ;NOW TEST LOW BYTE CJNE A,DPL,CL_1 ; CL_2: RET ; CCLR3: JMP TB ;ALLOCATED MEMORY DOESN'T EXSIST ; ;************************************************************** ; SCLR: ;Entry point for clear return ; ;************************************************************** ; CALL DELTST ;TEST FOR A CR JNC RCLEAR CALL GCI1 ;BUMP THE TEST POINTER CJNE A,#'I',RC1 ;SEE IF I, ELSE RESET THE STACK ; ;************************************************************** ; ICLR: ; Clear interrupts and system garbage ; ;************************************************************** ; JNB INTBIT,ICLR1 ;SEE IF BASIC HAS INTERRUPTS CLR EX1 ;IF SO, CLEAR INTERRUPTS ICLR1: ANL 34,#00100000B ;SET INTERRUPTS + CONTINUE RETI ; ;*************************************************************** ; ;OUTPUT ROUTINES ; ;*************************************************************** ; CRLF2: ACALL CRLF ;DO TWO CRLF'S ; CRLF: MOV R5,#CR ;LOAD THE CR ACALL TEROT ;CALL TERMINAL OUT MOV R5,#LF ;LOAD THE LF AJMP TEROT ;OUTPUT IT AND RETURN ; ;PRINT THE MESSAGE ADDRESSED IN ROM OR RAM BY THE DPTR ;ENDS WITH THE CHARACTER IN R4 ;DPTR HAS THE ADDRESS OF THE TERMINATOR ; CRP: ACALL CRLF ;DO A CR THEN PRINT ROM ; ROM_P: CLR A ;CLEAR A FOR LOOKUP MOVC A,@A+DPTR ;GET THE CHARACTER CLR ACC.7 ;CLEAR MS BIT CJNE A,#'"',ROM_P1 ;EXIT IF TERMINATOR RET ROM_P1: SETB C0ORX1 ; PN1: MOV R5,A ;OUTPUT THE CHARACTER ACALL TEROT INC DPTR ;BUMP THE POINTER SJMP PN0 ; UPRNT: ACALL X31DP ; PRNTCR: MOV R4,#CR ;OUTPUT UNTIL A CR ; PN0: JBC C0ORX1,ROM_P MOVX A,@DPTR ;GET THE RAM BYTE JZ PN01 CJNE A,R4B0,PN02 ;SEE IF THE SAME AS TERMINATOR PN01: RET ;EXIT IF THE SAME PN02: CJNE A,#CR,PN1 ;NEVER PRINT A CR IN THIS ROUTINE LJMP E1XX ;BAD SYNTAX ; ;*************************************************************** ; ; INLINE - Input a line to IBUF, exit when a CR is received ; ;*************************************************************** ; INL2: CJNE A,#CNTRLD,INL2B ;SEE IF A CONTROL D ; INL0: ACALL CRLF ;DO A CR ; INLINE: MOV P2,#HIGH IBUF ;IBUF IS IN THE ZERO PAGE MOV R0,#LOW IBUF ;POINT AT THE INPUT BUFFER ; INL1: ACALL INCHAR ;GET A CHARACTER MOV R5,A ;SAVE IN R5 FOR OUTPUT CJNE A,#7FH,INL2 ;SEE IF A DELETE CHARACTER CJNE R0,#LOW IBUF,INL6 INL11: MOV R5,#BELL ;OUTPUT A BELL ; INLX: ACALL TEROT ;OUTPUT CHARACTER SJMP INL1 ;DO IT AGAIN ; INL2B: MOVX @R0,A ;SAVE THE CHARACTER CJNE A,#CR,INL2B1 ;IS IT A CR AJMP CRLF ;OUTPUT A CRLF AND EXIT INL2B1: CJNE A,#20H,INL2B2 INL2B2: JC INLX ;ONLY ECHO CONTROL CHARACTERS INC R0 ;BUMP THE POINTER CJNE R0,#IBUF+79,INLX DEC R0 ;FORCE 79 SJMP INL11 ;OUTPUT A BELL ; INL6: DEC R0 ;DEC THE RAM POINTER MOV R5,#BS ;OUTPUT A BACK SPACE ACALL TEROT ACALL STEROT ;OUTPUT A SPACE MOV R5,#BS ;ANOTHER BACK SPACE SJMP INLX ;OUTPUT IT ; ;***************************************************************************** ;****** Use XTAL up to 47 MHz ************************************************ ;****** Wulf 2 *************************************************************** ; ;PTIME: DB 128-2 ;PROM PROGRAMMER TIMER ; DB 00H ; DB 00H ; DB 50H ; DB 67H ; DB 41H ; ptime: db 128-3 ;New programmer timer value is old value db 00H ;divide by 5 db 00H ;(50ms EPROM timeing to 10ms for EEPROM) db 00H db 35H db 83H ; ;***************************************************************************** ; ;*************************************************************** ; ; TEROT - Output a character to the system console ; update PHEAD position. ; ;*************************************************************** ; STEROT: MOV R5,#' ' ;OUTPUT A SPACE ; TEROT: PUSH ACC ;SAVE THE ACCUMULATOR PUSH DPH ;SAVE THE DPTR PUSH DPL TEROT01:JNB CNT_S,TEROT02 ;WAIT FOR A CONTROL Q ACALL BCK ;GET SERIAL STATUS SJMP TEROT01 TEROT02:MOV A,R5 ;PUT OUTPUT BYTE IN A JNB BO,TEROT03 ;CHECK FOR MONITOR LCALL 2040H ;DO THE MONITOR AJMP TEROT1 ;CLEAN UP TEROT03:JNB COUB,TEROT04 ;SEE IF USER WANTS OUTPUT LCALL 4030H AJMP TEROT1 TEROT04:JNB UPB,T_1 ;NO AT IF NO XBIT JNB LPB,T_1 ;AT PRINT LCALL 403CH ;CALL AT LOCATION AJMP TEROT1 ;FINISH OFF OUTPUT ; T_1: JNB COB,TXX ;SEE IF LIST SET MOV DPTR,#SPV ;LOAD BAUD RATE ACALL LD_T CLR LP ;OUTPUT START BIT ACALL TIMER_LOAD ;LOAD AND START THE TIMER MOV A,R5 ;GET THE OUTPUT BYTE SETB C ;SET CARRY FOR LAST OUTPUT MOV R5,#9 ;LOAD TIMER COUNTDOWN ; LTOUT1: RRC A ;ROTATE A JNB TF1,$ ;WAIT TILL TIMER READY MOV LP,C ;OUTPUT THE BIT ACALL TIMER_LOAD ;DO THE NEXT BIT DJNZ R5,LTOUT1 ;LOOP UNTIL DONE JNB TF1,$ ;FIRST STOP BIT ACALL TIMER_LOAD JNB TF1,$ ;SECOND STOP BIT MOV R5,A ;RESTORE R5 SJMP TEROT1 ;BACK TO TEROT ; TXX: JNB TI,$ ;WAIT FOR TRANSMIT READY CLR TI MOV SBUF,R5 ;SEND OUT THE CHARACTER ; TEROT1: CJNE R5,#CR,TEROT11 ;SEE IF A CR MOV PHEAD,#00H ;IF A CR, RESET PHEAD AND ; TEROT11:CJNE R5,#LF,NLC ;SEE IF A LF MOV A,NULLCT ;GET THE NULL COUNT JZ NLC ;NO NULLS IF ZERO ; TEROT2: MOV R5,#NULL ;PUT THE NULL IN THE OUTPUT REGISTER ACALL TEROT ;OUTPUT THE NULL DEC A ;DECREMENT NULL COUNT JNZ TEROT2 ;LOOP UNTIL DONE ; NLC: CJNE R5,#BS,NLC1 ;DEC PHEAD IF A BACKSPACE DEC PHEAD NLC1: CJNE R5,#20H,NLC2 ;IS IT A PRINTABLE CHARACTER? NLC2: JC NLC3 ;DON'T INCREMENT PHEAD IF NOT PRINTABLE INC PHEAD ;BUMP PRINT HEAD NLC3: POP DPL ;RESTORE DPTR POP DPH POP ACC ;RESTORE ACC RET ;EXIT ; BCK: ACALL CSTS ;CHECK STATUS JNC CI_RET1 ;EXIT IF NO CHARACTER ; ;*************************************************************** ; ;INPUTS A CHARACTER FROM THE SYSTEM CONSOLE. ; ;*************************************************************** ; INCHAR: JNB BI,INCHAR1 ;CHECK FOR MONITOR (BUBBLE) LCALL 2060H SJMP INCH1 INCHAR1:JNB CIUB,INCHAR2 ;CHECK FOR USER LCALL 4033H SJMP INCH1 INCHAR2:JNB RI,$ ;WAIT FOR RECEIVER READY. MOV A,SBUF CLR RI ;RESET READY CLR ACC.7 ;NO BIT 7 ; INCH1: CJNE A,#13H,INCH11 SETB CNT_S INCH11: CJNE A,#11H,INCH12 CLR CNT_S INCH12: CJNE A,#CNTRLC,INCH13 JNB NO_C,C_EX ;TRAP NO CONTROL C RET ; ; ;***************************************************************************** ;****** Sorry - but the ego message had to be disabled *********************** ; INCH13: ; CLR JKBIT CJNE A,#17H,CI_RET ;CONTROL W ; SETB JKBIT ; ;***************************************************************************** ; CI_RET: SETB C ;CARRY SET IF A CHARACTER CI_RET1:RET ;EXIT ; ;************************************************************* ; ;RROM - The Statement Action Routine RROM ; ;************************************************************* ; RROM: SETB INBIT ;SO NO ERRORS ACALL RO1 ;FIND THE LINE NUMBER JBC INBIT,CRUN RET ;EXIT ; ;*************************************************************** ; CSTS: ; RETURNS CARRY = 1 IF THERE IS A CHARACTER WAITING FROM ; THE SYSTEM CONSOLE. IF NO CHARACTER THE READY CHARACTER ; WILL BE CLEARED ; ;*************************************************************** ; JNB BI,CSTS1 ;BUBBLE STATUS LJMP 2068H CSTS1: JNB CIUB,CSTS2 ;SEE IF EXTERNAL CONSOLE LJMP 4036H CSTS2: MOV C,RI RET ; ; ;***************************************************************************** ;****** Sorry - but the ego message had to be disabled *********************** ; ;C_EX0: MOV DPTR,#WB ;EGO MESSAGE ; ACALL ROM_P ; ;***************************************************************************** ; C_EX: CLR CNT_S ;NO OUTPUT STOP LCALL SPRINT1 ;ASSURE CONSOLE ACALL CRLF ; ;***************************************************************************** ;****** Sorry - but the ego message had to be disabled *********************** ; ; JBC JKBIT,C_EX0 ; ;***************************************************************************** ; JNB DIRF,SSTOP0 AJMP C_K ;CLEAR COB AND EXIT ; T_CMP: MOV A,TVH ;COMPARE TIMER TO SP_H AND SP_L MOV R1,TVL CJNE A,TVH,T_CMP XCH A,R1 SUBB A,SP_L MOV A,R1 SUBB A,SP_H RET ; ;************************************************************* ; BR0: ; Trap the timer interrupt ; ;************************************************************* ; CALL T_CMP ;COMPARE TIMER JC BCHR1 ;EXIT IF TEST FAILS SETB OTI ;DOING THE TIMER INTERRUPT CLR OTS ;CLEAR TIMER BIT MOV C,INPROG ;SAVE IN PROGRESS MOV ISAV,C MOV DPTR,#TIV SJMP BR2 ; ;*************************************************************** ; ; The command action routine - RUN ; ;*************************************************************** ; CRUN: LCALL CNEW1 ;CLEAR THE STORAGE ARRAYS ACALL SRESTR1 ;GET THE STARTING ADDRESS ACALL B_C JZ CMNDLK ;IF NULL GO TO COMMAND MODE ; ACALL T_DP ACALL B_TXA ;BUMP TO STARTING LINE ; CILOOP: ACALL SP0 ;DO A CR AND A LF CILOOP1:CLR DIRF ;NOT IN DIRECT MODE ; ;INTERPERTER DRIVER ; ILOOP: MOV SP,SPSAV ;RESTORE THE STACK EACH TIME JB DIRF,ILOOP1 ;NO INTERRUPTS IF IN DIRECT MODE MOV INTXAH,TXAH ;SAVE THE TEXT POINTER MOV INTXAL,TXAL ILOOP1: LCALL BCK ;GET CONSOLE STATUS JB DIRF,I_L ;DIRECT MODE ANL C,/GTRD ;SEE IF CHARACTER READY JNC BCHR ;NO CHARACTER = NO CARRY ; ; DO TRAP OPERATION ; MOV DPTR,#GTB ;SAVE TRAP CHARACTER MOVX @DPTR,A SETB GTRD ;SAYS READ A BYTE ; BCHR: JB OTI,I_L ;EXIT IF TIMER INTERRUPT IN PROGRESS JB OTS,BR0 ;TEST TIMER VALUE IF SET BCHR1: JNB INTPEN,I_L ;SEE IF INTERRUPT PENDING JB INPROG,I_L ;DON'T DO IT AGAIN IF IN PROGRESS MOV DPTR,#INTLOC ;POINT AT INTERRUPT LOCATION ; BR2: MOV R4,#GTYPE ;SETUP FOR A FORCED GOSUB ACALL SGS1 ;PUT TXA ON STACK SETB INPROG ;INTERRUPT IN PROGRESS ; ERL4: CALL L20DPI AJMP D_L1 ;GET THE LINE NUMBER ; I_L: ACALL ISTAT ;LOOP ACALL CLN_UP ;FINISH IT OFF JNC ILOOP ;LOOP ON THE DRIVER JNB DIRF,CMNDLK ;CMND1 IF IN RUN MODE LJMP CMNDR ;DON'T PRINT READY ; CMNDLK: JMP CMND1 ;DONE ;************************************************************** ; ; The Statement Action Routine - STOP ; ;************************************************************** ; SSTOP: ACALL CLN_UP ;FINISH OFF THIS LINE MOV INTXAH,TXAH ;SAVE TEXT POINTER FOR CONT MOV INTXAL,TXAL ; SSTOP0: SETB CONB ;CONTINUE WILL WORK MOV DPTR,#STP ;PRINT THE STOP MESSAGE SETB STOPBIT ;SET FOR ERROR ROUTINE JMP ERRS ;JUMP TO ERROR ROUTINE ; ;************************************************************** ; ; ITRAP - Trap special function register operators ; ;************************************************************** ; ITRAP: CJNE A,#TMR0,ITRAP1 ;TIMER 0 MOV TH0,R3 MOV TL0,R1 RET ; ITRAP1: CJNE A,#TMR1,ITRAP2 ;TIMER 1 MOV TH1,R3 MOV TL1,R1 RET ; ITRAP2: CJNE A,#TMR2,ITRAP3 ;TIMER 2 ITRAP21:MOV TH2,R3 MOV TL2,R1 ; DB 8BH ;MOV R3 DIRECT OP CODE ; DB 0CDH ;T2H LOCATION ; DB 89H ;MOV R1 DIRECT OP CODE ; DB 0CCH ;T2L LOCATION RET ; ITRAP3: CJNE A,#TRC2,RCL1 ;RCAP2 TOKEN RCL: MOV RCAPH2,R3 MOV RCAPL2,R1 ; DB 8BH ;MOV R3 DIRECT OP CODE ; DB 0CBH ;RCAP2H LOCATION ; DB 89H ;MOV R1 DIRECT OP CODE ; DB 0CAH ;RCAP2L LOCATION RET ; RCL1: ACALL R3CK ;MAKE SURE THAT R3 IS ZERO CJNE A,#TT2C,RCL2 MOV T2CON,R1 ; DB 89H ;MOV R1 DIRECT OP CODE ; DB 0C8H ;T2CON LOCATION RET ; RCL2: CJNE A,#T_IE,RCL3 ;IE TOKEN MOV IE,R1 RET ; RCL3: CJNE A,#T_IP,RCL4 ;IP TOKEN MOV IP,R1 RET ; RCL4: CJNE A,#TTC,RCL5 ;TCON TOKEN MOV TCON,R1 RET ; RCL5: CJNE A,#TTM,RCL6 ;TMOD TOKEN MOV TMOD,R1 RET ; RCL6: CJNE A,#T_P1,T_T2 ;P1 TOKEN MOV P1,R1 RET ; ;*************************************************************** ; ; T_TRAP - Trap special operators ; ;*************************************************************** ; T_T: MOV TEMP5,A ;SAVE THE TOKEN ACALL GCI1 ;BUMP POINTER ACALL SLET2 ;EVALUATE AFTER = MOV A,TEMP5 ;GET THE TOKEN BACK CJNE A,#T_XTAL,T_T01 LJMP AXTAL1 ;SET UP CRYSTAL ; T_T01: ACALL IFIXL ;R3:R1 HAS THE TOS MOV A,TEMP5 ;GET THE TOKEN AGAIN CJNE A,#T_MTOP,T_T1 ;SEE IF MTOP TOKEN MOV DPTR,#MEMTOP CALL S31DP JMP RCLEAR ;CLEAR THE MEMORY ; T_T1: CJNE A,#T_TIME,ITRAP ;SEE IF A TIME TOKEN MOV C,EA ;SAVE INTERRUPTS CLR EA ;NO TIMER 0 INTERRUPTS DURING LOAD MOV TVH,R3 ;SAVE THE TIME MOV TVL,R1 ; ;***************************************************************************** ;****** Reset millisecond counter on "TIME=" ********************************* ;****** Boehling 2 *********************************************************** ; mov MILLIV,#0 ;Reset millisecond counter ; ;***************************************************************************** ; MOV EA,C ;RESTORE INTERRUPTS RET ;EXIT ; T_T2: CJNE A,#T_PC,INTERX ;PCON TOKEN MOV PCON,R1 ; DB 89H ;MOV DIRECT, R1 OP CODE ; DB 87H ;ADDRESS OF PCON RET ;EXIT ; T_TRAP: CJNE A,#T_ASC,T_T ;SEE IF ASC TOKEN ACALL IGC ;EAT IT AND GET THE NEXT CHARACTER CJNE A,#'$',INTERX ;ERROR IF NOT A STRING ACALL CSY ;CALCULATE ADDRESS ACALL X3120 CALL TWO_EY ACALL SPEOP1 ;EVALUATE AFTER EQUALS AJMP ISTAX1 ;SAVE THE CHARACTER ; ;************************************************************** ; ;INTERPERT THE STATEMENT POINTED TO BY TXAL AND TXAH ; ;************************************************************** ; ISTAT: ACALL GC ;GET THR FIRST CHARACTER JNB XBIT,IAT ;TRAP TO EXTERNAL RUN PACKAGE CJNE A,#20H,ISTAT1 ISTAT1: JNC IAT LCALL 2070H ;LET THE USER SET UP THE DPTR ACALL GCI1 ANL A,#0FH ;STRIP OFF BIAS SJMP ISTA1 ; IAT: CJNE A,#T_XTAL,IAT1 IAT1: JNC T_TRAP JNB ACC.7,SLET ;IMPLIED LET IF BIT 7 NOT SET CJNE A,#T_UOP+12,ISTAX ;DBYTE TOKEN ACALL SPEOP ;EVALUATE SPECIAL OPERATOR ACALL R3CK ;CHECK LOCATION MOV @R1,A ;SAVE IT RET ; ISTAX: CJNE A,#T_UOP+13,ISTAY ;XBYTE TOKEN ACALL SPEOP ; ISTAX1: MOV P2,R3 MOVX @R1,A RET ; ISTAY: CJNE A,#T_CR+1,ISTAY1;TRAP NEW OPERATORS ISTAY1: JC I_S CJNE A,#0B0H,ISTAY2 ;SEE IF TOO BIG ISTAY2: JNC INTERX ADD A,#0F9H ;BIAS FOR LOOKUP TABLE SJMP ISTA0 ;DO THE OPERATION ; I_S: CJNE A,#T_LAST,I_S1 ;MAKE SURE AN INITIAL RESERVED WORD I_S1: JC INTERX1 ;ERROR IF NOT ; INTERX: LJMP E1XX ;SYNTAX ERROR ; INTERX1:JNB DIRF,ISTA0 ;EXECUTE ALL STATEMENTS IF IN RUN MODE CJNE A,#T_DIR,INTERX2;SEE IF ON TOKEN INTERX2:JC ISTA0 ;OK IF DIRECT CJNE A,#T_GOSB+1,INTERX3;SEE IF FOR SJMP ISTA0 ;FOR IS OK INTERX3:CJNE A,#T_REM+1,INTERX4 ;NEXT IS OK SJMP ISTA0 INTERX4:CJNE A,#T_STOP+6,INTERX ;SO IS REM ; ISTA0: ACALL GCI1 ;ADVANCE THE TEXT POINTER MOV DPTR,#STATD ;POINT DPTR TO LOOKUP TABLE CJNE A,#T_GOTO-3,ISTA01;SEE IF LET TOKEN SJMP ISTAT ;WASTE LET TOKEN ISTA01: ANL A,#3FH ;STRIP OFF THE GARBAGE ; ISTA1: RL A ;ROTATE FOR OFFSET ADD A,DPL ;BUMP MOV DPL,A ;SAVE IT CLR A MOVC A,@A+DPTR ;GET HIGH BYTE PUSH ACC ;SAVE IT INC DPTR CLR A MOVC A,@A+DPTR ;GET LOW BYTE POP DPH MOV DPL,A ; AC1: CLR A JMP @A+DPTR ;GO DO IT ; ;*************************************************************** ; ; The statement action routine - LET ; ;*************************************************************** ; SLET: ACALL S_C ;CHECK FOR POSSIBLE STRING JC SLET0 ;NO STRING CLR LINEB ;USED STRINGS ; CALL X31DP ;PUT ADDRESS IN DPTR MOV R7,#T_EQU ;WASTE = ACALL EATC ACALL GC ;GET THE NEXT CHARACTER CJNE A,#'"',S_3 ;CHECK FOR A " MOV R7,S_LEN ;GET THE STRING LENGTH ; S_0: ACALL GCI1 ;BUMP PAST " ACALL DELTST ;CHECK FOR DELIMITER JZ INTERX ;EXIT IF CARRIAGE RETURN MOVX @DPTR,A ;SAVE THE CHARACTER CJNE A,#'"',S_1 ;SEE IF DONE ; S_E: MOV A,#CR ;PUT A CR IN A MOVX @DPTR,A ;SAVE CR AJMP GCI1 ; S_3: PUSH DPH PUSH DPL ;SAVE DESTINATION ACALL S_C ;CALCULATE SOURCE JC INTERX ;ERROR IF CARRY POP R0B0 ;GET DESTINATION BACK POP R2B0 ; SSOOP: MOV R7,S_LEN ;SET UP COUNTER ; S_4: CALL TBYTE ;TRANSFER THE BYTE CJNE A,#CR,S_41 ;EXIT IF A CR RET S_41: DJNZ R7,S_5 ;BUMP COUNTER MOV A,#CR ;SAVE A CR MOVX @R0,A AJMP EIGP ;PRINT EXTRA IGNORED ; ; S_5: CALL INC3210 ;BUMP POINTERS SJMP S_4 ;LOOP ; S_1: DJNZ R7,S_11 ;SEE IF DONE ACALL S_E ACALL EIGP ;PRINT EXTRA IGNORED AJMP FINDCR ;GO FIND THE END S_11: INC DPTR ;BUMP THE STORE POINTER SJMP S_0 ;CONTINUE TO LOOP ; E3XX: MOV DPTR,#E3X ;BAD ARG ERROR AJMP EK ; SLET0: ACALL SLET1 AJMP POPAS ;COPY EXPRESSION TO VARIABLE ; SLET1: ACALL VAR_ER ;CHECK FOR A"VARIABLE" ; SLET2: PUSH R2B0 ;SAVE THE VARIABLE ADDRESS PUSH R0B0 MOV R7,#T_EQU ;GET EQUAL TOKEN ACALL WE POP R1B0 ;POP VARIABLE TO R3:R1 POP R3B0 RET ;EXIT ; R3CK: CJNE R3,#00H,E3XX ;CHECK TO SEE IF R3 IS ZERO RET ; SPEOP: ACALL GCI1 ;BUMP TXA ACALL P_E ;EVALUATE PAREN SPEOP1: ACALL SLET2 ;EVALUATE AFTER = CALL TWOL ;R7:R6 GETS VALUE, R3:R1 GETS LOCATION MOV A,R6 ;SAVE THE VALUE ; CJNE R7,#00H,E3XX ;R2 MUST BE = 0 RET ; ;************************************************************** ; ; ST_CAL - Calculate string Address ; ;************************************************************** ; IST_CAL:; ; ACALL I_PI ;BUMP TEXT, THEN EVALUATE ACALL R3CK ;ERROR IF R3 <> 0 INC R1 ;BUMP FOR OFFSET MOV A,R1 ;ERROR IF R1 = 255 JZ E3XX MOV DPTR,#VARTOP ;GET TOP OF VARIABLE STORAGE MOV B,S_LEN ;MULTIPLY FOR LOCATION ACALL VARD ;CALCULATE THE LOCATION MOV DPTR,#MEMTOP ;SEE IF BLEW IT CALL FUL1 MOV DPL,S_LEN ;GET STRING LENGTH, DPH = 00H DEC DPH ;DPH = 0 ; DUBSUB: CLR C MOV A,R1 SUBB A,DPL MOV R1,A MOV A,R3 SUBB A,DPH MOV R3,A ORL A,R1 RET ; ;*************************************************************** ; ;VARD - Calculate the offset base ; ;*************************************************************** ; VARB: MOV B,#FPSIZ ;SET UP FOR OPERATION ; VARD: CALL LDPTRI ;LOAD DPTR MOV A,R1 ;MULTIPLY BASE MUL AB ADD A,DPL MOV R1,A MOV A,B ADDC A,DPH MOV R3,A RET ; ;************************************************************* ; CSY: ; Calculate a biased string address and put in R3:R1 ; ;************************************************************* ; ACALL IST_CAL ;CALCULATE IT PUSH R3B0 ;SAVE IT PUSH R1B0 MOV R7,#',' ;WASTE THE COMMA ACALL EATC ACALL ONE ;GET THE NEXT EXPRESSION MOV A,R1 ;CHECK FOR BOUNDS CJNE A,S_LEN,CSY1 CSY1: JNC E3XX ;MUST HAVE A CARRY DEC R1 ;BIAS THE POINTER POP ACC ;GET VALUE LOW ADD A,R1 ;ADD IT TO BASE MOV R1,A ;SAVE IT POP R3B0 ;GET HIGH ADDRESS JNC CSY2 ;PROPAGATE THE CARRY INC R3 CSY2: AJMP ERPAR ;WASTE THE RIGHT PAREN ; ;*************************************************************** ; ; The statement action routine FOR ; ;*************************************************************** ; SFOR: ACALL SLET1 ;SET UP CONTROL VARIABLE PUSH R3B0 ;SAVE THE CONTROL VARIABLE LOCATION PUSH R1B0 ACALL POPAS ;POP ARG STACK AND COPY CONTROL VAR MOV R7,#T_TO ;GET TO TOKEN ACALL WE ACALL GC ;GET NEXT CHARACTER CJNE A,#T_STEP,SF2 ACALL GCI1 ;EAT THE TOKEN ACALL EXPRB ;EVALUATE EXPRESSION SJMP SF21 ;JUMP OVER ; SF2: LCALL PUSH_ONE ;PUT ONE ON THE STACK ; SF21: MOV A,#-FSIZE ;ALLOCATE FSIZE BYTES ON THE CONTROL STACK ACALL PUSHCS ;GET CS IN R0 ACALL CSC ;CHECK CONTROL STACK MOV R3,#CSTKAH ;IN CONTROL STACK MOV R1,R0B0 ;STACK ADDRESS ACALL POPAS ;PUT STEP ON STACK ACALL POPAS ;PUT LIMIT ON STACK ACALL DP_T ;DPTR GETS TEXT MOV R0,R1B0 ;GET THE POINTER ACALL T_X_S ;SAVE THE TEXT POP TXAL ;GET CONTROL VARIABLE POP TXAH MOV R4,#FTYPE ;AND THE TYPE ACALL T_X_S ;SAVE IT ; SF3: ACALL T_DP ;GET THE TEXT POINTER AJMP ILOOP ;CONTINUE TO PROCESS ; ;************************************************************** ; ; The statement action routines - PUSH and POP ; ;************************************************************** ; SPUSH: ACALL EXPRB ;PUT EXPRESSION ON STACK ACALL C_TST ;SEE IF MORE TO DO JNC SPUSH ;IF A COMMA PUSH ANOTHER RET ; ; SPOP: ACALL VAR_ER ;GET VARIABLE ACALL XPOP ;FLIP THE REGISTERS FOR POPAS ACALL C_TST ;SEE IF MORE TO DO JNC SPOP ; SPOP1: RET ; ;*************************************************************** ; ; The statement action routine - IF ; ;*************************************************************** ; SIF: ACALL RTST ;EVALUATE THE EXPRESSION MOV R1,A ;SAVE THE RESULT ACALL GC ;GET THE CHARACTER AFTER EXPR CJNE A,#T_THEN,SIF1 ;SEE IF THEN TOKEN ACALL GCI1 ;WASTE THEN TOKEN SIF1: CJNE R1,#0,T_F1 ;CHECK R_OP RESULT ; E_FIND: MOV R7,#T_ELSE ;FIND ELSE TOKEN ACALL FINDC JZ SPOP1 ;EXIT IF A CR ACALL GCI1 ;BUMP PAST TOKEN CJNE A,#T_ELSE,E_FIND;WASTE IF NO ELSE ; T_F1: ACALL INTGER ;SEE IF NUMBER JNC D_L1 ;EXECUTE LINE NUMBER AJMP ISTAT ;EXECUTE STATEMENT IN NOT ; B_C: MOVX A,@DPTR DEC A JB ACC.7,FL11 RET ; ;*************************************************************** ; ; The statement action routine - GOTO ; ;*************************************************************** ; SGOTO: ACALL RLINE ;R2:R0 AND DPTR GET INTGER ; SGT1: ACALL T_DP ;TEXT POINTER GETS DPTR ; JBC RETBIT,SGT2 ;SEE IF RETI EXECUTED ; JNB LINEB,SGT11 ;SEE IF A LINE WAS EDITED LCALL CNEW1 ;CLEAR THE MEMORY IF SET SGT11: AJMP CILOOP1 ;CLEAR DIRF AND LOOP ; SGT2: JBC OTI,SGT21 ;SEE IF TIMER INTERRUPT ANL 34,#10111101B ;CLEAR INTERRUPTS AJMP ILOOP ;EXECUTE SGT21: MOV C,ISAV MOV INPROG,C AJMP ILOOP ;RESTORE INTERRUPTS AND RET ; ; ;************************************************************* ; RTST: ; Test for ZERO ; ;************************************************************* ; ACALL EXPRB ;EVALUATE EXPRESSION CALL INC_ASTKA ;BUMP ARG STACK JZ RTST1 ;EXIT WITH ZERO OR 0FFH MOV A,#0FFH RTST1: RET ; ; ;************************************************************** ; ; GLN - get the line number in R2:R0, return in DPTR ; ;************************************************************** ; GLN: ACALL DP_B ;GET THE BEGINNING ADDRESS ; FL1: MOVX A,@DPTR ;GET THE LENGTH MOV R7,A ;SAVE THE LENGTH DJNZ R7,FL3 ;SEE IF END OF FILE ; FL11: MOV DPTR,#E10X ;NO LINE NUMBER AJMP EK ;HANDLE THE ERROR ; FL3: JB ACC.7,FL11 ;CHECK FOR BIT 7 INC DPTR ;POINT AT HIGH BYTE MOVX A,@DPTR ;GET HIGH BYTE CJNE A,R2B0,FL2 ;SEE IF MATCH INC DPTR ;BUMP TO LOW BYTE DEC R7 ;ADJUST AGAIN MOVX A,@DPTR ;GET THE LOW BYTE CJNE A,R0B0,FL2 ;SEE IF LOW BYTE MATCH INC DPTR ;POINT AT FIRST CHARACTER RET ;FOUND IT ; FL2: MOV A,R7 ;GET THE LENGTH COUNTER CALL ADDPTR ;ADD A TO DATA POINTER SJMP FL1 ;LOOP ; ; ;************************************************************* ; ;RLINE - Read in ASCII string, get line, and clean it up ; ;************************************************************* ; RLINE: ACALL INTERR ;GET THE INTEGER ; RL1: ACALL GLN AJMP CLN_UP ; ; D_L1: ACALL GLN ;GET THE LINE AJMP SGT1 ;EXECUTE THE LINE ; ;*************************************************************** ; ; The statement action routines WHILE and UNTIL ; ;*************************************************************** ; SWHILE: ACALL RTST ;EVALUATE RELATIONAL EXPRESSION CPL A SJMP S_WU ; SUNTIL: ACALL RTST ;EVALUATE RELATIONAL EXPRESSION ; S_WU: MOV R4,#DTYPE ;DO EXPECTED MOV R5,A ;SAVE R_OP RESULT SJMP SR0 ;GO PROCESS ; ; ;*************************************************************** ; CNULL: ; The Command Action Routine - NULL ; ;*************************************************************** ; ACALL INTERR ;GET AN INTEGER FOLLOWING NULL MOV NULLCT,R0 ;SAVE THE NULLCOUNT AJMP CMNDLK ;JUMP TO COMMAND MODE ; ;*************************************************************** ; ; The statement action routine - RETI ; ;*************************************************************** ; SRETI: SETB RETBIT ;SAYS THAT RETI HAS BEEN EXECUTED ; ;*************************************************************** ; ; The statement action routine - RETURN ; ;*************************************************************** ; SRETRN: MOV R4,#GTYPE ;MAKE SURE OF GOSUB MOV R5,#55H ;TYPE RETURN TYPE ; SR0: ACALL CSETUP ;SET UP CONTROL STACK MOVX A,@R0 ;GET RETURN TEXT ADDRESS MOV DPH,A INC R0 MOVX A,@R0 MOV DPL,A INC R0 ;POP CONTROL STACK MOVX A,@DPTR ;SEE IF GOSUB WAS THE LAST STATEMENT CJNE A,#EOF,SR01 AJMP CMNDLK SR01: MOV A,R5 ;GET TYPE JZ SGT1 ;EXIT IF ZERO MOV CSTKA,R0 ;POP THE STACK CPL A ;OPTION TEST, 00H, 55H, 0FFH, NOW 55H JNZ SGT1 ;MUST BE GOSUB RET ;NORMAL FALL THRU EXIT FOR NO MATCH ; ;*************************************************************** ; ; The statement action routine - GOSUB ; ;*************************************************************** ; SGOSUB: ACALL RLINE ;NEW TXA IN DPTR ; SGS0: MOV R4,#GTYPE ACALL SGS1 ;SET EVERYTHING UP AJMP SF3 ;EXIT ; SGS1: MOV A,#-3 ;ALLOCATE 3 BYTES ON CONTROL STACK ACALL PUSHCS ; T_X_S: MOV P2,#CSTKAH ;SET UP PORT FOR CONTROL STACK MOV A,TXAL ;GET RETURN ADDRESS AND SAVE IT MOVX @R0,A DEC R0 MOV A,TXAH MOVX @R0,A DEC R0 MOV A,R4 ;GET TYPE MOVX @R0,A ;SAVE TYPE RET ;EXIT ; ; CS1: MOV A,#3 ;POP 3 BYTES ACALL PUSHCS ; CSETUP: MOV R0,CSTKA ;GET CONTROL STACK MOV P2,#CSTKAH MOVX A,@R0 ;GET BYTE CJNE A,R4B0,CSETUP1 ;SEE IF TYPE MATCH INC R0 RET CSETUP1:JZ E4XX ;EXIT IF STACK UNDERFLOW CJNE A,#FTYPE,CS1 ;SEE IF FOR TYPE ACALL XXI3 ;WASTE THE FOR TYPE SJMP CSETUP ;LOOP ; ;*************************************************************** ; ; The statement action routine - NEXT ; ;*************************************************************** ; SNEXT: MOV R4,#FTYPE ;FOR TYPE ACALL CSETUP ;SETUP CONTROL STACK MOV TEMP5,R0 ;SAVE CONTROL VARIABLE ADDRESS MOV R1,#TEMP1 ;SAVE VAR + RETURN IN TEMP1-4 ; XXI: MOVX A,@R0 ;LOOP UNTIL DONE MOV @R1,A INC R1 INC R0 CJNE R1,#TEMP5,XXI ; ACALL VAR ;SEE IF THE USER HAS A VARIABLE JNC XXI1 MOV R2,TEMP1 MOV R0,TEMP2 XXI1: MOV A,R2 ;SEE IF VAR'S AGREE CJNE A,TEMP1,E4XX MOV A,R0 CJNE A,TEMP2,E4XX ACALL PUSHAS ;PUT CONTROL VARIABLE ON STACK MOV A,#FPSIZ+FPSIZ+2;COMPUTE ADDRESS TO STEP VALUE SIGN ADD A,TEMP5 ;ADD IT TO BASE OF STACK MOV R0,A ;SAVE IN R0 MOV R2,#CSTKAH ;SET UP TO PUSH STEP VALUE MOV P2,R2 ;SET UP PORT MOVX A,@R0 ;GET SIGN INC R0 ;BACK TO EXPONENT PUSH ACC ;SAVE SIGN OF STEP ACALL PUSHAS ;PUT STEP VALUE ON STACK PUSH R0B0 ;SAVE LIMIT VALUE LOCATION CALL AADD ;ADD STEP VALUE TO VARIABLE CALL CSTAKA ;COPY STACK MOV R3,TEMP1 ;GET CONTROL VARIABLE MOV R1,TEMP2 ACALL POPAS ;SAVE THE RESULT MOV R2,#CSTKAH ;RESTORE LIMIT LOCATION POP R0B0 ACALL PUSHAS ;PUT LIMIT ON STACK CALL FP_BASE2 ;DO THE COMPARE POP ACC ;GET LIMIT SIGN BACK JZ XXI2 ;IF SIGN NEGATIVE, TEST "BACKWARDS" CPL C XXI2: ORL C,F0 ;SEE IF EQUAL JC N4 ;STILL SMALLER THAN LIMIT? XXI3: MOV A,#FSIZE ;REMOVE CONTROL STACK ENTRY ; ; Fall thru to PUSHCS ; ;*************************************************************** ; ; PUSHCS - push frame onto control stack ; acc has - number of bytes, also test for overflow ; ;*************************************************************** ; PUSHCS: ADD A,CSTKA ;BUMP CONTROL STACK CJNE A,#CONVT+17,PUSHCS1 ;SEE IF OVERFLOWED PUSHCS1:JC E4XX ;EXIT IF STACK OVERFLOW XCH A,CSTKA ;STORE NEW CONTROL STACK VALUE, GET OLD DEC A ;BUMP OLD VALUE MOV R0,A ;PUT OLD-1 IN R0 ; PUSHCS2:RET ;EXIT ; CSC: ACALL CLN_UP ;FINISH OFF THE LINE JNC PUSHCS2 ;EXIT IF NO TERMINATOR ; E4XX: MOV DPTR,#EXC ;CONTROL STACK ERROR AJMP EK ;STACK ERROR ; N4: MOV TXAH,TEMP3 ;GET TEXT POINTER MOV TXAL,TEMP4 AJMP ILOOP ;EXIT ; ;*************************************************************** ; ; The statement action routine - RESTORE ; ;*************************************************************** ; SRESTR: ACALL X_TR ;SWAP POINTERS SRESTR1:ACALL DP_B ;GET THE STARTING ADDRESS ACALL T_DP ;PUT STARTING ADDRESS IN TEXT POINTER ACALL B_TXA ;BUMP TXA ; ; Fall thru ; X_TR: ;swap txa and rtxa ; XCH A,TXAH XCH A,RTXAH XCH A,TXAH XCH A,TXAL XCH A,RTXAL XCH A,TXAL RET ;EXIT ; ;*************************************************************** ; ; The statement action routine - READ ; ;*************************************************************** ; SREAD: ACALL X_TR ;SWAP POINTERS ; SRD0: ACALL C_TST ;CHECK FOR COMMA JC SRD4 ;SEE WHAT IT IS ; SRD: ACALL EXPRB ;EVALUATE THE EXPRESSION ACALL GC ;GET THE CHARACTER AFTER EXPRESSION CJNE A,#',',SRD1 ;SEE IF MORE DATA SJMP SRD2 ;BYBASS CLEAN UP IF A COMMA ; SRD1: ACALL CLN_UP ;FINISH OFF THE LINE, IF AT END ; SRD2: ACALL X_TR ;RESTORE POINTERS ACALL VAR_ER ;GET VARIABLE ADDRESS ACALL XPOP ;FLIP THE REGISTERS FOR POPAS ACALL C_TST ;SEE IF A COMMA JNC SREAD ;READ AGAIN IF A COMMA SRD21: RET ;EXIT IF NOT ; SRD4: CJNE A,#T_DATA,SRD5 ;SEE IF DATA ACALL GCI1 ;BUMP POINTER SJMP SRD ; SRD5: CJNE A,#EOF,SRD6 ;SEE IF YOU BLEW IT SRD51: ACALL X_TR ;GET THE TEXT POINTER BACK MOV DPTR,#E14X ;READ ERROR ; EK: LJMP ERROR ; SRD6: ACALL FINDCR ;WASTE THIS LINE ACALL CLN_UP ;CLEAN IT UP JC SRD51 ;ERROR IF AT END SJMP SRD0 ; NUMC: ACALL GC ;GET A CHARACTER CJNE A,#'#',NUMC1 ;SEE IF A # SETB COB ;VALID LINE PRINT AJMP IGC ;BUMP THE TEXT POINTER ; NUMC1: CJNE A,#'@',SRD21 ;EXIT IF NO GOOD SETB LPB AJMP IGC ; ;*************************************************************** ; ; The statement action routine - PRINT ; ;*************************************************************** ; SPH0: SETB ZSURP ;NO ZEROS ; SPH1: SETB HMODE ;HEX MODE ; SPRINT: ACALL NUMC ;TEST FOR A LINE PRINT ACALL SPRINT2 ;PROCEED SPRINT1:ANL 35,#11110101B ;CLEAR COB AND LPB ANL 38,#00111111B ;NO HEX MODE ; RET ; SPRINT2:ACALL DELTST ;CHECK FOR A DELIMITER JC SP1 ; SP0: JMP CRLF ;EXIT WITH A CR IF SO ; SP2: ACALL C_TST ;CHECK FOR A COMMA JC SP0 ;EXIT IF NO COMMA ; SP1: ACALL CPS ;SEE IF A STRING TO PRINT JNC SP2 ;IF A STRING, CHECK FOR A COMMA ; SP4: CJNE A,#T_TAB,SP6 ACALL I_PI ;ALWAYS CLEARS CARRY SUBB A,PHEAD ;TAKE DELTA BETWEEN TAB AND PHEAD JC SP2 ;EXIT IF PHEAD > TAB SJMP SP7 ;OUTPUT SPACES ; SP6: CJNE A,#T_SPC,SM ACALL I_PI ;SET UP PAREN VALUE ; SP7: JZ SP2 LCALL STEROT ;OUTPUT A SPACE DEC A ;DECREMENT COUNTER SJMP SP7 ;LOOP ; SM: CJNE A,#T_CHR,SP8 ACALL IGC CJNE A,#'$',SM01 ACALL CNX ;PUT THE CHARACTER ON THE STACK ACALL IFIXL ;PUT THE CHARACTER IN R1 SJMP SM02 SM01: ACALL ONE ;EVALUATE THE EXPRESSION, PUT IN R3:R1 ACALL ERPAR SM02: MOV R5,R1B0 ;BYTE TO OUTPUT SJMP SQ ; SP8: CJNE A,#T_CR,SX ACALL GCI1 ;EAT THE TOKEN MOV R5,#CR ; SQ: CALL TEROT SJMP SP2 ;OUTPUT A CR AND DO IT AGAIN ; SX: CJNE A,#T_USE,SP9 ;USING TOKEN ACALL IGC ;GE THE CHARACTER AFTER THE USING TOKEN CJNE A,#'F',U4 ;SEE IF FLOATING MOV FORMAT,#0F0H ;SET FLOATING ACALL IGC ;BUMP THE POINTER AND GET THE CHARACTER ACALL GCI1 ;BUMP IT AGAIN ANL A,#0FH ;STRIP OFF ASCII BIAS JZ U3 ;EXIT IF ZERO CJNE A,#3,SX1 ;SEE IF AT LEAST A THREE SX1: JNC U3 ;FORCE A THREE IF NOT A THREE MOV A,#3 ; U3: ORL FORMAT,A ;PUT DIGIT IN FORMAT SJMP U8 ;CLEAN UP END ; U4: CJNE A,#'0',U5 MOV FORMAT,#0 ;FREE FORMAT ACALL GCI1 ;BUMP THE POINTER SJMP U8 ; U5: CJNE A,#'#',U8 ;SEE IF INTGER FORMAT ACALL U6 MOV FORMAT,R7 ;SAVE THE FORMAT CJNE A,#'.',U8A ;SEE IF TERMINATOR WAS RADIX ACALL IGC ;BUMP PAST . ACALL U6 ;LOOP AGAIN MOV A,R7 ;GET COUNT ADD A,FORMAT ;SEE IF TOO BIG ADD A,#0F7H JNC U5A ; SE0: AJMP INTERX ;ERROR, BAD SYNTAX ; U5A: MOV A,R7 ;GET THE COUNT BACK SWAP A ;ADJUST ORL FORMAT,A ;GET THE COUNT ; U8A: MOV A,FORMAT ; U8B: SWAP A ;GET THE FORMAT RIGHT MOV FORMAT,A ; U8: ACALL ERPAR AJMP SP2 ;DONE ; U6: MOV R7,#0 ;SET COUNTER ; U7: CJNE A,#'#',SP9A ;EXIT IF NOT A # INC R7 ;BUMP COUNTER ACALL IGC ;GET THE NEXT CHARACTER SJMP U7 ;LOOP ; SP9: ACALL DELTST1 ;CHECK FOR DELIMITER JNC SP9A ;EXIT IF A DELIMITER ; CJNE A,#T_ELSE,SS ; SP9A: RET ;EXIT IF ELSE TOKEN ; ;************************************************************** ; ; P_E - Evaluate an expression in parens ( ) ; ;************************************************************** ; P_E: MOV R7,#T_LPAR ACALL WE ; ERPAR: MOV R7,#')' ;EAT A RIGHT PAREN ; EATC: ACALL GCI ;GET THE CHARACTER CJNE A,R7B0,SE0 ;ERROR IF NOT THE SAME RET ; ;*************************************************************** ; S_ON: ; ON Statement ; ;*************************************************************** ; ACALL ONE ;GET THE EXPRESSION ACALL GCI ;GET THE NEXT CHARACTER CJNE A,#T_GOTO,C0 ACALL C1 ;EAT THE COMMAS AJMP SF3 ;DO GOTO ; C0: CJNE A,#T_GOSB,SE0 ACALL C1 AJMP SGS0 ;DO GOSUB ; C1: CJNE R1,#0,C2 ACALL INTERR ;GET THE LINE NUMBER ACALL FINDCR AJMP RL1 ;FINISH UP THIS LINE ; C2: MOV R7,#',' ACALL FINDC CJNE A,#',',SE0 ;ERROR IF NOT A COMMA DEC R1 ACALL GCI1 ;BUMP PAST COMMA SJMP C1 ; SS: ACALL S_C ;SEE IF A STRING JC SA ;NO STRING IF CARRY IS SET LCALL UPRNT ;PUT POINTER IN DPTR AJMP SP2 ;SEE IF MORE ; SA: ACALL EXPRB ;MUST BE AN EXPRESSION MOV A,#72 CJNE A,PHEAD,SA1 ;CHECK PHEAD POSITION SA1: JNC SA2 ACALL SP0 ;FORCE A CRLF SA2: JNB HMODE,S13 ;HEX MODE? CALL FCMP ;SEE IF TOS IS < 0FFFH JC S13 ;EXIT IF GREATER CALL AABS ;GET THE SIGN JNZ OOPS ;WASTE IF NEGATIVE ACALL IFIXL CALL FP_BASE11 ;PRINT HEXMODE AJMP SP2 OOPS: CALL ANEG ;MAKE IT NEGATIVE ; S13: CALL FP_BASE7 ;DO FP OUTPUT MOV A,#1 ;OUTPUT A SPACE AJMP SP7 ; ;*************************************************************** ; ; ANU - Get variable name from text - set carry if not found ; if succeeds returns variable in R7:R6 ; R6 = 0 if no digit in name ; ;*************************************************************** ; ANU: ACALL IGC ;INCREMENT AND GET CHARACTER LCALL DIGIT_CHECK ;CHECK FOR DIGIT JC AL2 ;EXIT IF VALID DIGIT CJNE A,#'_',AL ;SEE IF A _ RET ; AL: CJNE A,#'A',AL1 ;IS IT AN ASCII A? AL1: JC AL3 ;EXIT IF CARRY IS SET CJNE A,#'Z'+1,AL2 ;IS IT LESS THAN AN ASCII Z AL2: CPL C ;FLIP CARRY AL3: RET ; SD01: JNB F0,VAR2 ; SD0: MOV DPTR,#E6X AJMP EK ; SDIMX: SETB F0 ;SAYS DOING A DIMENSION SJMP VAR1 ; VAR: CLR F0 ;SAYS DOING A VARIABLE ; VAR1: ACALL GC ;GET THE CHARACTER ACALL AL ;CHECK FOR ALPHA JNC VAR11 ;ERROR IF IN DIM JB F0,SD0 RET VAR11: MOV R7,A ;SAVE ALPHA CHARACTER CLR A ;ZERO IN CASE OF FAILURE MOV R5,A ;SAVE IT ; VY: MOV R6,A ACALL ANU ;CHECK FOR ALPHA OR NUMBER JC VX ;EXIT IF NO ALPHA OR NUM ; XCH A,R7 ADD A,R5 ;NUMBER OF CHARACTERS IN ALPHABET XCH A,R7 ;PUT IT BACK MOV R5,#26 ;FOR THE SECOND TIME AROUND SJMP VY ; VX: CLR LINEB ;TELL EDITOR A VARIABLE IS DECLARED CJNE A,#T_LPAR,V4 ;SEE IF A LEFT PAREN ; ORL R6B0,#80H ;SET BIT 7 TO SIGINIFY MATRIX CALL F_VAR ;FIND THE VARIABLE PUSH R2B0 ;SAVE THE LOCATION PUSH R0B0 JNC SD01 ;DEFAULT IF NOT IN TABLE JB F0,SDI ;NO DEFAULT FOR DIMENSION MOV R1,#10 MOV R3,#0 ACALL D_CHK ; VAR2: ACALL PAREN_INT ;EVALUATE INTEGER IN PARENS CJNE R3,#0,SD0 ;ERROR IF R3<>0 POP DPL ;GET VAR FOR LOOKUP POP DPH MOVX A,@DPTR ;GET DIMENSION DEC A ;BUMP OFFSET SUBB A,R1 ;A MUST BE > R1 JC SD0 LCALL DECDP2 ;BUMP POINTER TWICE ACALL VARB ;CALCULATE THE BASE ; X3120: XCH A,R1 ;SWAP R2:R0, R3:R1 XCH A,R0 XCH A,R1 XCH A,R3 XCH A,R2 XCH A,R3 RET ; V4: JB F0,SD0 ;ERROR IF NO LPAR FOR DIM LCALL F_VAR ;GET SCALAR VARIABLE CLR C RET ; SDI: ACALL PAREN_INT ;EVALUATE PAREN EXPRESSION CJNE R3,#0,SD0 ;ERROR IF NOT ZERO POP R0B0 ;SET UP R2:R0 POP R2B0 ACALL D_CHK ;DO DIM ACALL C_TST ;CHECK FOR COMMA JNC SDIMX ;LOOP IF COMMA RET ;RETURN IF NO COMMA ; D_CHK: INC R1 ;BUMP FOR TABLE LOOKUP MOV A,R1 JZ SD0 ;ERROR IF 0FFFFH MOV R4,A ;SAVE FOR LATER MOV DPTR,#MT_ALL ;GET MATRIX ALLOCATION ACALL VARB ;DO THE CALCULATION MOV R7,DPH ;SAVE MATRIX ALLOCATION MOV R6,DPL MOV DPTR,#ST_ALL ;SEE IF TOO MUCH MEMORY TAKEN CALL FUL1 ;ST_ALL SHOULD BE > R3:R1 MOV DPTR,#MT_ALL ;SAVE THE NEW MATRIX POINTER CALL S31DP MOV DPL,R0 ;GET VARIABLE ADDRESS MOV DPH,R2 MOV A,R4 ;DIMENSION SIZE MOVX @DPTR,A ;SAVE IT CALL DECDP2 ;SAVE TARGET ADDRESS ; R76S: MOV A,R7 MOVX @DPTR,A INC DPTR MOV A,R6 ;ELEMENT SIZE MOVX @DPTR,A RET ;R2:R0 STILL HAS SYMBOL TABLE ADDRESS ; ;*************************************************************** ; ; The statement action routine - INPUT ; ;*************************************************************** ; SINPUT: ACALL CPS ;PRINT STRING IF THERE ; ACALL C_TST ;CHECK FOR A COMMA JNC IN2A ;NO CRLF ACALL SP0 ;DO A CRLF ; IN2: MOV R5,#'?' ;OUTPUT A ? CALL TEROT ; IN2A: SETB INP_B ;DOING INPUT CALL INLINE ;INPUT THE LINE CLR INP_B MOV TEMP5,#HIGH IBUF MOV TEMP4,#LOW IBUF ; IN3: ACALL S_C ;SEE IF A STRING JC IN3A ;IF CARRY IS SET, NO STRING ACALL X3120 ;FLIP THE ADDRESSES MOV R3,TEMP5 MOV R1,TEMP4 ACALL SSOOP ACALL C_TST ;SEE IF MORE TO DO JNC IN2 RET ; IN3A: CALL DTEMP ;GET THE USER LOCATION CALL GET_NUM ;GET THE USER SUPPLIED NUMBER JNZ IN5 ;ERROR IF NOT ZERO CALL TEMPD ;SAVE THE DATA POINTER ACALL VAR_ER ;GET THE VARIABLE ACALL XPOP ;SAVE THE VARIABLE CALL DTEMP ;GET DPTR BACK FROM VAR_ER ACALL C_TST ;SEE IF MORE TO DO JC IN6 ;EXIT IF NO COMMA MOVX A,@DPTR ;GET INPUT TERMINATOR CJNE A,#',',IN5 ;IF NOT A COMMA DO A CR AND TRY AGAIN INC DPTR ;BUMP PAST COMMA AND READ NEXT VALUE CALL TEMPD SJMP IN3 ; IN5: MOV DPTR,#IAN ;PRINT INPUT A NUMBER CALL CRP ;DO A CR, THEN, PRINT FROM ROM LJMP CC1 ;TRY IT AGAIN ; IN6: MOVX A,@DPTR CJNE A,#CR,EIGP RET ; EIGP: MOV DPTR,#EIG CALL CRP ;PRINT THE MESSAGE AND EXIT AJMP SP0 ;EXIT WITH A CRLF ; ;*************************************************************** ; SOT: ; On timer interrupt ; ;*************************************************************** ; ACALL TWO ;GET THE NUMBERS MOV SP_H,R3 MOV SP_L,R1 MOV DPTR,#TIV ;SAVE THE NUMBER SETB OTS AJMP R76S ;EXIT ; ; ;*************************************************************** ; SCALL: ; Call a user rountine ; ;*************************************************************** ; ACALL INTERR ;CONVERT INTEGER CJNE R2,#0,S_C_1 ;SEE IF TRAP MOV A,R0 JB ACC.7,S_C_1 ADD A,R0 MOV DPTR,#4100H MOV DPL,A ; S_C_1: ACALL AC1 ;JUMP TO USER PROGRAM ANL PSW,#11100111B ;BACK TO BANK 0 RET ;EXIT ; ;************************************************************** ; THREE: ; Save value for timer function ; ;************************************************************** ; ACALL ONE ;GET THE FIRST INTEGER CALL CBIAS ;BIAS FOR TIMER LOAD MOV T_HH,R3 MOV T_LL,R1 MOV R7,#',' ;WASTE A COMMA ACALL EATC ;FALL THRU TO TWO ; ;************************************************************** ; TWO: ; Get two values seperated by a comma off the stack ; ;************************************************************** ; ACALL EXPRB MOV R7,#',' ;WASTE THE COMMA ACALL WE JMP TWOL ;EXIT ; ;************************************************************* ; ONE: ; Evaluate an expression and get an integer ; ;************************************************************* ; ACALL EXPRB ;EVALUATE EXPERSSION ; IFIXL: CALL IFIX ;INTEGERS IN R3:R1 MOV A,R1 RET ; ; ;************************************************************* ; I_PI: ; Increment text pointer then get an integer ; ;************************************************************* ; ACALL GCI1 ;BUMP TEXT, THEN GET INTEGER ; PAREN_INT:; Get an integer in parens ( ) ; ACALL P_E SJMP IFIXL ; DP_B: MOV DPH,BOFAH MOV DPL,BOFAL RET ; DP_T: MOV DPH,TXAH MOV DPL,TXAL RET ; CPS: ACALL GC ;GET THE CHARACTER CJNE A,#'"',NOPASS ;EXIT IF NO STRING ACALL DP_T ;GET TEXT POINTER INC DPTR ;BUMP PAST " MOV R4,#'"' CALL PN0 ;DO THE PRINT INC DPTR ;GO PAST QUOTE CLR C ;PASSED TEST ; T_DP: MOV TXAH,DPH ;TEXT POINTER GETS DPTR MOV TXAL,DPL RET ; ;************************************************************* ; S_C: ; Check for a string ; ;************************************************************* ; ACALL GC ;GET THE CHARACTER CJNE A,#'$',NOPASS ;SET CARRY IF NOT A STRING AJMP IST_CAL ;CLEAR CARRY, CALCULATE OFFSET ; ; ; ;************************************************************** ; C_TST: ACALL GC ;GET A CHARACTER CJNE A,#',',NOPASS ;SEE IF A COMMA ; ;*************************************************************** ; ;GC AND GCI - GET A CHARACTER FROM TEXT (NO BLANKS) ; PUT CHARACTER IN THE ACC ; ;*************************************************************** ; IGC: ACALL GCI1 ;BUMP POINTER, THEN GET CHARACTER ; GC: SETB RS0 ;USE BANK 1 MOV P2,R2 ;SET UP PORT 2 MOVX A,@R0 ;GET EXTERNAL BYTE CLR RS0 ;BACK TO BANK 0 RET ;EXIT ; GCI: ACALL GC ; ; This routine bumps txa by one and always clears the carry ; GCI1: SETB RS0 ;BANK 1 INC R0 ;BUMP TXA CJNE R0,#0,GCI11 INC R2 GCI11: CLR RS0 RET ;EXIT ; ;************************************************************** ; ; Check delimiters ; ;************************************************************** ; DELTST: ACALL GC ;GET A CHARACTER DELTST1:CJNE A,#CR,DT1 ;SEE IF A CR CLR A RET ; DT1: CJNE A,#':',NOPASS ;SET CARRY IF NO MATCH ; L_RET: RET ; ; ;*************************************************************** ; ; FINDC - Find the character in R7, update TXA ; ;*************************************************************** ; FINDCR: MOV R7,#CR ;KILL A STATEMENT LINE ; FINDC: ACALL DELTST JNC L_RET ; CJNE A,R7B0,FNDCL2 ;MATCH? RET ; FNDCL2: ACALL GCI1 SJMP FINDC ;LOOP ; FNDCL3: ACALL GCI1 ; WCR: ACALL DELTST ;WASTE UNTIL A "REAL" CR JNZ FNDCL3 RET ; ;*************************************************************** ; ; VAR_ER - Check for a variable, exit if error ; ;*************************************************************** ; VAR_ER: ACALL VAR SJMP INTERR1 ; ; ;*************************************************************** ; ; S_D0 - The Statement Action Routine DO ; ;*************************************************************** ; S_DO: ACALL CSC ;FINISH UP THE LINE MOV R4,#DTYPE ;TYPE FOR STACK ACALL SGS1 ;SAVE ON STACK AJMP ILOOP ;EXIT ; ;*************************************************************** ; ; CLN_UP - Clean up the end of a statement, see if at end of ; file, eat character and line count after CR ; ;*************************************************************** ; C_2: CJNE A,#':',C_1 ;SEE IF A TERMINATOR AJMP GCI1 ;BUMP POINTER AND EXIT, IF SO ; C_1: CJNE A,#T_ELSE,EP5 ACALL WCR ;WASTE UNTIL A CR ; CLN_UP: ACALL GC ;GET THE CHARACTER CJNE A,#CR,C_2 ;SEE IF A CR ACALL IGC ;GET THE NEXT CHARACTER CJNE A,#EOF,B_TXA ;SEE IF TERMINATOR ; NOPASS: SETB C RET ; B_TXA: XCH A,TXAL ;BUMP TXA BY THREE ADD A,#3 XCH A,TXAL JBC CY,B_TXA1 RET B_TXA1: INC TXAH RET ; ;*************************************************************** ; ; Get an INTEGER from the text ; sets CARRY if not found ; returns the INTGER value in DPTR and R2:R0 ; returns the terminator in ACC ; ;*************************************************************** ; INTERR: ACALL INTGER ;GET THE INTEGER INTERR1:JC EP5 ;ERROR IF NOT FOUND RET ;EXIT IF FOUND ; INTGER: ACALL DP_T CALL FP_BASE9 ;CONVERT THE INTEGER ACALL T_DP MOV DPH,R2 ;PUT THE RETURNED VALUE IN THE DPTR MOV DPL,R0 ; ITRET: RET ;EXIT ; ; WE: ACALL EATC ;WASTE THE CHARACTER ; ; Fall thru to evaluate the expression ; ;*************************************************************** ; ; EXPRB - Evaluate an expression ; ;*************************************************************** ; EXPRB: MOV R2,#LOW OPBOL ;BASE PRECEDENCE ; EP1: PUSH R2B0 ;SAVE OPERATOR PRECEDENCE CLR ARGF ;RESET STACK DESIGNATOR ; EP2: MOV A,SP ;GET THE STACK POINTER ADD A,#12 ;NEED AT LEAST 12 BYTES JNC EP21 LJMP E1XX2 EP21: MOV A,ASTKA ;GET THE ARG STACK SUBB A,#LOW TM_TOP+12;NEED 12 BYTES ALSO JNC EP22 LJMP E4YY EP22: JB ARGF,EP4 ;MUST BE AN OPERATOR, IF SET ACALL VAR ;IS THE VALUE A VARIABLE? JNC EP3 ;PUT VARIABLE ON STACK ; ACALL CONST ;IS THE VALUE A NUMERIC CONSTANT? JNC EP4 ;IF SO, CONTINUE, IF NOT, SEE WHAT CALL GC ;GET THE CHARACTER CJNE A,#T_LPAR,EP4 ;SEE IF A LEFT PAREN MOV A,#(LOW OPBOL+1) SJMP XLPAR ;PROCESS THE LEFT PAREN ; EP3: ACALL PUSHAS ;SAVE VAR ON STACK ; EP4: ACALL GC ;GET THE OPERATOR ; CJNE A,#T_LPAR,EP41 ;IS IT AN OPERATOR EP41: JNC XOP ;PROCESS OPERATOR CJNE A,#T_UOP,EP42 ;IS IT A UNARY OPERATOR EP42: JNC XBILT ;PROCESS UNARY (BUILT IN) OPERATOR POP R2B0 ;GET BACK PREVIOUS OPERATOR PRECEDENCE JB ARGF,ITRET ;OK IF ARG FLAG IS SET ; EP5: CLR C ;NO RECOVERY LJMP E1XX1 ; ; Process the operator ; XOP: ANL A,#1FH ;STRIP OFF THE TOKE BITS JB ARGF,XOP1 ;IF ARG FLAG IS SET, PROCESS CJNE A,#T_SUB-T_LPAR,XOP3 MOV A,#T_NEG-T_LPAR ; XOP1: ADD A,#LOW OPBOL+1 ;BIAS THE TABLE MOV R2,A MOV DPTR,#00H MOVC A,@A+DPTR ;GET THE CURRENT PRECEDENCE MOV R4,A POP ACC ;GET THE PREVIOUS PRECEDENCE MOV R5,A ;SAVE THE PREVIOUS PRECEDENCE MOVC A,@A+DPTR ;GET IT CJNE A,R4B0,XOP11 ;SEE WHICH HAS HIGHER PRECEDENCE CJNE A,#12,ITRET ;SEE IF ANEG SETB C XOP11: JNC ITRET ;PROCESS NON-INCREASING PRECEDENCE ; ; Save increasing precedence ; PUSH R5B0 ;SAVE OLD PRECEDENCE ADDRESS PUSH R2B0 ;SAVE NEW PRECEDENCE ADDRESS ACALL GCI1 ;EAT THE OPERATOR ACALL EP1 ;EVALUATE REMAINING EXPRESSION XOP12: POP ACC ; ; R2 has the action address, now setup and perform operation ; XOP2: MOV DPTR,#OPTAB ADD A,#LOW (NOT OPBOL) CALL ISTA1 ;SET UP TO RETURN TO EP2 AJMP EP2 ;JUMP TO EVALUATE EXPRESSION ; ; Built-in operator processing ; XBILT: ACALL GCI1 ;EAT THE TOKEN ADD A,#LOW (50H+LOW UOPBOL) JB ARGF,EP5 ;XBILT MUST COME AFTER AN OPERATOR CJNE A,#STP,XBILT1 XBILT1: JNC XOP2 ; XLPAR: PUSH ACC ;PUT ADDRESS ON THE STACK ACALL P_E SJMP XOP12 ;PERFORM OPERATION ; XOP3: CJNE A,#T_ADD-T_LPAR,EP5 ACALL GCI1 AJMP EP2 ;WASTE + SIGN ; XPOP: ACALL X3120 ;FLIP ARGS THEN POP ; ;*************************************************************** ; ; POPAS - Pop arg stack and copy variable to R3:R1 ; ;*************************************************************** ; POPAS: LCALL INC_ASTKA JMP VARCOP ;COPY THE VARIABLE ; AXTAL: MOV R2,#HIGH CXTAL MOV R0,#LOW CXTAL ; ; fall thru ; ;*************************************************************** ; PUSHAS: ; Push the Value addressed by R2:R0 onto the arg stack ; ;*************************************************************** ; CALL DEC_ASTKA SETB ARGF ;SAYS THAT SOMTHING IS ON THE STACK LJMP VARCOP ; ; ;*************************************************************** ; ST_A: ; Store at expression ; ;*************************************************************** ; ACALL ONE ;GET THE EXPRESSION SJMP POPAS ;SAVE IT ; ; ;*************************************************************** ; LD_A: ; Load at expression ; ;*************************************************************** ; ACALL ONE ;GET THE EXPRESSION ACALL X3120 ;FLIP ARGS SJMP PUSHAS ; ;*************************************************************** ; CONST: ; Get a constant fron the text ; ;*************************************************************** ; CALL GC ;FIRST SEE IF LITERAL CJNE A,#T_ASC,C0C ;SEE IF ASCII TOKEN CALL IGC ;GET THE CHARACTER AFTER TOKEN CJNE A,#'$',CN0 ;SEE IF A STRING ; CNX: CALL CSY ;CALCULATE IT JMP AXBYTE1 ;SAVE IT ON THE STACK ; ;***************************************************************************** ;****** Correct ASC(x) bug *************************************************** ;****** Wulf 5 *************************************************************** ; ; CN0: jnb acc.7,cn0t ;jump if possibly ascii mov dptr,#toktab mov r6,a ;save search token cn0t1: cpl a jz cn0t4 ;jump if EOT clr a movc a,@a+dptr ;read token from token table inc dptr cjne a,r6b0,cn0t1 ;jump if wrong entry ; mov r5,a ;save search token clr a cn0t2: movc a,@a+dptr mov r6,a ;save first ascii of token text ; cn0t3: clr a movc a,@a+dptr inc dptr jnb acc.7,cn0t3 ;jump if possibly ascii ; xrl a,r5 jz cn0t2 ;jump if same search token again ; cn0t4: mov a,r6 ;get saved ascii CN0t: CALL TWO_R2 ;PUT IT ON THE STACK ; ;****** continue with original code: ***************************************** ; CALL GCI1 ;BUMP THE POINTER JMP ERPAR ;WASTE THE RIGHT PAREN ; C0C: CALL DP_T ;GET THE TEXT POINTER CALL GET_NUM ;GET THE NUMBER CJNE A,#0FFH,C1C ;SEE IF NO NUMBER SETB C C2C: RET ; C1C: JNZ FPTST CLR C SETB ARGF ; C3C: JMP T_DP ; FPTST: ANL A,#00001011B ;CHECK FOR ERROR JZ C2C ;EXIT IF ZERO ; ; Handle the error condition ; MOV DPTR,#E2X ;DIVIDE BY ZERO JNB ACC.0,FPTST1 ;UNDERFLOW MOV DPTR,#E7X FPTST1: JNB ACC.1,FPTS ;OVERFLOW MOV DPTR,#E11X ; FPTS: JMP ERROR ; ;*************************************************************** ; ; The Command action routine - LIST ; ;*************************************************************** ; CLIST: CALL NUMC ;SEE IF TO LINE PORT ACALL FSTK ;PUT 0FFFFH ON THE STACK CALL INTGER ;SEE IF USER SUPPLIES LN CLR A ;LN = 0 TO START MOV R3,A MOV R1,A JC CL1 ;START FROM ZERO ; CALL TEMPD ;SAVE THE START ADDTESS CALL GCI ;GET THE CHARACTER AFTER LIST CJNE A,#T_SUB,CLIST1 ;CHECK FOR TERMINATION ADDRESS '-' ACALL INC_ASTKA ;WASTE 0FFFFH LCALL INTERR ;GET TERMINATION ADDRESS ACALL TWO_EY ;PUT TERMINATION ON THE ARG STACK CLIST1: MOV R3,TEMP5 ;GET THE START ADDTESS MOV R1,TEMP4 ; CL1: CALL GETLIN ;GET THE LINE NO IN R3:R1 JZ CL3 ;RET IF AT END ; CL2: ACALL C3C ;SAVE THE ADDRESS INC DPTR ;POINT TO LINE NUMBER ACALL PMTOP1 ;PUT LINE NUMBER ON THE STACK ACALL CMPLK ;COMPARE LN TO END ADDRESS JC CL3 ;EXIT IF GREATER CALL BCK ;CHECK FOR A CONTROL C ACALL DEC_ASTKA ;SAVE THE COMPARE ADDRESS CALL DP_T ;RESTORE ADDRESS ACALL UPPL ;UN-PROCESS THE LINE ACALL C3C ;SAVE THE CR ADDRESS ACALL CL6 ;PRINT IT INC DPTR ;BUMP POINTER TO NEXT LINE MOVX A,@DPTR ;GET LIN LENGTH DJNZ ACC,CL2 ;LOOP ACALL INC_ASTKA ;WASTE THE COMPARE BYTE ; CL3: AJMP CMND1 ;BACK TO COMMAND PROCESSOR ; CL6: MOV DPTR,#IBUF ;PRINT IBUF CALL PRNTCR ;PRINT IT CALL DP_T ; CL7: JMP CRLF ; UPPL0: LCALL X31DP ; ;*************************************************************** ; ;UPPL - UN PREPROCESS A LINE ADDRESSED BY DPTR INTO IBUF ; RETURN SOURCE ADDRESS OF CR IN DPTR ON RETURN ; ;*************************************************************** ; UPPL: MOV R3,#HIGH IBUF ;POINT R3 AT HIGH IBUF MOV R1,#LOW IBUF ;POINT R1 AT IBUF INC DPTR ;SKIP OVER LINE LENGTH ; ;***************************************************************************** ;****** Elektor 1 Patch ****************************************************** ; ; ACALL C3C ;SAVE THE DPTR (DP_T) ; CALL L20DPI ;PUT LINE NUMBER IN R2:R0 ; CALL FP_BASE8 ;CONVERT R2:R0 TO INTEGER ; CALL DP_T ; INC DPTR ;BUMP DPTR PAST THE LINE NUMBER ; ;****** Proper code starts here: ********************************************* ; lcall L20DPI ;PUT LINE NUMBER IN R2:R0 lcall FP_BASE8 ;CONVERT R2:R0 TO INTEGER ; ;****** continue with original code: ***************************************** ; UPP0: CJNE R1,#LOW IBUF+6,UPP01 UPP01: JC UPP91 ;PUT SPACES IN TEXT INC DPTR ;BUMP PAST LN HIGH MOVX A,@DPTR ;GET USER TEXT MOV R6,A ;SAVE A IN R6 FOR TOKE COMPARE JB ACC.7,UPP1 ;IF TOKEN, PROCESS CJNE A,#20H,UPP02 ;TRAP THE USER TOKENS UPP02: JNC UPP03 CJNE A,#CR,UPP1 ;DO IT IF NOT A CR UPP03: CJNE A,#'"',UPP9 ;SEE IF STRING ACALL UPP7 ;SAVE IT UPP04: ACALL UPP8 ;GET THE NEXT CHARACTER AND SAVE IT CJNE A,#'"',UPP04 ;LOOP ON QUOTES SJMP UPP0 ; UPP9: CJNE A,#':',UPP1A ;PUT A SPACE IN DELIMITER ACALL UPP7A MOV A,R6 ACALL UPP7 UPP91: ACALL UPP7A SJMP UPP0 ; UPP1A: ACALL UPP81 ;SAVE THE CHARACTER, UPDATE POINTER SJMP UPP0 ;EXIT IF A CR, ELSE LOOP ; UPP1: ACALL C3C ;SAVE THE TEXT POINTER MOV C,XBIT MOV F0,C ;SAVE XBIT IN F0 UPP11: MOV DPTR,#TOKTAB ;POINT AT TOKEN TABLE JNB F0,UPP2 LCALL 2078H ;SET UP DPTR FOR LOOKUP ; UPP2: CLR A ;ZERO A FOR LOOKUP MOVC A,@A+DPTR ;GET TOKEN INC DPTR ;ADVANCE THE TOKEN POINTER CJNE A,#0FFH,UP_2 ;SEE IF DONE JBC F0,UPP11 ;NOW DO NORMAL TABLE AJMP CMND1 ;EXIT IF NOT FOUND ; UP_2: CJNE A,R6B0,UPP2 ;LOOP UNTIL THE SAME ; UP_3: CJNE A,#T_UOP,UP_4 UP_4: JNC UPP3 ACALL UPP7A ;PRINT THE SPACE IF OK ; UPP3: CLR A ;DO LOOKUP MOVC A,@A+DPTR JB ACC.7,UPP4 ;EXIT IF DONE, ELSE SAVE JZ UPP4 ;DONE IF ZERO ACALL UPP7 ;SAVE THE CHARACTER INC DPTR SJMP UPP3 ;LOOP ; UPP4: CALL DP_T ;GET IT BACK MOV A,R6 ;SEE IF A REM TOKEN XRL A,#T_REM JNZ UPP42 UPP41: ACALL UPP8 SJMP UPP41 UPP42: JNC UPP0 ;START OVER AGAIN IF NO TOKEN ACALL UPP7A ;PRINT THE SPACE IF OK SJMP UPP0 ;DONE ; UPP7A: MOV A,#' ' ;OUTPUT A SPACE ; UPP7: AJMP PPL91 ;SAVE A ; UPP8: INC DPTR MOVX A,@DPTR UPP81: CJNE A,#CR,UPP7 AJMP PPL71 ; ;************************************************************** ; ; This table contains all of the floating point constants ; ; The constants in ROM are stored "backwards" from the way ; basic normally treats floating point numbers. Instead of ; loading from the exponent and decrementing the pointer, ; ROM constants pointers load from the most significant ; digits and increment the pointers. This is done to 1) make ; arg stack loading faster and 2) compensate for the fact that ; no decrement data pointer instruction exsist. ; ; The numbers are stored as follows: ; ; BYTE X+5 = MOST SIGNIFICANT DIGITS IN BCD ; BYTE X+4 = NEXT MOST SIGNIFICANT DIGITS IN BCD ; BYTE X+3 = NEXT LEAST SIGNIFICANT DIGITS IN BCD ; BYTE X+2 = LEAST SIGNIFICANT DIGITS IN BCD ; BYTE X+1 = SIGN OF THE ABOVE MANTISSA 0 = +, 1 = - ; BYTE X = EXPONENT IN TWO'S COMPLEMENT BINARY ; ZERO EXPONENT = THE NUMBER ZERO ; ;************************************************************** ; ATTAB: DB 128-2 ; ARCTAN LOOKUP DB 00H DB 57H DB 22H DB 66H DB 28H ; DB 128-1 DB 01H DB 37H DB 57H DB 16H DB 16H ; DB 128-1 DB 00H DB 14H DB 96H DB 90H DB 42H ; DB 128-1 DB 01H DB 40H DB 96H DB 28H DB 75H ; DB 128 DB 00H DB 64H DB 62H DB 65H DB 10H ; DB 128 DB 01H DB 99H DB 88H DB 20H DB 14H ; DB 128 DB 00H DB 51H DB 35H DB 99H DB 19H ; DB 128 DB 01H DB 45H DB 31H DB 33H DB 33H ; DB 129 DB 00H DB 00H DB 00H DB 00H DB 10H ; DB 0FFH ;END OF TABLE ; NTWO: DB 129 DB 0 DB 0 DB 0 DB 0 DB 20H ; ;***************************************************************************** ;****** Use XTAL up to 47 MHz ************************************************ ;****** Wulf 2 *************************************************************** ; ;TTIME: DB 128-4 ; CLOCK CALCULATION ; DB 00H ; DB 00H ; DB 00H ; DB 04H ; DB 13H ; ttime: db 128-5 ;New clock calculation for timer 0 in db 00H ;16 bit mode db 42H db 60H db 27H db 16H ; ;***************************************************************************** ; ;*************************************************************** ; ; COSINE - Add pi/2 to stack, then fall thru to SIN ; ;*************************************************************** ; ACOS: ACALL POTWO ;PUT PI/2 ON THE STACK ACALL AADD ;TOS = TOS+PI/2 ; ;*************************************************************** ; ; SINE - use taylor series to calculate sin function ; ;*************************************************************** ; ASIN: ACALL PIPI ;PUT PI ON THE STACK ACALL RV ;REDUCE THE VALUE MOV A,MT2 ;CALCULATE THE SIGN ANL A,#01H ;SAVE LSB XRL MT1,A ;SAVE SIGN IN MT1 ACALL CSTAKA ;NOW CONVERT TO ONE QUADRANT ACALL POTWO ACALL CMPLK ;DO COMPARE JC ASIN1 ACALL PIPI ACALL ASUB ASIN1: ACALL AABS MOV DPTR,#SINTAB ;SET UP LOOKUP TABLE ACALL POLYC ;CALCULATE THE POLY ACALL STRIP AJMP SIN0 ; ; Put PI/2 on the stack ; POTWO: ACALL PIPI ;PUT PI ON THE STACK, NOW DIVIDE ; DBTWO: MOV DPTR,#NTWO ACALL PUSHC ;MOV A,#2 ;BY TWO ;ACALL TWO_R2 AJMP ADIV ; ;************************************************************* ; POLYC: ; Expand a power series to calculate a polynomial ; ;************************************************************* ; ACALL CSTAKA2 ;COPY THE STACK ACALL AMUL ;SQUARE THE STACK ACALL POP_T1 ;SAVE X*X ACALL PUSHC ;PUT CONSTANT ON STACK ; POLY1: ACALL PUSH_T1 ;PUT COMPUTED VALUE ON STACK ACALL AMUL ;MULTIPLY CONSTANT AND COMPUTED VALUE ACALL PUSHC ;PUT NEXT CONSTANT ON STACK ACALL AADD ;ADD IT TO THE OLD VALUE CLR A ;CHECK TO SEE IF DONE MOVC A,@A+DPTR CJNE A,#0FFH,POLY1 ;LOOP UNTIL DONE ; AMUL: LCALL FP_BASE3 AJMP FPTST ; ;************************************************************* ; RV: ; Reduce a value for Trig and A**X functions ; ; value = (value/x - INT(value/x)) * x ; ;************************************************************* ; ACALL C2_T2 ;COPY TOS TO T2 ACALL ADIV ;TOS = TOS/TEMP2 ACALL AABS ;MAKE THE TOS A POSITIVE NUMBER MOV MT1,A ;SAVE THE SIGN ACALL CSTAKA2 ;COPY THE STACK TWICE ACALL IFIX ;PUT THE NUMBER IN R3:R1 PUSH R3B0 ;SAVE R3 MOV MT2,R1 ;SAVE THE LS BYTE IN MT2 ACALL AINT ;MAKE THE TOS AN INTEGER ACALL ASUB ;TOS = TOS/T2 - INT(TOS/T2) ACALL P_T2 ;TOS = T2 ACALL AMUL ;TOS = T2*(TOS/T2 - INT(TOS/T2) POP R3B0 ;RESTORE R3 RET ;EXIT ; ;************************************************************** ; ; TAN ; ;************************************************************** ; ATAN: ACALL CSTAKA ;DUPLACATE STACK ACALL ASIN ;TOS = SIN(X) ACALL SWAP_ASTKA ;TOS = X ACALL ACOS ;TOS = COS(X) AJMP ADIV ;TOS = SIN(X)/COS(X) ; STRIP: ACALL SETREG ;SETUP R0 MOV R3,#1 ;LOOP COUNT AJMP AI11 ;WASTE THE LSB ; ;************************************************************ ; ; ARC TAN ; ;************************************************************ ; AATAN: ACALL AABS MOV MT1,A ;SAVE THE SIGN ACALL SETREG ;GET THE EXPONENT ADD A,#7FH ;BIAS THE EXPONENT MOV UBIT,C ;SAVE CARRY STATUS JNC AATAN1 ;SEE IF > 1 ACALL RECIP ;IF > 1, TAKE RECIP AATAN1: MOV DPTR,#ATTAB ;SET UP TO CALCULATE THE POLY ACALL POLYC ;CALCULATE THE POLY JNB UBIT,SIN0 ;JUMP IF NOT SET ACALL ANEG ;MAKE X POLY NEGATIVE ACALL POTWO ;SUBTRACT PI/2 ACALL AADD ; SIN0: MOV A,MT1 ;GET THE SIGN JZ SRT AJMP ANEG ; ;************************************************************* ; ; FCOMP - COMPARE 0FFFFH TO TOS ; ;************************************************************* ; FCMP: ACALL CSTAKA ;COPY THE STACK ACALL FSTK ;MAKE THE TOS = 0FFFFH ACALL SWAP_ASTKA ;NOW COMPARE IS 0FFFFH - X ; CMPLK: JMP FP_BASE2 ;DO THE COMPARE ; ;************************************************************* ; DEC_ASTKA: ;Push ARG STACK and check for underflow ; ;************************************************************* ; MOV A,#-FPSIZ ADD A,ASTKA CJNE A,#LOW TM_TOP+6,DEC_ASTKA1 DEC_ASTKA1: JC E4YY MOV ASTKA,A MOV R1,A MOV R3,#ASTKAH ; SRT: RET ; E4YY: MOV DPTR,#EXA AJMP FPTS ;ARG STACK ERROR ; ; AXTAL3: ACALL PUSHC ;PUSH CONSTANT, THEN MULTIPLY ACALL AMUL ; ; Fall thru to IFIX ; ;*************************************************************** ; IFIX: ; Convert a floating point number to an integer, put in R3:R1 ; ;*************************************************************** ; CLR A ;RESET THE START MOV R3,A MOV R1,A MOV R0,ASTKA ;GET THE ARG STACK MOV P2,#ASTKAH MOVX A,@R0 ;READ EXPONENT CLR C SUBB A,#81H ;BASE EXPONENT MOV R4,A ;SAVE IT DEC R0 ;POINT AT SIGN MOVX A,@R0 ;GET THE SIGN JNZ SQ_ERR ;ERROR IF NEGATIVE JC INC_ASTKA ;EXIT IF EXPONENT IS < 81H INC R4 ;ADJUST LOOP COUNTER MOV A,R0 ;BUMP THE POINTER REGISTER SUBB A,#FPSIZ-1 MOV R0,A ; I2: INC R0 ;POINT AT DIGIT MOVX A,@R0 ;GET DIGIT SWAP A ;FLIP CALL FP_BASE10 ;ACCUMULATE JC SQ_ERR DJNZ R4,I21 SJMP INC_ASTKA I21: MOVX A,@R0 ;GET DIGIT CALL FP_BASE10 JC SQ_ERR DJNZ R4,I2 ; ;************************************************************ ; INC_ASTKA: ; Pop the ARG STACK and check for overflow ; ;************************************************************ ; MOV A,#FPSIZ ;NUMBER TO POP SJMP SETREG1 ; SETREG: CLR A ;DON'T POP ANYTHING SETREG1:MOV R0,ASTKA MOV R2,#ASTKAH MOV P2,R2 ADD A,R0 JC E4YY MOV ASTKA,A MOVX A,@R0 A_D: RET ; ;************************************************************ ; ; EBIAS - Bias a number for E to the X calculations ; ;************************************************************ ; EBIAS: ACALL PUSH_ONE ACALL RV CJNE R3,#00H,SQ_ERR ;ERROR IF R3 <> 0 ACALL C2_T2 ;TEMP 2 GETS FRACTIONS ACALL INC_ASTKA ACALL POP_T1 ACALL PUSH_ONE ; AELP: MOV A,MT2 JNZ AEL1 ; MOV A,MT1 JZ A_D MOV DPTR,#FPT2-1 MOVX @DPTR,A ;MAKE THE FRACTIONS NEGATIVE ; RECIP: ACALL PUSH_ONE ACALL SWAP_ASTKA AJMP ADIV ; AEL1: DEC MT2 ACALL PUSH_T1 ACALL AMUL SJMP AELP ; SQ_ERR: LJMP E3XX ;LINK TO BAD ARG ; ;************************************************************ ; ; SQUARE ROOT ; ;************************************************************ ; ASQR: ACALL AABS ;GET THE SIGN JNZ SQ_ERR ;ERROR IF NEGATIVE ACALL C2_T2 ;COPY VARIABLE TO T2 ACALL POP_T1 ;SAVE IT IN T1 MOV R0,#LOW FPT1 MOVX A,@R0 ;GET EXPONENT JZ SQR41 ;EXIT IF ZERO ADD A,#128 ;BIAS THE EXPONENT JNC SQR1 ;SEE IF < 80H RR A ANL A,#127 SJMP SQR2 ; SQR1: CPL A ;FLIP BITS INC A RR A ANL A,#127 ;STRIP MSB CPL A INC A ; SQR2: ADD A,#128 ;BIAS EXPONENT MOVX @R0,A ;SAVE IT ; ; NEWGUESS = ( X/OLDGUESS + OLDGUESS) / 2 ; SQR4: ACALL P_T2 ;TOS = X ACALL PUSH_T1 ;PUT NUMBER ON STACK ACALL ADIV ;TOS = X/GUESS ACALL PUSH_T1 ;PUT ON AGAIN ACALL AADD ;TOS = X/GUESS + GUESS ACALL DBTWO ;TOS = ( X/GUESS + GUESS ) / 2 ACALL TEMP_COMP ;SEE IF DONE JNB F0,SQR4 ; SQR41: AJMP PUSH_T1 ;PUT THE ANSWER ON THE STACK ; ;************************************************************* ; ; NATURAL LOG ; ;************************************************************* ; ALN: ACALL AABS ;MAKE SURE THAT NUM IS POSITIVE JNZ SQ_ERR ;ERROR IF NOT MOV MT2,A ;CLEAR FOR LOOP INC R0 ;POINT AT EXPONENT MOVX A,@R0 ;READ THE EXPONENT JZ SQ_ERR ;ERROR IF EXPONENT IS ZERO CJNE A,#81H,ALN1 ;SEE IF NUM >= 1 ALN1: MOV UBIT,C ;SAVE CARRY STATUS JC ALNL ;TAKE RECIP IF >= 1 ACALL RECIP ; ; Loop to reduce ; ALNL: ACALL CSTAKA ;COPY THE STACK FOR COMPARE ACALL PUSH_ONE ;COMPARE NUM TO ONE ACALL CMPLK JNC ALNO ;EXIT IF DONE ACALL SETREG ;GET THE EXPONENT ADD A,#85H ;SEE HOW BIG IT IS JNC ALN11 ;BUMP BY EXP(11) IF TOO SMALL ACALL PLNEXP ;PUT EXP(1) ON STACK MOV A,#1 ;BUMP COUNT ; ALNE: ADD A,MT2 JC SQ_ERR MOV MT2,A ACALL AMUL ;BIAS THE NUMBER SJMP ALNL ; ALN11: MOV DPTR,#EXP11 ;PUT EXP(11) ON STACK ACALL PUSHC MOV A,#11 SJMP ALNE ; ALNO: ACALL C2_T2 ;PUT NUM IN TEMP 2 ACALL PUSH_ONE ;TOS = 1 ACALL ASUB ;TOS = X - 1 ACALL P_T2 ;TOS = X ACALL PUSH_ONE ;TOS = 1 ACALL AADD ;TOS = X + 1 ACALL ADIV ;TOS = (X-1)/(X+1) MOV DPTR,#LNTAB ;LOG TABLE ACALL POLYC INC DPTR ;POINT AT LN(10) ACALL PUSHC ACALL AMUL MOV A,MT2 ;GET THE COUNT ACALL TWO_R2 ;PUT IT ON THE STACK ACALL ASUB ;INT - POLY ACALL STRIP JNB UBIT,AABS ; LN_D: RET ; ;************************************************************* ; TEMP_COMP: ; Compare FPTEMP1 to TOS, FPTEMP1 gets TOS ; ;************************************************************* ; ACALL PUSH_T1 ;SAVE THE TEMP ACALL SWAP_ASTKA ;TRADE WITH THE NEXT NUMBER ACALL CSTAKA ;COPY THE STACK ACALL POP_T1 ;SAVE THE NEW NUMBER JMP FP_BASE2 ;DO THE COMPARE ; AETOX: ACALL PLNEXP ;EXP(1) ON TOS ACALL SWAP_ASTKA ;X ON TOS ; AEXP: ;EXPONENTIATION ; ACALL EBIAS ;T1=BASE,T2=FRACTIONS,TOS=INT MULTIPLIED MOV DPTR,#FPT2 ;POINT AT FRACTIONS MOVX A,@DPTR ;READ THE EXP OF THE FRACTIONS JZ LN_D ;EXIT IF ZERO ACALL P_T2 ;TOS = FRACTIONS ACALL PUSH_T1 ;TOS = BASE ACALL SETREG ;SEE IF BASE IS ZERO JZ AEXP1 ACALL ALN ;TOS = LN(BASE) AEXP1: ACALL AMUL ;TOS = FRACTIONS * LN(BASE) ACALL PLNEXP ;TOS = EXP(1) ACALL SWAP_ASTKA ;TOS = FRACTIONS * LN(BASE) ACALL EBIAS ;T2 = FRACTIONS, TOS = INT MULTIPLIED MOV MT2,#00H ;NOW CALCULATE E**X ACALL PUSH_ONE ACALL CSTAKA ACALL POP_T1 ;T1 = 1 ; AEXL: ACALL P_T2 ;TOS = FRACTIONS ACALL AMUL ;TOS = FRACTIONS * ACCUMLATION INC MT2 ;DO THE DEMONIATOR MOV A,MT2 ACALL TWO_R2 ACALL ADIV ACALL CSTAKA ;SAVE THE ITERATION ACALL PUSH_T1 ;NOW ACCUMLATE ACALL AADD ;ADD ACCUMLATION ACALL TEMP_COMP JNB F0,AEXL ;LOOP UNTIL DONE ; ACALL INC_ASTKA ACALL PUSH_T1 ACALL AMUL ;LAST INT MULTIPLIED ; MU1: AJMP AMUL ;FIRST INT MULTIPLIED ; ;*************************************************************** ; ; integer operator - INT ; ;*************************************************************** ; AINT: ACALL SETREG ;SET UP THE REGISTERS, CLEAR CARRY SUBB A,#129 ;SUBTRACT EXPONENT BIAS JNC AI1 ;JUMP IF ACC > 81H ; ; Force the number to be a zero ; ACALL INC_ASTKA ;BUMP THE STACK ; P_Z: MOV DPTR,#ZRO ;PUT ZERO ON THE STACK AJMP PUSHC ; AI1: SUBB A,#7 JNC AI3 CPL A INC A MOV R3,A AI11: DEC R0 ;POINT AT SIGN ; AI2: DEC R0 ;NOW AT LSB'S MOVX A,@R0 ;READ BYTE ANL A,#0F0H ;STRIP NIBBLE MOVX @R0,A ;WRITE BYTE DJNZ R3,AI21 RET AI21: CLR A MOVX @R0,A ;CLEAR THE LOCATION DJNZ R3,AI2 ; AI3: RET ;EXIT ; ;*************************************************************** ; AABS: ; Absolute value - Make sign of number positive ; return sign in ACC ; ;*************************************************************** ; ACALL ANEG ;CHECK TO SEE IF + OR - JNZ ALPAR ;EXIT IF NON ZERO, BECAUSE THE NUM IS MOVX @R0,A ;MAKE A POSITIVE SIGN RET ; ;*************************************************************** ; ASGN: ; Returns the sign of the number 1 = +, -1 = - ; ;*************************************************************** ; ACALL INC_ASTKA ;POP STACK, GET EXPONENT JZ P_Z ;EXIT IF ZERO DEC R0 ;BUMP TO SIGN MOVX A,@R0 ;GET THE SIGN MOV R7,A ;SAVE THE SIGN ACALL PUSH_ONE ;PUT A ONE ON THE STACK MOV A,R7 ;GET THE SIGN JZ ALPAR ;EXIT IF ZERO ; ; Fall thru to ANEG ; ;*************************************************************** ; ANEG: ; Flip the sign of the number on the tos ; ;*************************************************************** ; ACALL SETREG DEC R0 ;POINT AT THE SIGN OF THE NUMBER JZ ALPAR ;EXIT IF ZERO MOVX A,@R0 XRL A,#01H ;FLIP THE SIGN MOVX @R0,A XRL A,#01H ;RESTORE THE SIGN ; ALPAR: RET ; ;*************************************************************** ; ACBYTE: ; Read the ROM ; ;*************************************************************** ; ACALL IFIX ;GET EXPRESSION CALL X31DP ;PUT R3:R1 INTO THE DP CLR A MOVC A,@A+DPTR AJMP TWO_R2 ; ;*************************************************************** ; ADBYTE: ; Read internal memory ; ;*************************************************************** ; ACALL IFIX ;GET THE EXPRESSION CALL R3CK ;MAKE SURE R3 = 0 MOV A,@R1 AJMP TWO_R2 ; ;*************************************************************** ; AXBYTE: ; Read external memory ; ;*************************************************************** ; ACALL IFIX ;GET THE EXPRESSION AXBYTE1:MOV P2,R3 MOVX A,@R1 AJMP TWO_R2 ; ;*************************************************************** ; ; The relational operators - EQUAL (=) ; GREATER THAN (>) ; LESS THAN (<) ; GREATER THAN OR EQUAL (>=) ; LESS THAN OR EQUAL (<=) ; NOT EQUAL (<>) ; ;*************************************************************** ; AGT: ACALL CMPLK ORL C,F0 ;SEE IF EITHER IS A ONE AGT1: JC P_Z ; FSTK: MOV DPTR,#FS AJMP PUSHC ; FS: DB 85H DB 00H DB 00H DB 50H DB 53H DB 65H ; ALT: ACALL CMPLK ALT1: CPL C SJMP AGT1 ; AEQ: ACALL CMPLK AEQ1: MOV C,F0 SJMP ALT1 ; ANE: ACALL CMPLK CPL F0 SJMP AEQ1 ; AGE: ACALL CMPLK SJMP AGT1 ; ALE: ACALL CMPLK ORL C,F0 SJMP ALT1 ; ;*************************************************************** ; ARND: ; Generate a random number ; ;*************************************************************** ; MOV DPTR,#RCELL ;GET THE BINARY SEED CALL L31DPI MOV A,R1 CLR C RRC A MOV R0,A MOV A,#6 RRC A ADD A,R1 XCH A,R0 ADDC A,R3 MOV R2,A DEC DPL ;SAVE THE NEW SEED ACALL S20DP ACALL TWO_EY ACALL FSTK ; ADIV: LCALL FP_BASE4 AJMP FPTST ; ;*************************************************************** ; SONERR: ; ON ERROR Statement ; ;*************************************************************** ; LCALL INTERR ;GET THE LINE NUMBER SETB ON_ERR MOV DPTR,#ERRNUM ;POINT AT THR ERROR LOCATION SJMP S20DP ; ; ;************************************************************** ; SONEXT: ; ON EXT1 Statement ; ;************************************************************** ; LCALL INTERR SETB INTBIT ORL IE,#10000100B ;ENABLE INTERRUPTS MOV DPTR,#INTLOC ; S20DP: MOV A,R2 ;SAVE R2:R0 @DPTR MOVX @DPTR,A INC DPTR MOV A,R0 MOVX @DPTR,A RET ; ;*************************************************************** ; ; CASTAK - Copy and push another top of arg stack ; ;*************************************************************** ; CSTAKA2:ACALL CSTAKA ;COPY STACK TWICE ; CSTAKA: ACALL SETREG ;SET UP R2:R0 SJMP PUSH_T12 ; PLNEXP: MOV DPTR,#EXP1 ; ;*************************************************************** ; ; PUSHC - Push constant on to the arg stack ; ;*************************************************************** ; PUSHC: ACALL DEC_ASTKA MOV P2,R3 MOV R3,#FPSIZ ;LOOP COUNTER ; PCL: CLR A ;SET UP A MOVC A,@A+DPTR ;LOAD IT MOVX @R1,A ;SAVE IT INC DPTR ;BUMP POINTERS DEC R1 DJNZ R3,PCL ;LOOP ; SETB ARGF RET ;EXIT ; PUSH_ONE:; ; MOV DPTR,#FPONE AJMP PUSHC ; POP_T1: ; MOV R3,#HIGH FPT1 MOV R1,#LOW FPT1 JMP POPAS ; PUSH_T1: ; MOV R0,#LOW FPT1 PUSH_T11: MOV R2,#HIGH FPT1 PUSH_T12: LJMP PUSHAS ; P_T2: MOV R0,#LOW FPT2 SJMP PUSH_T11 ;JUMP TO PUSHAS ; ;**************************************************************** ; SWAP_ASTKA: ; SWAP TOS<>TOS-1 ; ;**************************************************************** ; ACALL SETREG ;SET UP R2:R0 AND P2 MOV A,#FPSIZ ;PUT TOS+1 IN R1 MOV R2,A ADD A,R0 MOV R1,A ; S_L: MOVX A,@R0 MOV R3,A MOVX A,@R1 MOVX @R0,A MOV A,R3 MOVX @R1,A DEC R1 DEC R0 DJNZ R2,S_L RET ; C2_T2: ACALL SETREG ;SET UP R2:R0 MOV R3,#HIGH FPT2 MOV R1,#LOW FPT2 ;TEMP VALUE ; ; Fall thru ; ;*************************************************************** ; ; VARCOP - Copy a variable from R2:R0 to R3:R1 ; ;*************************************************************** ; VARCOP: MOV R4,#FPSIZ ;LOAD THE LOOP COUNTER ; V_C: MOV P2,R2 ;SET UP THE PORTS MOVX A,@R0 ;READ THE VALUE MOV P2,R3 ;PORT TIME AGAIN MOVX @R1,A ;SAVE IT ACALL DEC3210 ;BUMP POINTERS DJNZ R4,V_C ;LOOP RET ;EXIT ; PIPI: MOV DPTR,#PIE AJMP PUSHC ; ;*************************************************************** ; ; The logical operators ANL, ORL, XRL, NOT ; ;*************************************************************** ; AANL: ACALL TWOL ;GET THE EXPRESSIONS MOV A,R3 ;DO THE AND ANL A,R7 MOV R2,A MOV A,R1 ANL A,R6 SJMP TWO_EX ; AORL: ACALL TWOL ;SAME THING FOR OR MOV A,R3 ORL A,R7 MOV R2,A MOV A,R1 ORL A,R6 SJMP TWO_EX ; ANOT: ACALL FSTK ;PUT 0FFFFH ON THE STACK ; AXRL: ACALL TWOL MOV A,R3 XRL A,R7 MOV R2,A MOV A,R1 XRL A,R6 SJMP TWO_EX ; TWOL: ACALL IFIX MOV R7,R3B0 MOV R6,R1B0 AJMP IFIX ; ;************************************************************* ; AGET: ; READ THE BREAK BYTE AND PUT IT ON THE ARG STACK ; ;************************************************************* ; MOV DPTR,#GTB ;GET THE BREAK BYTE MOVX A,@DPTR JBC GTRD,TWO_R2 CLR A ; TWO_R2: MOV R2,#00H ;ACC GOES TO STACK ; ; TWO_EX: MOV R0,A ;R2:ACC GOES TO STACK ; ; TWO_EY: SETB ARGF ;R2:R0 GETS PUT ON THE STACK JMP FP_BASE12 ;DO IT ; ;************************************************************* ; ; Put directs onto the stack ; ;************************************************************** ; A_IE: MOV A,IE ;IE SJMP TWO_R2 ; A_IP: MOV A,IP ;IP SJMP TWO_R2 ; ATIM0: MOV R2,TH0 ;TIMER 0 MOV R0,TL0 SJMP TWO_EY ; ATIM1: MOV R2,TH1 ;TIMER 1 MOV R0,TL1 SJMP TWO_EY ; ATIM2: MOV R2,TH2 MOV R0,TL2 ; DB 0AAH ;MOV R2 DIRECT OP CODE ; DB 0CDH ;T2 HIGH ; DB 0A8H ;MOV R0 DIRECT OP CODE ; DB 0CCH ;T2 LOW SJMP TWO_EY ;TIMER 2 ; AT2CON: MOV A,T2CON ; DB 0E5H ;MOV A,DIRECT OPCODE ; DB 0C8H ;T2CON LOCATION SJMP TWO_R2 ; ATCON: MOV A,TCON ;TCON SJMP TWO_R2 ; ATMOD: MOV A,TMOD ;TMOD SJMP TWO_R2 ; ARCAP2: MOV R2,RCAPH2 MOV R0,RCAPL2 ; DB 0AAH ;MOV R2, DIRECT OP CODE ; DB 0CBH ;RCAP2H LOCATION ; DB 0A8H ;MOV R0, DIRECT OP CODE ; DB 0CAH ;R2CAPL LOCATION SJMP TWO_EY ; AP1: MOV A,P1 ;GET P1 SJMP TWO_R2 ;PUT IT ON THE STACK ; APCON: MOV A,PCON ; DB 0E5H ;MOV A, DIRECT OP CODE ; DB 87H ;ADDRESS OF PCON SJMP TWO_R2 ;PUT PCON ON THE STACK ; ;*************************************************************** ; ;THIS IS THE LINE EDITOR ; ;TAKE THE PROCESSED LINE IN IBUF AND INSERT IT INTO THE ;BASIC TEXT FILE. ; ;*************************************************************** ; LINE0: LJMP NOGO ;CAN'T EDIT A ROM ; LINE: MOV A,BOFAH CJNE A,#HIGH PSTART,LINE0 CALL G4 ;GET END ADDRESS FOR EDITING MOV R4,DPL MOV R5,DPH MOV R3,TEMP5 ;GET HIGH ORDER IBLN MOV R1,TEMP4 ;LOW ORDER IBLN ; CALL GETLIN ;FIND THE LINE JNZ INSR ;INSERT IF NOT ZERO, ELSE APPEND ; ;APPEND THE LINE AT THE END ; MOV A,TEMP3 ;PUT IBCNT IN THE ACC CJNE A,#4H,LINE1 ;SEE IF NO ENTRY RET ;RET IF NO ENTRY ; LINE1: ACALL FULL ;SEE IF ENOUGH SPACE LEFT MOV R2,R5B0 ;PUT END ADDRESS A INTO TRANSFER MOV R0,R4B0 ;REGISTERS ACALL IMOV ;DO THE BLOCK MOVE ; UE: MOV A,#EOF ;SAVE EOF CHARACTER AJMP TBR ; ;INSERT A LINE INTO THE FILE ; INSR: MOV R7,A ;SAVE IT IN R7 CALL TEMPD ;SAVE INSERATION ADDRESS MOV A,TEMP3 ;PUT THE COUNT LENGTH IN THE ACC JC LTX ;JUMP IF NEW LINE # NOT = OLD LINE # CJNE A,#04H,INSR1 ;SEE IF NULL CLR A ; INSR1: SUBB A,R7 ;SUBTRACT LINE COUNT FROM ACC JZ LIN1 ;LINE LENGTHS EQUAL JC GTX ;SMALLER LINE ; ;EXPAND FOR A NEW LINE OR A LARGER LINE ; LTX: MOV R7,A ;SAVE A IN R7 MOV A,TEMP3 ;GET THE COUNT IN THE ACC CJNE A,#04H,LTX1 ;DO NO INSERTATION IF NULL LINE RET ;EXIT IF IT IS ; LTX1: MOV A,R7 ;GET THE COUNT BACK - DELTA IN A ACALL FULL ;SEE IF ENOUGH MEMORY NEW EOFA IN R3:R1 CALL DTEMP ;GET INSERATION ADDRESS ACALL NMOV ;R7:R6 GETS (EOFA)-DPTR CALL X3120 MOV R1,R4B0 ;EOFA LOW MOV R3,R5B0 ;EOFA HIGH INC R6 ;INCREMENT BYTE COUNT CJNE R6,#00,LTX2 ;NEED TO BUMP HIGH BYTE? INC R7 ; LTX2: ACALL RMOV ;GO DO THE INSERTION SJMP LIN1 ;INSERT THE CURRENT LINE ; GTX: CPL A ;FLIP ACC INC A ;TWOS COMPLEMENT CALL ADDPTR ;DO THE ADDITION ACALL NMOV ;R7:R6 GETS (EOFA)-DPTR MOV R1,DPL ;SET UP THE REGISTERS MOV R3,DPH MOV R2,TEMP5 ;PUT INSERTATION ADDRESS IN THE RIGHT REG MOV R0,TEMP4 JZ GTX1 ;IF ACC WAS ZERO FROM NMOV, JUMP ACALL LMOV ;IF NO ZERO DO A LMOV ; GTX1: ACALL UE ;SAVE NEW END ADDRESS ; LIN1: MOV R2,TEMP5 ;GET THE INSERTATION ADDRESS MOV R0,TEMP4 MOV A,TEMP3 ;PUT THE COUNT LENGTH IN ACC CJNE A,#04H,IMOV ;SEE IF NULL RET ;EXIT IF NULL ; ;*************************************************************** ; ;INSERT A LINE AT ADDRESS R2:R0 ; ;*************************************************************** ; IMOV: CLR A ;TO SET UP MOV R1,#LOW IBCNT ;INITIALIZE THE REGISTERS MOV R3,A MOV R6,TEMP3 ;PUT THE BYTE COUNT IN R6 FOR LMOV MOV R7,A ;PUT A 0 IN R7 FOR LMOV ; ;*************************************************************** ; ;COPY A BLOCK FROM THE BEGINNING ; ;R2:R0 IS THE DESTINATION ADDRESS ;R3:R1 IS THE SOURCE ADDRESS ;R7:R6 IS THE COUNT REGISTER ; ;*************************************************************** ; LMOV: ACALL TBYTE ;TRANSFER THE BYTE ACALL INC3210 ;BUMP THE POINTER ACALL DEC76 ;BUMP R7:R6 JNZ LMOV ;LOOP RET ;GO BACK TO CALLING ROUTINE ; INC3210:INC R0 CJNE R0,#00H,INC3211 INC R2 ; INC3211:INC R1 CJNE R1,#00H,INC3212 INC R3 INC3212:RET ; ;*************************************************************** ; ;COPY A BLOCK STARTING AT THE END ; ;R2:R0 IS THE DESTINATION ADDRESS ;R3:R1 IS THE SOURCE ADDRESS ;R6:R7 IS THE COUNT REGISTER ; ;*************************************************************** ; RMOV: ACALL TBYTE ;TRANSFER THE BYTE ACALL DEC3210 ;DEC THE LOCATIONS ACALL DEC76 ;BUMP THE COUNTER JNZ RMOV ;LOOP ; DEC_R: NOP ;CREATE EQUAL TIMING RET ;EXIT ; DEC3210:DEC R0 ;BUMP THE POINTER CJNE R0,#0FFH,DEC3212;SEE IF OVERFLOWED DEC3211:DEC R2 ;BUMP THE HIGH BYTE DEC3212:DEC R1 ;BUMP THE POINTER CJNE R1,#0FFH,DEC_R ;SEE IF OVERFLOWED DEC R3 ;CHANGE THE HIGH BYTE RET ;EXIT ; ;*************************************************************** ; ;TBYTE - TRANSFER A BYTE ; ;*************************************************************** ; TBYTE: MOV P2,R3 ;OUTPUT SOURCE REGISTER TO PORT MOVX A,@R1 ;PUT BYTE IN ACC ; TBR: MOV P2,R2 ;OUTPUT DESTINATION TO PORT MOVX @R0,A ;SAVE THE BYTE RET ;EXIT ; ;*************************************************************** ; ;NMOV - R7:R6 = END ADDRESS - DPTR ; ;ACC GETS CLOBBERED ; ;*************************************************************** ; NMOV: MOV A,R4 ;THE LOW BYTE OF EOFA CLR C ;CLEAR THE CARRY FOR SUBB SUBB A,DPL ;SUBTRACT DATA POINTER LOW MOV R6,A ;PUT RESULT IN R6 MOV A,R5 ;HIGH BYTE OF EOFA SUBB A,DPH ;SUBTRACT DATA POINTER HIGH MOV R7,A ;PUT RESULT IN R7 ORL A,R6 ;SEE IF ZERO NMOV1: RET ;EXIT ; ;*************************************************************** ; ;CHECK FOR A FILE OVERFLOW ;LEAVES THE NEW END ADDRESS IN R3:R1 ;A HAS THE INCREASE IN SIZE ; ;*************************************************************** ; FULL: ADD A,R4 ;ADD A TO END ADDRESS MOV R1,A ;SAVE IT CLR A ADDC A,R5 ;ADD THE CARRY MOV R3,A MOV DPTR,#VARTOP ;POINT AT VARTOP ; FUL1: CALL DCMPX ;COMPARE THE TWO JC NMOV1 ;OUT OF ROOM ; TB: MOV DPTR,#E5X ;OUT OF MEMORY AJMP FPTS ; ;*************************************************************** ; ; PP - Preprocesses the line in IBUF back into IBUF ; sets F0 if no line number ; leaves the correct length of processed line in IBCNT ; puts the line number in IBLN ; wastes the text address TXAL and TXAH ; ;*************************************************************** ; PP: ACALL T_BUF ;TXA GETS IBUF CALL INTGER ;SEE IF A NUMBER PRESENT CALL TEMPD ;SAVE THE INTEGER IN TEMP5:TEMP4 MOV F0,C ;SAVE INTEGER IF PRESENT MOV DPTR,#IBLN ;SAVE THE LINE NUMBER, EVEN IF NONE ACALL S20DP MOV R0,TXAL ;TEXT POINTER MOV R1,#LOW IBUF ;STORE POINTER ; ; Now process the line back into IBUF ; PPL: CLR ARGF ;FIRST PASS DESIGNATOR MOV DPTR,#TOKTAB ;POINT DPTR AT LOOK UP TABLE ; PPL1: MOV R5B0,R0 ;SAVE THE READ POINTER CLR A ;ZERO A FOR LOOKUP MOVC A,@A+DPTR ;GET THE TOKEN MOV R7,A ;SAVE TOKEN IN CASE OF MATCH ; PPL2: MOVX A,@R0 ;GET THE USER CHARACTER MOV R3,A ;SAVE FOR REM CJNE A,#'a',PPL21 PPL21: JC PPX ;CONVERT LOWER TO UPPER CASE CJNE A,#('z'+1),PPL22 PPL22: JNC PPX CLR ACC.5 ; PPX: MOV R2,A MOVX @R0,A ;SAVE UPPER CASE INC DPTR ;BUMP THE LOOKUP POINTER CLR A MOVC A,@A+DPTR CJNE A,R2B0,PPL3 ;LEAVE IF NOT THE SAME INC R0 ;BUMP THE USER POINTER SJMP PPL2 ;CONTINUE TO LOOP ; PPL3: JB ACC.7,PPL6 ;JUMP IF FOUND MATCH JZ PPL6 ;USER MATCH ; ; ; Scan to the next TOKTAB entry ; PPL4: INC DPTR ;ADVANCE THE POINTER CLR A ;ZERO A FOR LOOKUP MOVC A,@A+DPTR ;LOAD A WITH TABLE JB ACC.7,PPL41 ;KEEP SCANNING IF NOT A RESERVED WORD JNZ PPL4 INC DPTR ; ; See if at the end of TOKTAB ; PPL41: MOV R0,R5B0 ;RESTORE THE POINTER CJNE A,#0FFH,PPL1 ;SEE IF END OF TABLE ; ; Character not in TOKTAB, so see what it is ; CJNE R2,#' ',PPLX ;SEE IF A SPACE INC R0 ;BUMP USER POINTER SJMP PPL ;TRY AGAIN ; PPLX: JNB XBIT,PPLY ;EXTERNAL TRAP JB ARGF,PPLY SETB ARGF ;SAYS THAT THE USER HAS TABLE LCALL 2078H ;SET UP POINTER AJMP PPL1 ; PPLY: ACALL PPL7 ;SAVE CHARACTER, EXIT IF A CR CJNE A,#'"',PPL ;SEE IF QUOTED STRING, START AGAIN IF NOT ; ; Just copy a quoted string ; PPLY1: ACALL PPL7 ;SAVE THE CHARACTER, TEST FOR CR CJNE A,#'"',PPLY1 ;IS THERE AN ENDQUOTE, IF NOT LOOP SJMP PPL ;DO IT AGAIN IF ENDQUOTE ; PPL6: MOV A,R7 ;GET THE TOKEN ACALL PPL91 ;SAVE THE TOKEN CJNE A,#T_REM,PPL ;SEE IF A REM TOKEN MOV A,R3 ACALL PPL71 ;WASTE THE REM STATEMENT PPL61: ACALL PPL7 ;LOOP UNTIL A CR SJMP PPL61 ; PPL7: MOVX A,@R0 ;GET THE CHARACTER PPL71: CJNE A,#CR,PPL9 ;FINISH IF A CR POP R0B0 ;WASTE THE CALLING STACK POP R0B0 MOVX @R1,A ;SAVE CR IN MEMORY INC R1 ;SAVE A TERMINATOR MOV A,#EOF MOVX @R1,A MOV A,R1 ;SUBTRACT FOR LENGTH SUBB A,#4 MOV TEMP3,A ;SAVE LENGTH MOV R1,#LOW IBCNT ;POINT AT BUFFER COUNT ; PPL9: INC R0 PPL91: MOVX @R1,A ;SAVE THE CHARACTER INC R1 ;BUMP THE POINTERS RET ;EXIT TO CALLING ROUTINE ; ; ;*************************************************************** ; ;DEC76 - DECREMENT THE REGISTER PAIR R7:R6 ; ;ACC = ZERO IF R7:R6 = ZERO ; ELSE ACC DOES NOT ; ;*************************************************************** ; DEC76: DEC R6 ;BUMP R6 CJNE R6,#0FFH,DEC77 ;SEE IF RAPPED AROUND DEC R7 DEC77: MOV A,R7 ;SEE IF ZERO ORL A,R6 RET ;EXIT ; ;*************************************************************** ; ; MTOP - Get or Put the top of assigned memory ; ;*************************************************************** ; PMTOP: MOV DPTR,#MEMTOP PMTOP1: CALL L20DPI AJMP TWO_EY ;PUT R2:R0 ON THE STACK ; ;************************************************************* ; ; AXTAL - Crystal value calculations ; ;************************************************************* ; AXTAL0: MOV DPTR,#XTALV ;CRYSTAL VALUE ACALL PUSHC ; AXTAL1: ACALL CSTAKA2 ;COPY CRYSTAL VALUE TWICE ; ;***************************************************************************** ;****** Disable Intel programming for to get room **************************** ; ; ACALL CSTAKA ;Copy crystal value the 3rd. ; ;***************************************************************************** ; MOV DPTR,#PTIME ;PROM TIMER ACALL AXTAL2 MOV DPTR,#PROGS ACALL S31L ; ;***************************************************************************** ;****** Disable Intel programming for to get room **************************** ; ; MOV DPTR,#IPTIME ;IPROM TIMER ; ACALL AXTAL2 ; MOV DPTR,#IPROGS ; ACALL S31L ; ;***************************************************************************** ; MOV DPTR,#TTIME ;CLOCK CALCULATION ACALL AXTAL3 MOV A,R1 CPL A INC A MOV SAVE_T,A MOV R3,#HIGH CXTAL MOV R1,#LOW CXTAL JMP POPAS ; AXTAL2: ACALL AXTAL3 ; CBIAS: ;Bias the crystal calculations ; MOV A,R1 ;GET THE LOW COUNT CPL A ;FLIP IT FOR TIMER LOAD ADD A,#15 ;BIAS FOR CALL AND LOAD TIMES MOV R1,A ;RESTORE IT MOV A,R3 ;GET THE HIGH COUNT CPL A ;FLIP IT ADDC A,#00H ;ADD THE CARRY MOV R3,A ;RESTORE IT RET ; ;************************************************************** ; STONE: ; Toggle the I/O port ; ;************************************************************** ; CALL THREE ;GET THE NUMBERS ACALL CBIAS ;BIAS R3:R1 FOR COUNT LOOP ; STONE1: CLR T_BIT ;TOGGLE THE BIT CLR TR1 ;STOP THE TIMER MOV TH1,R3 ;LOAD THE TIMER MOV TL1,R1 CLR TF1 ;CLEAR THE OVERFLOW FLAG SETB TR1 ;TURN IT ON ACALL DEC76 JNB TF1,$ ;WAIT ACALL ALPAR SETB T_BIT ;BACK TO A ONE CALL TIMER_LOAD1 ;LOAD THE HIGH VALUE JNB TF1,$ ;WAIT JNZ STONE1 ;LOOP RET ; ;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN ; LNTAB: ; Natural log lookup table ; ;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN ; DB 80H DB 00H DB 71H DB 37H DB 13H DB 19H ; DB 7FH DB 00H DB 76H DB 64H DB 37H DB 94H ; DB 80H DB 00H DB 07H DB 22H DB 75H DB 17H ; DB 80H DB 00H DB 52H DB 35H DB 93H DB 28H ; DB 80H DB 00H DB 71H DB 91H DB 85H DB 86H ; DB 0FFH ; DB 81H DB 00H DB 51H DB 58H DB 02H DB 23H ; ;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN ; SINTAB: ; Sin lookup table ; ;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN ; DB 128-9 DB 00H DB 44H DB 90H DB 05H DB 16H ; DB 128-7 DB 01H DB 08H DB 21H DB 05H DB 25H ; DB 128-5 DB 00H DB 19H DB 73H DB 55H DB 27H DB 128-3 DB 01H DB 70H DB 12H DB 84H DB 19H ; DB 128-2 DB 00H DB 33H DB 33H DB 33H DB 83H ; DB 128 DB 01H DB 67H DB 66H DB 66H DB 16H ; FPONE: DB 128+1 DB 00H DB 00H DB 00H DB 00H DB 10H ; DB 0FFH ;END OF TABLE ; SBAUD: CALL AXTAL ;PUT CRYSTAL ON THE STACK CALL EXPRB ;PUT THE NUMBER AFTER BAUD ON STACK MOV A,#12 ACALL TWO_R2 ;TOS = 12 ACALL AMUL ;TOS = 12*BAUD ACALL ADIV ;TOS = XTAL/(12*BAUD) ACALL IFIX ACALL CBIAS MOV DPTR,#SPV ; S31L: JMP S31DP ; AFREE: CALL PMTOP ;PUT MTOP ON STACK CALL G4 ;GET END ADDRESS MOV R0,DPL MOV R2,DPH ACALL TWO_EY ; ASUB: LCALL FP_BASE1 ;DO FP SUB AJMP FPTST ; ALEN: CALL CCAL ;CALCULATE THE LEN OF THE SELECTED PROGRAM MOV R2,R7B0 ;SAVE THE HIGH BYTE MOV A,R6 ;SAVE THE LOW BYTE AJMP TWO_EX ;PUT IT ON THE STACK ; ATIME: MOV C,EA ;SAVE INTERRUTS CLR EA PUSH MILLIV ;SAVE MILLI VALUE MOV R2,TVH ;GET THE TIMER MOV A,TVL MOV EA,C ;SAVE INTERRUPTS ACALL TWO_EX ;PUT TIMER ON THE STACK POP ACC ;GET MILLI ACALL TWO_R2 ;PUT MILLI ON STACK MOV A,#200 ACALL TWO_R2 ;DIVIDE MILLI BY 200 ACALL ADIV ; AADD: LCALL FP_BASE ;DO FP ADDITION AJMP FPTST ;CHECK FOR ERRORS ; ;************************************************************** ; ; Here are some error messages that were moved ; ;************************************************************** ; ; E1X: DB 'BAD SYNTAX"' E2X: DB 128+10 DB 'DIVIDE BY ZERO"' ; E6X: DB 'ARRAY SIZE"' ; ;************************************************************** ; T_BUF: ; TXA gets IBUF ; ;************************************************************** ; MOV TXAH,#HIGH IBUF MOV TXAL,#LOW IBUF RET ; ; ;*************************************************************** ; CXFER: ; Transfer a program from rom to ram ; ;*************************************************************** ; CALL CCAL ;GET EVERYTHING SET UP MOV R2,#HIGH PSTART MOV R0,#LOW PSTART ACALL LMOV ;DO THE TRANSFER CALL RCLEAR ;CLEAR THE MEMORY ; ; Fall thru to CRAM ; ;*************************************************************** ; CRAM: ; The command action routine - RAM - Run out of ram ; ;*************************************************************** ; CLR CONB ;CAN'T CONTINUE IF MODE CHANGE MOV BOFAH,#HIGH PSTART MOV BOFAL,#LOW PSTART ; ; Fall thru to Command Processor ; ;*************************************************************** ; CMND1: ; The entry point for the command processor ; ;*************************************************************** ; LCALL SPRINT1 ;WASTE AT AND HEX CLR XBIT ;TO RESET IF NEEDED ; ;***************************************************************************** ;****** Karmann 1 Bugfix ***************************************************** ; acall TEST_USER ;check for user command extensions ; ;****** continue with original code: ***************************************** ; MOV DPTR,#RDYS ;PRINT THE READY MESSAGE CALL CRP ;DO A CR, THEN, PRINT FROM THE ROM ; CMNDR: SETB DIRF ;SET THE DIRECT INPUT BIT MOV SP,SPSAV ;LOAD THE STACK ACALL CL7 ;DO A CRLF ; CMNX: CLR GTRD ;CLEAR BREAK MOV DPTR,#5EH ;DO RUN TRAP MOVX A,@DPTR XRL A,#52 JNZ CMNX1 LJMP CRUN CMNX1: MOV R5,#'>' ;OUTPUT A PROMPT LCALL TEROT CALL INLINE ;INPUT A LINE INTO IBUF CALL PP ;PRE-PROCESS THE LINE JB F0,CMND3 ;NO LINE NUMBER CALL LINE ;PROCESS THE LINE LCALL LCLR JB LINEB,CMNX ;DON'T CLEAR MEMORY IF NO NEED SETB LINEB LCALL RCLEAR ;CLEAR THE MEMORY SJMP CMNX ;LOOP BACK ; CMND3: CALL T_BUF ;SET UP THE TEXT POINTER CALL DELTST ;GET THE CHARACTER JZ CMNDR ;IF CR, EXIT MOV DPTR,#CMNDD ;POINT AT THE COMMAND LOOKUP CJNE A,#T_CMND,CMND31;PROCESS STATEMENT IF NOT A COMMAND CMND31: JC CMND5 CALL GCI1 ;BUMP TXA ANL A,#0FH ;STRIP MSB'S FOR LOOKUP LCALL ISTA1 ;PROCESS COMMAND SJMP CMNDR ; CMND5: LJMP ILOOP ;CHECK FOR A POSSIBLE BREAK ; ;***************************************************************************** ;****** Karmann 1 Bugfix ***************************************************** ; TEST_USER: ;check for user command extensions CLR A MOV DPTR,#2002H ;CHECK FOR EXTERNAL TRAP PACKAGE MOVC A,@A+DPTR CJNE A,#5AH,CMND11 ;test for user commands LCALL 2048H ;IF PRESENT JUMP TO LOCATION 200BH CMND11: ret ; ;****** continue with original code: ***************************************** ; ;CONSTANTS ; XTALV: DB 128+8 ; DEFAULT CRYSTAL VALUE DB 00H DB 00H DB 92H DB 05H DB 11H ; EXP11: DB 85H DB 00H DB 42H DB 41H DB 87H DB 59H ; EXP1: DB 128+1 ; EXP(1) DB 00H DB 18H DB 28H DB 18H DB 27H ; ;***************************************************************************** ;****** Disable Intel programming for to get room **************************** ; ;IPTIME: DB 128-4 ;FPROG TIMING ; DB 00H ; DB 00H ; DB 00H ; DB 75H ; DB 83H ; ;***************************************************************************** ; PIE: DB 128+1 ;PI DB 00H DB 26H DB 59H DB 41H DB 31H ; 3.1415926 ; ;*************************************************************** ; ; The error messages, some have been moved ; ;*************************************************************** ; E7X: DB 128+30 DB 'ARITH. UNDERFLOW"' ; E5X: DB 'MEMORY ALLOCATION"' ; E3X: DB 128+40 DB 'BAD ARGUMENT"' ; EXI: DB 'I-STACK"' ; ;*************************************************************** ; ; The command action routine - CONTINUE ; ;*************************************************************** ; CCONT: MOV DPTR,#E15X JNB CONB,ERROR ;ERROR IF CONTINUE IS NOT SET ; CC1: ;used for input statement entry ; MOV TXAH,INTXAH ;RESTORE TXA MOV TXAL,INTXAL JMP CILOOP ;EXECUTE ; DTEMP: MOV DPH,TEMP5 ;RESTORE DPTR MOV DPL,TEMP4 RET ; TEMPD: MOV TEMP5,DPH MOV TEMP4,DPL RET ; ;************************************************************** ; I_DL: ; IDLE ; ;************************************************************** ; JB DIRF,E1XX ;SYNTAX ERROR IN DIRECT INPUT CLR DACK ;ACK IDLE ; U_ID1: ORL PCON,#01H ; DB 01000011B ;ORL DIRECT OP CODE ; DB 87H ;PCON ADDRESS ; DB 01H ;SET IDLE BIT JB INTPEN,I_RET ;EXIT IF EXTERNAL INTERRUPT JBC U_IDL,I_RET ;EXIT IF USER WANTS TO JNB OTS,U_ID1 ;LOOP IF TIMER NOT ENABLED LCALL T_CMP ;CHECK THE TIMER JC U_ID1 ;LOOP IF TIME NOT BIG ENOUGH ; I_RET: SETB DACK ;RESTORE EXECUTION RET ;EXIT IF IT IS ; ; ; ER0: INC DPTR ;BUMP TO TEXT JB DIRF,ERROR0 ;CAN'T GET OUT OF DIRECT MODE JNB ON_ERR,ERROR0 ;IF ON ERROR ISN'T SET, GO BACK MOV DPTR,#ERRLOC ;SAVE THE ERROR CODE CALL RC2 ;SAVE ERROR AND SET UP THE STACKS INC DPTR ;POINT AT ERRNUM JMP ERL4 ;LOAD ERR NUM AND EXIT ; ; Syntax error ; E1XX: MOV C,DIRF ;SEE IF IN DIRECT MODE E1XX1: MOV DPTR,#E1X ;ERROR MESSAGE SJMP ERROR1 ;TRAP ON SET DIRF ; E1XX2: MOV DPTR,#EXI ;STACK ERROR ; ; Falls through ; ;*************************************************************** ; ;ERROR PROCESSOR - PRINT OUT THE ERROR TYPE, CHECK TO SEE IF IN ; RUN OR COMMAND MODE, FIND AND PRINT OUT THE ; LINE NUMBER IF IN RUN MODE ; ;*************************************************************** ; ERROR: CLR C ;RESET STACK ERROR1: MOV SP,SPSAV ;RESET THE STACK LCALL SPRINT1 ;CLEAR LINE AND AT MODE CLR A ;SET UP TO GET ERROR CODE MOVC A,@A+DPTR JBC ACC.7,ER0 ;PROCESS ERROR ; ERROR0: ACALL TEMPD ;SAVE THE DATA POINTER JC ERROR01 ;NO RESET IF CARRY IS SET LCALL RC1 ;RESET THE STACKS ERROR01:CALL CRLF2 ;DO TWO CARRIAGE RET - LINE FEED MOV DPTR,#ERS ;OUTPUT ERROR MESSAGE CALL ROM_P CALL DTEMP ;GET THE ERROR MESSAGE BACK ; ERRS: CALL ROM_P ;PRINT ERROR TYPE JNB DIRF,ER1 ;DO NOT PRINT IN LINE IF DIRF=1 ; SERR1: CLR STOPBIT ;PRINT STOP THEN EXIT, FOR LIST JMP CMND1 ; ER1: MOV DPTR,#INS ;OUTPUT IN LINE CALL ROM_P ; ;NOW, FIND THE LINE NUMBER ; ; CALL DP_B ;GET THE FIRST ADDRESS OF THE PROGRAM CLR A ;FOR INITIALIZATION ; ER2: ACALL TEMPD ;SAVE THE DPTR CALL ADDPTR ;ADD ACC TO DPTR ACALL ER4 ;R3:R1 = TXA-DPTR JC ER3 ;EXIT IF DPTR>TXA JZ ER3 ;EXIT IF DPTR=TXA MOVX A,@DPTR ;GET LENGTH CJNE A,#EOF,ER2 ;SEE IF AT THE END ; ER3: ACALL DTEMP ;PUT THE LINE IN THE DPTR ACALL ER4 ;R3:R1 = TXA - BEGINNING OF LINE MOV A,R1 ;GET LENGTH ADD A,#10 ;ADD 10 TO LENGTH, DPTR STILL HAS ADR MOV MT1,A ;SAVE THE COUNT INC DPTR ;POINT AT LINE NUMBER HIGH BYTE CALL PMTOP1 ;LOAD R2:R0, PUT IT ON THE STACK ACALL FP_BASE7 ;OUTPUT IT JB STOPBIT,SERR1 ;EXIT IF STOP BIT SET CALL CRLF2 ;DO SOME CRLF'S CALL DTEMP CALL UPPL ;UNPROCESS THE LINE CALL CL6 ;PRINT IT ER31: MOV R5,#'-' ;OUTPUT DASHES, THEN AN X ACALL T_L ;PRINT AN X IF ERROR CHARACTER FOUND DJNZ MT1,ER31 ;LOOP UNTIL DONE MOV R5,#'X' ACALL T_L AJMP SERR1 ; ER4: MOV R3,TXAH ;GET TEXT POINTER AND PERFORM SUBTRACTION MOV R1,TXAL JMP DUBSUB ; ;************************************************************** ; ; Interrupt driven timer ; ;************************************************************** ; I_DR: MOV TH0,SAVE_T ;LOAD THE TIMER XCH A,MILLIV ;SAVE A, GET MILLI COUNTER INC A ;BUMP COUNTER CJNE A,#200,TR ;CHECK OUT TIMER VALUE CLR A ;FORCE ACC TO BE ZERO INC TVL ;INCREMENT LOW TIMER CJNE A,TVL,TR ;CHECK LOW VALUE INC TVH ;BUMP TIMER HIGH ; TR: XCH A,MILLIV POP PSW RETI ; ;************************************************************** ; ; The statement action routine - CLOCK ; ;************************************************************** ; SCLOCK: ACALL OTST ;GET CHARACTER AFTER CLOCK TOKEN CLR ET0 CLR C_BIT JNC SC_R ;EXIT IF A ZERO ; ;***************************************************************************** ;****** Use XTAL up to 47 MHz ************************************************ ;****** Wulf 2 *************************************************************** ; ; ANL TMOD,#0F0H ;SET UP THE MODE ; anl TMOD,#0F1H ;Set up 16 bit mode for timer 0 orl TMOD,#01H ; ;***************************************************************************** ; SETB C_BIT ;USER INTERRUPTS ORL IE,#82H ;ENABLE ET0 AND EA SETB TR0 ;TURN ON THE TIMER ; SC_R: RET ; ;*************************************************************** ; SUI: ; Statement USER IN action routine ; ;*************************************************************** ; ACALL OTST MOV CIUB,C ;SET OR CLEAR CIUB RET ; ;*************************************************************** ; SUO: ; Statement USER OUT action routine ; ;*************************************************************** ; ACALL OTST MOV COUB,C RET ; OTST: ; Check for a one ; LCALL GCI ;GET THE CHARACTER, CLEARS CARRY SUBB A,#'1' ;SEE IF A ONE CPL C ;SETS CARRY IF ONE, CLEARS IT IF ZERO OTST1: RET ; ;************************************************************** ; ; IBLK - EXECUTE USER SUPPLIED TOKEN ; ;************************************************************** ; IBLK: JB PSW.4,OTST1 ;EXIT IF REGISTER BANK <> 0 JB PSW.3,OTST1 JBC ACC.7,IBLK1 ;SEE IF BIT SEVEN IS SET MOV DPTR,#USENT ;USER ENTRY LOCATION LJMP ISTA1 ; IBLK1: JB ACC.0,FP_BASE6 ;FLOATING POINT INPUT JZ T_L ;DO OUTPUT ON 80H MOV DPTR,#FP_BASE-2 JMP @A+DPTR ; ; ;************************************************************** ; ; GET_NUM - GET A NUMBER, EITHER HEX OR FLOAT ; ;************************************************************** ; GET_NUM:ACALL FP_BASE5 ;SCAN FOR HEX JNC FP_BASE6 ;DO FP INPUT ; ACALL FP_BASE9 ;ASCII STRING TO R2:R0 JNZ H_RET PUSH DPH ;SAVE THE DATA_POINTER PUSH DPL ACALL FP_BASE12 ;PUT R2:R0 ON THE STACK POP DPL ;RESTORE THE DATA_POINTER POP DPH CLR A ;NO ERRORS RET ;EXIT ; ;************************************************************** ; ; WB - THE EGO MESSAGE ; ;************************************************************** ; ;***************************************************************************** ;****** Sorry - but the ego message had to be disabled *********************** ; ;WB: ; ; DB 'W'+80H,'R'+80H ; DB 'I'+80H,'T'+80H,'T','E'+80H,'N'+80H ; DB ' ','B'+80H,'Y'+80H,' ' ; DB 'J'+80H,'O'+80H,'H'+80H,'N'+80H,' '+80H ; DB 'K','A'+80H,'T'+80H,'A'+80H,'U'+80H ; DB 'S','K'+80H,'Y'+80H ; DB ', I','N'+80H,'T'+80H,'E'+80H,'L'+80H ; DB ' '+80H,'C'+80H,'O'+80H,'R'+80H,'P'+80H ; DB '. 1','9'+80H,'85' ; ;***************************************************************************** ; H_RET: RET ; ;************************************************************ ; ; This is a complete BCD floating point package for the 8051 micro- ; controller. It provides 8 digits of accuracy with exponents that ; range from +127 to -127. The mantissa is in packed BCD, while the ; exponent is expressed in pseudo-twos complement. A ZERO exponent ; is used to express the number ZERO. An exponent value of 80H or ; greater than means the exponent is positive, i.e. 80H = E 0, ; 81H = E+1, 82H = E+2 and so on. If the exponent is 7FH or less, ; the exponent is negative, 7FH = E-1, 7EH = E-2, and so on. ; ALL NUMBERS ARE ASSUMED TO BE NORMALIZED and all results are ; normalized after calculation. A normalized mantissa is >=.10 and ; <=.99999999. ; ; The numbers in memory assumed to be stored as follows: ; ; EXPONENT OF ARGUMENT 2 = VALUE OF ARG_STACK+FP_NUMBER_SIZE ; SIGN OF ARGUMENT 2 = VALUE OF ARG_STACK+FP_NUMBER_SIZE-1 ; DIGIT 78 OF ARGUMENT 2 = VALUE OF ARG_STACK+FP_NUMBER_SIZE-2 ; DIGIT 56 OF ARGUMENT 2 = VALUE OF ARG_STACK+FP_NUMBER_SIZE-3 ; DIGIT 34 OF ARGUMENT 2 = VALUE OF ARG_STACK+FP_NUMBER_SIZE-4 ; DIGIT 12 OF ARGUMENT 2 = VALUE OF ARG_STACK+FP_NUMBER_SIZE-5 ; ; EXPONENT OF ARGUMENT 1 = VALUE OF ARG_STACK ; SIGN OF ARGUMENT 1 = VALUE OF ARG_STACK-1 ; DIGIT 78 OF ARGUMENT 1 = VALUE OF ARG_STACK-2 ; DIGIT 56 OF ARGUMENT 1 = VALUE OF ARG_STACK-3 ; DIGIT 34 OF ARGUMENT 1 = VALUE OF ARG_STACK-4 ; DIGIT 12 OF ARGUMENT 1 = VALUE OF ARG_STACK-5 ; ; The operations are performed thusly: ; ; ARG_STACK+FP_NUMBER_SIZE = ARG_STACK+FP_NUMBER_SIZE # ARG_STACK ; ; Which is ARGUMENT 2 = ARGUMENT 2 # ARGUMENT 1 ; ; Where # can be ADD, SUBTRACT, MULTIPLY OR DIVIDE. ; ; Note that the stack gets popped after an operation. ; ; The FP_COMP instruction POPS the ARG_STACK TWICE and returns status. ; ;********************************************************************** ; ;********************************************************************** ; ; STATUS ON RETURN - After performing an operation (+, -, *, /) ; the accumulator contains the following status ; ; ACCUMULATOR - BIT 0 - FLOATING POINT UNDERFLOW OCCURED ; ; - BIT 1 - FLOATING POINT OVERFLOW OCCURED ; ; - BIT 2 - RESULT WAS ZER0 ; ; - BIT 3 - DIVIDE BY ZERO ATTEMPTED ; ; - BIT 4 - NOT USED, 0 RETURNED ; ; - BIT 5 - NOT USED, 0 RETURNED ; ; - BIT 6 - NOT USED, 0 RETURNED ; ; - BIT 7 - NOT USED, 0 RETURNED ; ; NOTE: When underflow occures, a ZERO result is returned. ; When overflow or divide by zero occures, a result of ; .99999999 E+127 is returned and it is up to the user ; to handle these conditions as needed in the program. ; ; NOTE: The Compare instruction returns F0 = 0 if ARG 1 = ARG 2 ; and returns a CARRY FLAG = 1 if ARG 1 is > ARG 2 ; ;*********************************************************************** ; ;*********************************************************************** ; ; The following values MUST be provided by the user ; ;*********************************************************************** ; ARG_STACK EQU 9 ;ARGUMENT STACK POINTER ARG_STACK_PAGE EQU 1 ;OUTPUT EQU 1990H ;CALL LOCATION TO OUTPUT A CHARACTER CONVERT EQU 58H ;LOCATION TO CONVERT NUMBERS INTGRC BIT 25 ;BIT SET IF INTGER ERROR ; ;*********************************************************************** ; ; The following equates are used internally ; ;*********************************************************************** ; FP_NUMBER_SIZE EQU 6 UNDERFLOW EQU 0 OVERFLOW EQU 1 ZERO EQU 2 ZERO_DIVIDE EQU 3 ; ;*********************************************************************** ; ;************************************************************** ; ; The following internal locations are used by the math pack ; ordering is important and the FP_DIGITS must be bit ; addressable ; ;*************************************************************** ; FP_STATUS EQU 28H ;NOT USED FP_TEMP EQU FP_STATUS+1 ;NOT USED FP_CARRY EQU FP_STATUS+2 ;USED FOR BITS ADD_IN BIT 35 ;DCMPXZ IN BASIC BACKAGE XSIGN BIT FP_CARRY.0 FOUND_RADIX BIT FP_CARRY.1 FIRST_RADIX BIT FP_CARRY.2 DONE_LOAD BIT FP_CARRY.3 FP_DIG12 EQU FP_CARRY+1 FP_DIG34 EQU FP_CARRY+2 FP_DIG56 EQU FP_CARRY+3 FP_DIG78 EQU FP_CARRY+4 FP_SIGN EQU FP_CARRY+5 MSIGN BIT FP_SIGN.0 FP_EXP EQU FP_CARRY+6 FP_NIB1 EQU FP_DIG12 FP_NIB2 EQU FP_NIB1+1 FP_NIB3 EQU FP_NIB1+2 FP_NIB4 EQU FP_NIB1+3 FP_NIB5 EQU FP_NIB1+4 FP_NIB6 EQU FP_NIB1+5 FP_NIB7 EQU FP_NIB1+6 FP_NIB8 EQU FP_NIB1+7 FP_ACCX EQU FP_NIB1+8 FP_ACCC EQU FP_NIB1+9 FP_ACC1 EQU FP_NIB1+10 FP_ACC2 EQU FP_NIB1+11 FP_ACC3 EQU FP_NIB1+12 FP_ACC4 EQU FP_NIB1+13 FP_ACC5 EQU FP_NIB1+14 FP_ACC6 EQU FP_NIB1+15 FP_ACC7 EQU FP_NIB1+16 FP_ACC8 EQU FP_NIB1+17 FP_ACCS EQU FP_NIB1+18 ; ; ORG 1990H ; OUTPUT: T_L: LJMP TEROT ; ; ;************************************************************** ; ; The floating point entry points and jump table ; ;************************************************************** ; FP_BASE: AJMP FLOATING_ADD FP_BASE1: AJMP FLOATING_SUB FP_BASE2: AJMP FLOATING_COMP FP_BASE3: AJMP FLOATING_MUL FP_BASE4: AJMP FLOATING_DIV FP_BASE5: AJMP HEXSCAN FP_BASE6: AJMP FLOATING_POINT_INPUT FP_BASE7: AJMP FLOATING_POINT_OUTPUT FP_BASE8: AJMP CONVERT_BINARY_TO_ASCII_STRING FP_BASE9: AJMP CONVERT_ASCII_STRING_TO_BINARY FP_BASE10: AJMP MULNUM10 FP_BASE11: AJMP HEXOUT FP_BASE12: AJMP PUSHR2R0 ; ; FLOATING_SUB: ; MOV P2,#ARG_STACK_PAGE MOV R0,ARG_STACK DEC R0 ;POINT TO SIGN MOVX A,@R0 ;READ SIGN CPL ACC.0 MOVX @R0,A ; ;AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ; FLOATING_ADD: ; ;AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ; ; ACALL MDES1 ;R7=TOS EXP, R6=TOS-1 EXP, R4=TOS SIGN ;R3=TOS-1 SIGN, OPERATION IS R1 # R0 ; MOV A,R7 ;GET TOS EXPONENT JZ POP_AND_EXIT ;IF TOS=0 THEN POP AND EXIT CJNE R6,#0,LOAD1 ;CLEAR CARRY EXIT IF ZERO ; ;************************************************************** ; SWAP_AND_EXIT: ; Swap external args and return ; ;************************************************************** ; ACALL LOAD_POINTERS MOV R7,#FP_NUMBER_SIZE ; SE1: MOVX A,@R0 ;SWAP THE ARGUMENTS MOVX @R1,A DEC R0 DEC R1 DJNZ R7,SE1 ; POP_AND_EXIT: ; MOV A,ARG_STACK ;POP THE STACK ADD A,#FP_NUMBER_SIZE MOV ARG_STACK,A CLR A RET ; ; LOAD1: SUBB A,R6 ;A = ARG 1 EXP - ARG 2 EXP MOV FP_EXP,R7 ;SAVE EXPONENT AND SIGN MOV FP_SIGN,R4 JNC LOAD2 ;ARG1 EXPONENT IS LARGER OR SAME MOV FP_EXP,R6 MOV FP_SIGN,R3 CPL A INC A ;COMPENSATE FOR EXP DELTA XCH A,R0 ;FORCE R0 TO POINT AT THE LARGEST XCH A,R1 ;EXPONENT XCH A,R0 ; LOAD2: MOV R7,A ;SAVE THE EXPONENT DELTA IN R7 CLR ADD_IN CJNE R5,#0,LOAD21 SETB ADD_IN ; ; Load the R1 mantissa ; LOAD21: ACALL LOADR1_MANTISSA ;LOAD THE SMALLEST NUMBER ; ; Now align the number to the delta exponent ; R4 points to the string of the last digits lost ; CJNE R7,#DIGIT+DIGIT+3,LOAD22 LOAD22: JC LOAD23 MOV R7,#DIGIT+DIGIT+2 ; LOAD23: MOV FP_CARRY,#00 ;CLEAR THE CARRY ACALL RIGHT ;SHIFT THE NUMBER ; ; Set up for addition and subtraction ; MOV R7,#DIGIT ;LOOP COUNT MOV R1,#FP_DIG78 ; ;***************************************************************************** ;****** Elektor 2 Patch ****************************************************** ;****** Floting Point Error, found by D. Mudric and Z. Stojsavljevic ********* ; ; MOV A,#9EH ;****** Error Number 1 ; ;****** Value in R4 must be complemented with 100D (#9AH), it must be the ;****** first complement ; ; CLR C ; SUBB A,R4 ; DA A ; XCH A,R4 ; JNZ LOAD24 ; MOV R4,A ;****** Error Number 2 ; ;****** With substraction, after reducing both the minuend and the ;****** subtrahend to the same exponents, when R4 <> 0, it is obvious ;****** that one always has to make a borrowing from the first higher ;****** position of the minuend, not as it is stated by the original ;****** were it is made only when R4 = 50H ; ;LOAD24: CJNE A,#50H,LOAD25 ;TEST FOR SUBTRACTION ;LOAD25: JNB ADD_IN,SUBLP ;DO SUBTRACTION IF NO ADD_IN ; ;***************************************************************************** ;****** Proper code starts here: ********************************************* ; mov A,#9AH clr C subb A,R4 da A xch A,R4 jnb ADD_IN,SUBLP cjne A,#50H,LOAD25 ; ;****** continue with original code: ***************************************** ; LOAD25: CPL C ;FLIP CARRY FOR ADDITION ACALL ADDLP ;DO ADDITION ; JNC ADD_R INC FP_CARRY MOV R7,#1 ACALL RIGHT ACALL INC_FP_EXP ;SHIFT AND BUMP EXPONENT ; ADD_R: AJMP STORE_ALIGN_TEST_AND_EXIT ; ADDLP: MOVX A,@R0 ADDC A,@R1 DA A MOV @R1,A DEC R0 DEC R1 DJNZ R7,ADDLP ;LOOP UNTIL DONE RET ; SUBLP: MOVX A,@R0 ;NOW DO SUBTRACTION MOV R6,A CLR A ADDC A,#99H SUBB A,@R1 ADD A,R6 DA A MOV @R1,A DEC R0 DEC R1 DJNZ R7,SUBLP JC FSUB6 ; ; Need to complement the result and sign because the floating ; point accumulator mantissa was larger than the external ; memory and their signs were equal. ; CPL FP_SIGN.0 MOV R1,#FP_DIG78 MOV R7,#DIGIT ;LOOP COUNT ; FSUB5: MOV A,#9AH SUBB A,@R1 ADD A,#0 DA A MOV @R1,A DEC R1 CPL C DJNZ R7,FSUB5 ;LOOP ; ; Now see how many zeros their are ; FSUB6: MOV R0,#FP_DIG12 MOV R7,#0 ; FSUB7: MOV A,@R0 JNZ FSUB8 INC R7 INC R7 INC R0 CJNE R0,#FP_SIGN,FSUB7 AJMP ZERO_AND_EXIT ; FSUB8: CJNE A,#10H,FSUB81 FSUB81: JNC FSUB9 INC R7 ; ; Now R7 has the number of leading zeros in the FP ACC ; FSUB9: MOV A,FP_EXP ;GET THE OLD EXPONENT CLR C SUBB A,R7 ;SUBTRACT FROM THE NUMBER OF ZEROS JZ FSUB10 JC FSUB10 ; MOV FP_EXP,A ;SAVE THE NEW EXPONENT ; ACALL LEFT1 ;SHIFT THE FP ACC MOV FP_CARRY,#0 AJMP STORE_ALIGN_TEST_AND_EXIT ; FSUB10: AJMP UNDERFLOW_AND_EXIT ; ;*************************************************************** ; FLOATING_COMP: ; Compare two floating point numbers ; used for relational operations and is faster ; than subtraction. ON RETURN, The carry is set ; if ARG1 is > ARG2, else carry is not set ; if ARG1 = ARG2, F0 gets set ; ;*************************************************************** ; ACALL MDES1 ;SET UP THE REGISTERS MOV A,ARG_STACK ADD A,#FP_NUMBER_SIZE+FP_NUMBER_SIZE MOV ARG_STACK,A ;POP THE STACK TWICE, CLEAR THE CARRY MOV A,R6 ;CHECK OUT EXPONENTS CLR F0 SUBB A,R7 JZ EXPONENTS_EQUAL JC ARG1_EXP_IS_LARGER ; ; Now the ARG2 EXPONENT is > ARG1 EXPONENT ; SIGNS_DIFFERENT: ; MOV A,R3 ;SEE IF SIGN OF ARG2 IS POSITIVE SJMP ARG1_EXP_IS_LARGER1 ; ARG1_EXP_IS_LARGER: ; MOV A,R4 ;GET THE SIGN OF ARG1 EXPONENT ARG1_EXP_IS_LARGER1: JZ ARG1_EXP_IS_LARGER2 CPL C ARG1_EXP_IS_LARGER2: RET ; EXPONENTS_EQUAL: ; ; First, test the sign, then the mantissa ; CJNE R5,#0,SIGNS_DIFFERENT ; BOTH_PLUS: ; MOV R7,#DIGIT ;POINT AT MS DIGIT DEC R0 DEC R0 DEC R0 DEC R1 DEC R1 DEC R1 ; ; Now do the compare ; CLOOP: MOVX A,@R0 MOV R6,A MOVX A,@R1 SUBB A,R6 JNZ ARG1_EXP_IS_LARGER INC R0 INC R1 DJNZ R7,CLOOP ; ; If here, the numbers are the same, the carry is cleared ; SETB F0 RET ;EXIT WITH EQUAL ; ;MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM ; FLOATING_MUL: ; Floating point multiply ; ;MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM ; ACALL MUL_DIV_EXP_AND_SIGN ; ; check for zero exponents ; CJNE R6,#00,FMUL1 ;ARG 2 EXP ZERO? FMUL0: AJMP ZERO_AND_EXIT ; ; calculate the exponent ; FMUL1: MOV FP_SIGN,R5 ;SAVE THE SIGN, IN CASE OF FAILURE ; MOV A,R7 JZ FMUL0 ADD A,R6 ;ADD THE EXPONENTS JB ACC.7,FMUL_OVER JBC CY,FMUL21 ;SEE IF CARRY IS SET ; AJMP UNDERFLOW_AND_EXIT ; FMUL_OVER: ; JNC FMUL2 ;OK IF SET ; FOV: AJMP OVERFLOW_AND_EXIT ;***************************************************************************** ;****** Wulf 1 Bugfix 1 ****************************************************** ;****** Multiplication Error, found by D. Wulf ******************************* ; ; FMUL2: SUBB A,#129 ;SUBTRACT THE EXPONENT BIAS ; ;***************************************************************************** ;****** Proper code starts here: ********************************************* ; FMUL2: setb mul_underflow ;Flag of multiplication limit case FMUL21: subb A,#83H ;exp. multipl. results are within the limits inc A ;Correct SUBB 83H inc A ;to original SUBB 81H jc NMARK_L ;Limit case clr mul_underflow ;No limit case NMARK_L: ; ;****** continue with original code: ***************************************** ; MOV R6,A ;SAVE IT FOR LATER ; ; Unpack and load R0 ; ACALL UNPACK_R0 ; ; Now set up for loop multiply ; MOV R3,#DIGIT MOV R4,R1B0 ; ; Now, do the multiply and accumulate the product ; FMUL3: MOV R1B0,R4 MOVX A,@R1 MOV R2,A ACALL MUL_NIBBLE ; MOV A,R2 SWAP A ACALL MUL_NIBBLE DEC R4 DJNZ R3,FMUL3 ; ; Now, pack and restore the sign ; MOV FP_EXP,R6 MOV FP_SIGN,R5 AJMP PACK ;FINISH IT OFF ; ;DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD ; FLOATING_DIV: ; ;DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD ; ACALL MDES1 ; ; Check the exponents ; MOV FP_SIGN,R5 ;SAVE THE SIGN CJNE R7,#0,DIV0 ;CLEARS THE CARRY ACALL OVERFLOW_AND_EXIT CLR A SETB ACC.ZERO_DIVIDE RET ; DIV0: MOV A,R6 ;GET EXPONENT JZ FMUL0 ;EXIT IF ZERO SUBB A,R7 ;DELTA EXPONENT JB ACC.7,D_UNDER JNC DIV3 AJMP UNDERFLOW_AND_EXIT ; D_UNDER:JNC FOV ; DIV3: ADD A,#129 ;CORRECTLY BIAS THE EXPONENT MOV FP_EXP,A ;SAVE THE EXPONENT ACALL LOADR1_MANTISSA ;LOAD THE DIVIDED ; MOV R2,#FP_ACCC ;SAVE LOCATION MOV R3,R0B0 ;SAVE POINTER IN R3 MOV FP_CARRY,#0 ;ZERO CARRY BYTE ; DIV4: MOV R5,#0FFH ;LOOP COUNT SETB C ; DIV5: MOV R0B0,R3 ;RESTORE THE EXTERNAL POINTER MOV R1,#FP_DIG78 ;SET UP INTERNAL POINTER MOV R7,#DIGIT ;LOOP COUNT JNC DIV7 ;EXIT IF NO CARRY ; DIV6: MOVX A,@R0 ;DO ACCUMLATION MOV R6,A CLR A ADDC A,#99H SUBB A,R6 ADD A,@R1 DA A MOV @R1,A DEC R0 DEC R1 DJNZ R7,DIV6 ;LOOP ; INC R5 ;SUBTRACT COUNTER JC DIV5 ;KEEP LOOPING IF CARRY MOV A,@R1 ;GET CARRY SUBB A,#1 ;CARRY IS CLEARED MOV @R1,A ;SAVE CARRY DIGIT CPL C SJMP DIV5 ;LOOP ; ; Restore the result if carry was found ; DIV7: ACALL ADDLP ;ADD NUMBER BACK MOV @R1,#0 ;CLEAR CARRY MOV R0B0,R2 ;GET SAVE COUNTER MOV @R0,5 ;SAVE COUNT BYTE ; INC R2 ;ADJUST SAVE COUNTER MOV R7,#1 ;BUMP DIVIDEND ACALL LEFT CJNE R2,#FP_ACC8+2,DIV4 ; DJNZ FP_EXP,DIV8 AJMP UNDERFLOW_AND_EXIT ; DIV8: MOV FP_CARRY,#0 ; ;*************************************************************** ; PACK: ; Pack the mantissa ; ;*************************************************************** ; ; First, set up the pointers ; MOV R0,#FP_ACCC MOV A,@R0 ;GET FP_ACCC MOV R6,A ;SAVE FOR ZERO COUNT JZ PACK0 ;JUMP OVER IF ZERO ACALL INC_FP_EXP ;BUMP THE EXPONENT DEC R0 ; PACK0: INC R0 ;POINT AT FP_ACC1 ; PACK1: MOV A,#8 ;ADJUST NIBBLE POINTER MOV R1,A ADD A,R0 MOV R0,A CJNE @R0,#5,PACK11 ;SEE IF ADJUSTING NEEDED PACK11: JC PACK31 ; PACK2: SETB C CLR A DEC R0 ADDC A,@R0 DA A XCHD A,@R0 ;SAVE THE VALUE JNB ACC.4,PACK3 DJNZ R1,PACK2 ; DEC R0 MOV @R0,#1 ACALL INC_FP_EXP SJMP PACK4 ; PACK3: DEC R1 PACK31: MOV A,R1 CLR C XCH A,R0 SUBB A,R0 MOV R0,A ; ;***************************************************************************** ;****** Wulf 1 Bugfix 2 ****************************************************** ;****** Multiplication Error, found by D. Wulf ******************************* ; jnb mul_underflow,PACK4 clr mul_underflow mov A,FP_EXP ;test of exceeding in limit case jz UNDER_MD ;message about underflow cpl a ;test of exceeding in limit case jz UNDER_MD ;message about underflow cpl a ;restore original exp cjne a,#1,pack4 ;jump if not outer limit UNDER_MD: ajmp UNDERFLOW_AND_EXIT ; ;****** continue with original code: ***************************************** ; PACK4: MOV R1,#FP_DIG12 ; ; Now, pack ; PLOOP: MOV A,@R0 SWAP A ;FLIP THE DIGITS INC R0 XCHD A,@R0 ORL 6,A ;ACCUMULATE THE OR'ED DIGITS MOV @R1,A INC R0 INC R1 CJNE R1,#FP_SIGN,PLOOP MOV A,R6 JNZ STORE_ALIGN_TEST_AND_EXIT MOV FP_EXP,#0 ;ZERO EXPONENT ; ;************************************************************** ; STORE_ALIGN_TEST_AND_EXIT: ;Save the number align carry and exit ; ;************************************************************** ; ACALL LOAD_POINTERS MOV ARG_STACK,R1 ;SET UP THE NEW STACK MOV R0,#FP_EXP ; ; Now load the numbers ; STORE2: MOV A,@R0 MOVX @R1,A ;SAVE THE NUMBER DEC R0 DEC R1 CJNE R0,#FP_CARRY,STORE2 ; CLR A ;NO ERRORS ; PRET: RET ;EXIT ; INC_FP_EXP: ; INC FP_EXP MOV A,FP_EXP JNZ PRET ;EXIT IF NOT ZERO POP ACC ;WASTE THE CALLING STACK POP ACC AJMP OVERFLOW_AND_EXIT ; ;*********************************************************************** ; UNPACK_R0: ; Unpack BCD digits and load into nibble locations ; ;*********************************************************************** ; PUSH R1B0 MOV R1,#FP_NIB8 ; ULOOP: MOVX A,@R0 ANL A,#0FH MOV @R1,A ;SAVE THE NIBBLE MOVX A,@R0 SWAP A ANL A,#0FH DEC R1 MOV @R1,A ;SAVE THE NIBBLE AGAIN DEC R0 DEC R1 CJNE R1,#FP_NIB1-1,ULOOP ; POP R1B0 ; LOAD7: RET ; ;************************************************************** ; OVERFLOW_AND_EXIT: ;LOAD 99999999 E+127, SET OV BIT, AND EXIT ; ;************************************************************** ; MOV R0,#FP_DIG78 MOV A,#99H ; OVE1: MOV @R0,A DEC R0 CJNE R0,#FP_CARRY,OVE1 ; MOV FP_EXP,#0FFH ACALL STORE_ALIGN_TEST_AND_EXIT ; SETB ACC.OVERFLOW RET ; ;************************************************************** ; UNDERFLOW_AND_EXIT: ;LOAD 0, SET UF BIT, AND EXIT ; ;************************************************************** ; ACALL ZERO_AND_EXIT CLR A SETB ACC.UNDERFLOW RET ; ;************************************************************** ; ZERO_AND_EXIT: ;LOAD 0, SET ZERO BIT, AND EXIT ; ;************************************************************** ; ACALL FP_CLEAR ACALL STORE_ALIGN_TEST_AND_EXIT SETB ACC.ZERO RET ;EXIT ; ;************************************************************** ; FP_CLEAR: ; ; Clear internal storage ; ;************************************************************** ; CLR A MOV R0,#FP_ACC8+1 ; FPC1: MOV @R0,A DEC R0 CJNE R0,#FP_TEMP,FPC1 RET ; ;************************************************************** ; RIGHT: ; Shift ACCUMULATOR RIGHT the number of nibbles in R7 ; Save the shifted values in R4 if SAVE_ROUND is set ; ;************************************************************** ; MOV R4,#0 ;IN CASE OF NO SHIFT ; RIGHT1: CLR C RIGHT2: MOV A,R7 ;GET THE DIGITS TO SHIFT JZ RIGHTL1 ;EXIT IF ZERO SUBB A,#2 ;TWO TO DO? JNC RIGHT5 ;SHIFT TWO NIBBLES ; ; Swap one nibble then exit ; RIGHT3: PUSH R0B0 ;SAVE POINTER REGISTER PUSH R1B0 ; MOV R1,#FP_DIG78 ;LOAD THE POINTERS MOV R0,#FP_DIG56 MOV A,R4 ;GET THE OVERFLOW REGISTER XCHD A,@R1 ;GET DIGIT 8 SWAP A ;FLIP FOR LOAD MOV R4,A ; RIGHTL: MOV A,@R1 ;GET THE LOW ORDER BYTE XCHD A,@R0 ;SWAP NIBBLES SWAP A ;FLIP FOR STORE MOV @R1,A ;SAVE THE DIGITS DEC R0 ;BUMP THE POINTERS DEC R1 CJNE R1,#FP_DIG12-1,RIGHTL ;LOOP ; MOV A,@R1 ;ACC = CH8 SWAP A ;ACC = 8CH ANL A,#0FH ;ACC = 0CH MOV @R1,A ;CARRY DONE POP R1B0 ;EXIT POP R0B0 ;RESTORE REGISTER RIGHTL1:RET ; RIGHT5: MOV R7,A ;SAVE THE NEW SHIFT NUMBER CLR A XCH A,FP_CARRY ;SWAP THE NIBBLES XCH A,FP_DIG12 XCH A,FP_DIG34 XCH A,FP_DIG56 XCH A,FP_DIG78 MOV R4,A ;SAVE THE LAST DIGIT SHIFTED SJMP RIGHT2 ; ;*************************************************************** ; LEFT: ; Shift ACCUMULATOR LEFT the number of nibbles in R7 ; ;*************************************************************** ; MOV R4,#00H ;CLEAR FOR SOME ENTRYS ; LEFT1: CLR C LEFT2: MOV A,R7 ;GET SHIFT VALUE JZ LEFTL1 ;EXIT IF ZERO SUBB A,#2 ;SEE HOW MANY BYTES TO SHIFT JNC LEFT5 ; LEFT3: PUSH R0B0 ;SAVE POINTER PUSH R1B0 MOV R0,#FP_CARRY MOV R1,#FP_DIG12 ; MOV A,@R0 ;ACC=CHCL SWAP A ;ACC = CLCH MOV @R0,A ;ACC = CLCH, @R0 = CLCH ; LEFTL: MOV A,@R1 ;DIG 12 SWAP A ;DIG 21 XCHD A,@R0 MOV @R1,A ;SAVE IT INC R0 ;BUMP POINTERS INC R1 CJNE R0,#FP_DIG78,LEFTL ; MOV A,R4 SWAP A XCHD A,@R0 ANL A,#0F0H MOV R4,A ; POP R1B0 POP R0B0 ;RESTORE LEFTL1: RET ;DONE ; LEFT5: MOV R7,A ;RESTORE COUNT CLR A XCH A,R4 ;GET THE RESTORATION BYTE XCH A,FP_DIG78 ;DO THE SWAP XCH A,FP_DIG56 XCH A,FP_DIG34 XCH A,FP_DIG12 XCH A,FP_CARRY SJMP LEFT2 ; MUL_NIBBLE: ; ; Multiply the nibble in R7 by the FP_NIB locations ; accumulate the product in FP_ACC ; ; Set up the pointers for multiplication ; ANL A,#0FH ;STRIP OFF MS NIBBLE MOV R7,A MOV R0,#FP_ACC8 MOV R1,#FP_NIB8 CLR A MOV FP_ACCX,A ; MNLOOP: DEC R0 ;BUMP POINTER TO PROPAGATE CARRY ADD A,@R0 ;ATTEMPT TO FORCE CARRY DA A ;BCD ADJUST JNB ACC.4,MNL0 ;DON'T ADJUST IF NO NEED DEC R0 ;PROPAGATE CARRY TO THE NEXT DIGIT INC @R0 ;DO THE ADJUSTING INC R0 ;RESTORE R0 ; MNL0: XCHD A,@R0 ;RESTORE INITIAL NUMBER MOV B,R7 ;GET THE NUBBLE TO MULTIPLY MOV A,@R1 ;GET THE OTHER NIBBLE MUL AB ;DO THE MULTIPLY MOV B,#10 ;NOW BCD ADJUST DIV AB XCH A,B ;GET THE REMAINDER ADD A,@R0 ;PROPAGATE THE PARTIAL PRODUCTS DA A ;BCD ADJUST JNB ACC.4,MNL1 ;PROPAGATE PARTIAL PRODUCT CARRY INC B ; MNL1: INC R0 XCHD A,@R0 ;SAVE THE NEW PRODUCT DEC R0 MOV A,B ;GET BACK THE QUOTIENT DEC R1 CJNE R1,#FP_NIB1-1,MNLOOP ; ADD A,FP_ACCX ;GET THE OVERFLOW DA A ;ADJUST MOV @R0,A ;SAVE IT RET ;EXIT ; ;*************************************************************** ; LOAD_POINTERS: ; Load the ARG_STACK into R0 and bump R1 ; ;*************************************************************** ; MOV P2,#ARG_STACK_PAGE MOV R0,ARG_STACK MOV A,#FP_NUMBER_SIZE ADD A,R0 MOV R1,A RET ; ;*************************************************************** ; MUL_DIV_EXP_AND_SIGN: ; ; Load the sign into R7, R6. R5 gets the sign for ; multiply and divide. ; ;*************************************************************** ; ACALL FP_CLEAR ;CLEAR INTERNAL MEMORY ; MDES1: ACALL LOAD_POINTERS ;LOAD REGISTERS MOVX A,@R0 ;ARG 1 EXP MOV R7,A ;SAVED IN R7 MOVX A,@R1 ;ARG 2 EXP MOV R6,A ;SAVED IN R6 DEC R0 ;BUMP POINTERS TO SIGN DEC R1 MOVX A,@R0 ;GET THE SIGN MOV R4,A ;SIGN OF ARG1 MOVX A,@R1 ;GET SIGN OF NEXT ARG MOV R3,A ;SIGN OF ARG2 XRL A,R4 ;ACC GETS THE NEW SIGN MOV R5,A ;R5 GETS THE NEW SIGN ; ; Bump the pointers to point at the LS digit ; DEC R0 DEC R1 ; RET ; ;*************************************************************** ; LOADR1_MANTISSA: ; ; Load the mantissa of R0 into FP_Digits ; ;*************************************************************** ; PUSH R0B0 ;SAVE REGISTER 1 MOV R0,#FP_DIG78 ;SET UP THE POINTER ; LOADR1: MOVX A,@R1 MOV @R0,A DEC R1 DEC R0 CJNE R0,#FP_CARRY,LOADR1 ; POP R0B0 RET ; ;*************************************************************** ; HEXSCAN: ; Scan a string to determine if it is a hex number ; set carry if hex, else carry = 0 ; ;*************************************************************** ; ACALL GET_DPTR_CHARACTER PUSH DPH PUSH DPL ;SAVE THE POINTER ; HEXSC1: MOVX A,@DPTR ;GET THE CHARACTER ACALL DIGIT_CHECK ;SEE IF A DIGIT JC HS1 ;CONTINUE IF A DIGIT ACALL HEX_CHECK ;SEE IF HEX JC HS1 ; CLR ACC.5 ;NO LOWER CASE CJNE A,#'H',HEXDON SETB C SJMP HEXDO1 ;NUMBER IS VALID HEX, MAYBE ; HEXDON: CLR C ; HEXDO1: POP DPL ;RESTORE POINTER POP DPH RET ; HS1: INC DPTR ;BUMP TO NEXT CHARACTER SJMP HEXSC1 ;LOOP ; HEX_CHECK: ;CHECK FOR A VALID ASCII HEX, SET CARRY IF FOUND ; CLR ACC.5 ;WASTE LOWER CASE CJNE A,#'F'+1,HEX_CHECK1 ;SEE IF F OR LESS HEX_CHECK1: JC HC1 RET ; HC1: CJNE A,#'A',HC11 ;SEE IF A OR GREATER HC11: CPL C RET ; PUSHR2R0: ; MOV R3,#HIGH CONVERT;CONVERSION LOCATION MOV R1,#LOW CONVERT ACALL CONVERT_BINARY_TO_ASCII_STRING MOV A,#0DH ;A CR TO TERMINATE MOVX @R1,A ;SAVE THE CR MOV DPTR,#CONVERT ; ; Falls thru to FLOATING INPUT ; ;*************************************************************** ; FLOATING_POINT_INPUT: ; Input a floating point number pointed to by ; the DPTR ; ;*************************************************************** ; ACALL FP_CLEAR ;CLEAR EVERYTHING ACALL GET_DPTR_CHARACTER ACALL PLUS_MINUS_TEST MOV MSIGN,C ;SAVE THE MANTISSA SIGN ; ; Now, set up for input loop ; MOV R0,#FP_ACCC MOV R6,#7FH ;BASE EXPONENT SETB F0 ;SET INITIAL FLAG ; INLOOP: ACALL GET_DIGIT_CHECK JNC GTEST ;IF NOT A CHARACTER, WHAT IS IT? ANL A,#0FH ;STRIP ASCII ACALL STDIG ;STORE THE DIGITS ; INLPIK: INC DPTR ;BUMP POINTER FOR LOOP SJMP INLOOP ;LOOP FOR INPUT ; GTEST: CJNE A,#'.',GT1 ;SEE IF A RADIX JB FOUND_RADIX,INERR SETB FOUND_RADIX CJNE R0,#FP_ACCC,INLPIK SETB FIRST_RADIX ;SET IF FIRST RADIX SJMP INLPIK ;GET ADDITIONAL DIGITS ; GT1: JB F0,INERR ;ERROR IF NOT CLEARED CJNE A,#'e',GT11 ;CHECK FOR LOWER CASE SJMP GT12 GT11: CJNE A,#'E',FINISH_UP GT12: ACALL INC_AND_GET_DPTR_CHARACTER ACALL PLUS_MINUS_TEST MOV XSIGN,C ;SAVE SIGN STATUS ACALL GET_DIGIT_CHECK JNC INERR ; ANL A,#0FH ;STRIP ASCII BIAS OFF THE CHARACTER MOV R5,A ;SAVE THE CHARACTER IN R5 ; GT2: INC DPTR ACALL GET_DIGIT_CHECK JNC FINISH1 ANL A,#0FH ;STRIP OFF BIAS XCH A,R5 ;GET THE LAST DIGIT MOV B,#10 ;MULTIPLY BY TEN MUL AB ADD A,R5 ;ADD TO ORIGINAL VALUE MOV R5,A ;SAVE IN R5 JNC GT2 ;LOOP IF NO CARRY MOV R5,#0FFH ;FORCE AN ERROR ; FINISH1:MOV A,R5 ;GET THE SIGN JNB XSIGN,POSNUM ;SEE IF EXPONENT IS POS OR NEG CLR C SUBB A,R6 CPL A INC A JC FINISH2 MOV A,#01H RET ; POSNUM: ADD A,R6 ;ADD TO EXPONENT JNC FINISH2 ; POSNM1: MOV A,#02H RET ; FINISH2:XCH A,R6 ;SAVE THE EXPONENT ; FINISH_UP: ; MOV FP_EXP,R6 ;SAVE EXPONENT CJNE R0,#FP_ACCC,FINISH_UP1 ACALL FP_CLEAR ;CLEAR THE MEMORY IF 0 FINISH_UP1: MOV A,ARG_STACK ;GET THE ARG STACK CLR C SUBB A,#FP_NUMBER_SIZE+FP_NUMBER_SIZE MOV ARG_STACK,A ;ADJUST FOR STORE AJMP PACK ; STDIG: CLR F0 ;CLEAR INITIAL DESIGNATOR JNZ STDIG1 ;CONTINUE IF NOT ZERO CJNE R0,#FP_ACCC,STDIG1 JNB FIRST_RADIX,RET_X ; DECX: DJNZ R6,RET_X ; INERR: MOV A,#0FFH ; RET_X: RET ; STDIG1: JB DONE_LOAD,FRTEST CLR FIRST_RADIX ; FRTEST: JB FIRST_RADIX,DECX ; FDTEST: JB FOUND_RADIX,FDT1 INC R6 ; FDT1: JB DONE_LOAD,RET_X CJNE R0,#FP_ACC8+1,FDT2 SETB DONE_LOAD ; FDT2: MOV @R0,A ;SAVE THE STRIPPED ACCUMULATOR INC R0 ;BUMP THE POINTER RET ;EXIT ; ;*************************************************************** ; ; I/O utilities ; ;*************************************************************** ; INC_AND_GET_DPTR_CHARACTER: ; INC DPTR ; GET_DPTR_CHARACTER: ; MOVX A,@DPTR ;GET THE CHARACTER CJNE A,#' ',PMT1 ;SEE IF A SPACE ; ; Kill spaces ; SJMP INC_AND_GET_DPTR_CHARACTER ; PLUS_MINUS_TEST: ; CJNE A,#0E3H,PMT11 ;SEE IF A PLUS, PLUS TOKEN FROM BASIC SJMP PMT3 PMT11: CJNE A,#'+',PMT12 SJMP PMT3 PMT12: CJNE A,#0E5H,PMT13 ;SEE IF MINUS, MINUS TOKEN FROM BASIC SJMP PMT2 PMT13: CJNE A,#'-',PMT1 ; PMT2: SETB C ; PMT3: INC DPTR ; PMT1: RET ; ;*************************************************************** ; FLOATING_POINT_OUTPUT: ; Output the number, format is in location 23 ; ; IF FORMAT = 00 - FREE FLOATING ; = FX - EXPONENTIAL (X IS THE NUMBER OF SIG DIGITS) ; = NX - N = NUM BEFORE RADIX, X = NUM AFTER RADIX ; N + X = 8 MAX ; ;*************************************************************** ; ACALL MDES1 ;GET THE NUMBER TO OUTPUT, R0 IS POINTER ACALL POP_AND_EXIT ;OUTPUT POPS THE STACK MOV A,R7 MOV R6,A ;PUT THE EXPONENT IN R6 ACALL UNPACK_R0 ;UNPACK THE NUMBER MOV R0,#FP_NIB1 ;POINT AT THE NUMBER MOV A,FORMAT ;GET THE FORMAT MOV R3,A ;SAVE IN CASE OF EXP FORMAT JZ FREE ;FREE FLOATING? CJNE A,#0F0H,FPO1 ;SEE IF EXPONENTIAL FPO1: JNC EXPOUT ; ; If here, must be integer USING format ; MOV A,R6 ;GET THE EXPONENT JNZ FPO2 MOV R6,#80H FPO2: MOV A,R3 ;GET THE FORMAT SWAP A ;SPLIT INTEGER AND FRACTION ANL A,#0FH MOV R2,A ;SAVE INTEGER ACALL NUM_LT ;GET THE NUMBER OF INTEGERS XCH A,R2 ;FLIP FOR SUBB CLR C SUBB A,R2 MOV R7,A JNC FPO3 MOV R5,#'?' ;OUTPUT A QUESTION MARK ACALL SOUT1 ;NUMBER IS TOO LARGE FOR FORMAT AJMP FREE FPO3: CJNE R2,#00,USING0 ;SEE IF ZERO DEC R7 ACALL SS7 ACALL ZOUT ;OUTPUT A ZERO SJMP USING1 ; USING0: ACALL SS7 ;OUTPUT SPACES, IF NEED TO MOV A,R2 ;OUTPUT DIGITS MOV R7,A ACALL OUTR0 ; USING1: MOV A,R3 ANL A,#0FH ;GET THE NUMBER RIGHT OF DP MOV R2,A ;SAVE IT JZ PMT1 ;EXIT IF ZERO ACALL ROUT ;OUTPUT DP ACALL NUM_RT CJNE A,2,USINGX ;COMPARE A TO R2 ; USINGY: MOV A,R2 AJMP Z7R7 ; USINGX: JNC USINGY ; USING2: XCH A,R2 CLR C SUBB A,R2 XCH A,R2 ACALL Z7R7 ;OUTPUT ZEROS IF NEED TO MOV A,R2 MOV R7,A AJMP OUTR0 ; ; First, force exponential output, if need to ; FREE: MOV A,R6 ;GET THE EXPONENT JNZ FREE1 ;IF ZERO, PRINT IT ACALL SOUT AJMP ZOUT ; FREE1: MOV R3,#0F0H ;IN CASE EXP NEEDED MOV A,#80H-DIGIT-DIGIT-1 ADD A,R6 JC EXPOUT SUBB A,#0F7H JC EXPOUT ; ; Now, just print the number ; ACALL SINOUT ;PRINT THE SIGN OF THE NUMBER ACALL NUM_LT ;GET THE NUMBER LEFT OF DP CJNE A,#8,FREE4 AJMP OUTR0 ; FREE4: ACALL OUTR0 ACALL ZTEST ;TEST FOR TRAILING ZEROS JZ U_RET ;DONE IF ALL TRAILING ZEROS ACALL ROUT ;OUTPUT RADIX ; FREE2: MOV R7,#1 ;OUTPUT ONE DIGIT ACALL OUTR0 JNZ U_RET ACALL ZTEST JZ U_RET SJMP FREE2 ;LOOP ; EXPOUT: ACALL SINOUT ;PRINT THE SIGN MOV R7,#1 ;OUTPUT ONE CHARACTER ACALL OUTR0 ACALL ROUT ;OUTPUT RADIX MOV A,R3 ;GET FORMAT ANL A,#0FH ;STRIP INDICATOR JZ EXPOTX ; MOV R7,A ;OUTPUT THE NUMBER OF DIGITS DEC R7 ;ADJUST BECAUSE ONE CHAR ALREADY OUT ACALL OUTR0 SJMP EXPOT4 ; EXPOTX: ACALL FREE2 ;OUTPUT UNTIL TRAILING ZEROS ; EXPOT4: ACALL SOUT ;OUTPUT A SPACE MOV R5,#'E' ACALL SOUT1 ;OUTPUT AN E MOV A,R6 ;GET THE EXPONENT JZ XOUT0 ;EXIT IF ZERO DEC A ;ADJUST FOR THE DIGIT ALREADY OUTPUT CJNE A,#80H,XOUT2 ;SEE WHAT IT IS ; XOUT0: ACALL SOUT CLR A SJMP XOUT4 ; XOUT2: JC XOUT3 ;NEGATIVE EXPONENT MOV R5,#'+' ;OUTPUT A PLUS SIGN ACALL SOUT1 SJMP XOUT4 ; XOUT3: ACALL MOUT CPL A ;FLIP BITS INC A ;BUMP ; XOUT4: CLR ACC.7 MOV R0,A MOV R2,#0 MOV R1,#LOW CONVERT ;CONVERSION LOCATION MOV R3,#HIGH CONVERT ACALL CONVERT_BINARY_TO_ASCII_STRING MOV R0,#LOW CONVERT ;NOW, OUTPUT EXPONENT ; EXPOT5: MOVX A,@R0 ;GET THE CHARACTER MOV R5,A ;OUTPUT IT ACALL SOUT1 INC R0 ;BUMP THE POINTER MOV A,R0 ;GET THE POINTER CJNE A,R1B0,EXPOT5 ;LOOP ; U_RET: RET ;EXIT ; OUTR0: ; Output the characters pointed to by R0, also bias ascii ; MOV A,R7 ;GET THE COUNTER JZ OUTR ;EXIT IF DONE MOV A,@R0 ;GET THE NUMBER ORL A,#30H ;ASCII BIAS INC R0 ;BUMP POINTER AND COUNTER DEC R7 MOV R5,A ;PUT CHARACTER IN OUTPUT REGISTER ACALL SOUT1 ;OUTPUT THE CHARACTER CLR A ;JUST FOR TEST CJNE R0,#FP_NIB8+1,OUTR0 MOV A,#55H ;KNOW WHERE EXIT OCCURED ; OUTR: RET ; ZTEST: MOV R1,R0B0 ;GET POINTER REGISTER ; ZT0: MOV A,@R1 ;GET THE VALUE JNZ ZT1 INC R1 ;BUMP POINTER CJNE R1,#FP_NIB8+1,ZT0 ; ZT1: RET ; NUM_LT: MOV A,R6 ;GET EXPONENT CLR C ;GET READY FOR SUBB SUBB A,#80H ;SUB EXPONENT BIAS JNC NL1 ;OK IF NO CARRY CLR A ;NO DIGITS LEFT ; NL1: MOV R7,A ;SAVE THE COUNT RET ; NUM_RT: CLR C ;SUBB AGAIN MOV A,#80H ;EXPONENT BIAS SUBB A,R6 ;GET THE BIASED EXPONENT JNC NR1 CLR A ; NR1: RET ;EXIT ; SPACE7: MOV A,R7 ;GET THE NUMBER OF SPACES JZ NR1 ;EXIT IF ZERO ACALL SOUT ;OUTPUT A SPACE DEC R7 ;BUMP COUNTER SJMP SPACE7 ;LOOP ; Z7R7: MOV R7,A ; ZERO7: MOV A,R7 ;GET COUNTER JZ NR1 ;EXIT IF ZERO ACALL ZOUT ;OUTPUT A ZERO DEC R7 ;BUMP COUNTER SJMP ZERO7 ;LOOP ; SS7: ACALL SPACE7 ; SINOUT: MOV A,R4 ;GET THE SIGN JZ SOUT ;OUTPUT A SPACE IF ZERO ; MOUT: MOV R5,#'-' SJMP SOUT1 ;OUTPUT A MINUS IF NOT ; ROUT: MOV R5,#'.' ;OUTPUT A RADIX SJMP SOUT1 ; ZOUT: MOV R5,#'0' ;OUTPUT A ZERO SJMP SOUT1 ; SOUT: MOV R5,#' ' ;OUTPUT A SPACE ; SOUT1: AJMP OUTPUT ; ;*************************************************************** ; CONVERT_ASCII_STRING_TO_BINARY: ; ;DPTR POINTS TO ASCII STRING ;PUT THE BINARY NUMBER IN R2:R0, ERROR IF >64K ; ;*************************************************************** ; CASB: ACALL HEXSCAN ;SEE IF HEX NUMBER MOV ADD_IN,C ;IF ADD_IN IS SET, THE NUMBER IS HEX ACALL GET_DIGIT_CHECK CPL C ;FLIP FOR EXIT JC RCASB MOV R3,#00H ;ZERO R3:R1 FOR LOOP MOV R1,#00H SJMP CASB5 ; CASB2: INC DPTR MOV R0B0,R1 ;SAVE THE PRESENT CONVERTED VALUE MOV R2B0,R3 ;IN R2:R0 ACALL GET_DIGIT_CHECK JC CASB5 JNB ADD_IN,RCASB ;CONVERSION COMPLETE ACALL HEX_CHECK ;SEE IF HEX NUMBER JC CASB4 ;PROCEED IF GOOD INC DPTR ;BUMP PAST H SJMP RCASB ; CASB4: ADD A,#9 ;ADJUST HEX ASCII BIAS ; CASB5: MOV B,#10 JNB ADD_IN,CASB6 MOV B,#16 ;HEX MODE ; CASB6: ACALL MULNUM ;ACCUMULATE THE DIGITS JNC CASB2 ;LOOP IF NO CARRY ; RCASB: CLR A ;RESET ACC MOV ACC.OVERFLOW,C ;IF OVERFLOW, SAY SO RET ;EXIT ; MULNUM10:MOV B,#10 ; ;*************************************************************** ; MULNUM: ; Take the next digit in the acc (masked to 0FH) ; accumulate in R3:R1 ; ;*************************************************************** ; PUSH ACC ;SAVE ACC PUSH B ;SAVE MULTIPLIER MOV A,R1 ;PUT LOW ORDER BITS IN ACC MUL AB ;DO THE MULTIPLY MOV R1,A ;PUT THE RESULT BACK MOV A,R3 ;GET THE HIGH ORDER BYTE MOV R3,B ;SAVE THE OVERFLOW POP B ;GET THE MULTIPLIER MUL AB ;DO IT MOV C,OV ;SAVE OVERFLOW IN F0 MOV F0,C ADD A,R3 ;ADD OVERFLOW TO HIGH RESULT MOV R3,A ;PUT IT BACK POP ACC ;GET THE ORIGINAL ACC BACK ORL C,F0 ;OR CARRY AND OVERFLOW JC MULX ;NO GOOD IF THE CARRY IS SET ; MUL11: ANL A,#0FH ;MASK OFF HIGH ORDER BITS ADD A,R1 ;NOW ADD THE ACC MOV R1,A ;PUT IT BACK CLR A ;PROPAGATE THE CARRY ADDC A,R3 MOV R3,A ;PUT IT BACK ; MULX: RET ;EXIT WITH OR WITHOUT CARRY ; CONVERT_BINARY_TO_ASCII_STRING: ; ;***************************************************************************** ;****** Elektor 3 Patch ****************************************************** ;****** Performance improvements ********************************************* ; ; ;R3:R1 contains the address of the string ;R2:R0 contains the value to convert ;DPTR, R7, R6, and ACC gets clobbered ; ;*************************************************************** ; ; CLR A ;NO LEADING ZEROS ; MOV DPTR,#10000 ;SUBTRACT 10000 ; ACALL RSUB ;DO THE SUBTRACTION ; MOV DPTR,#1000 ;NOW 1000 ; ACALL RSUB ; MOV DPTR,#100 ;NOW 100 ; ACALL RSUB ; MOV DPTR,#10 ;NOW 10 ; ACALL RSUB ; MOV DPTR,#1 ;NOW 1 ; ACALL RSUB ; JZ RSUB2 ;JUMP OVER RET ; ;RSUB_R: RET ; ;RSUB: MOV R6,#-1 ;SET UP THE COUNTER ; ;RSUB1: INC R6 ;BUMP THE COUNTER ; XCH A,R2 ;DO A FAST COMPARE ; CJNE A,DPH,RSUB11 ;RSUB11: XCH A,R2 ; JC FAST_DONE ; XCH A,R0 ;GET LOW BYTE ; SUBB A,DPL ;SUBTRACT, CARRY IS CLEARED ; XCH A,R0 ;PUT IT BACK ; XCH A,R2 ;GET THE HIGH BYTE ; SUBB A,DPH ;ADD THE HIGH BYTE ; XCH A,R2 ;PUT IT BACK ; JNC RSUB1 ;LOOP UNTIL CARRY ; ; XCH A,R0 ; ADD A,DPL ;RESTORE R2:R0 ; XCH A,R0 ; XCH A,R2 ; ADDC A,DPH ; XCH A,R2 ; ;FAST_DONE: ; ; ORL A,R6 ;OR THE COUNT VALUE ; JZ RSUB_R ;RETURN IF ZERO ; ;RSUB2: MOV A,#'0' ;GET THE ASCII BIAS ; ADD A,R6 ;ADD THE COUNT ; ;RSUB4: MOV P2,R3 ;SET UP P2 ; MOVX @R1,A ;PLACE THE VALUE IN MEMORY ; INC R1 ; CJNE R1,#00H,RSUB3 ;SEE IF RAPPED AROUND ; INC R3 ;BUMP HIGH BYTE ; ;RSUB3: RET ;EXIT ; ;****** Faster code starts here: ********************************************* ; mov R5,#0 ; RSUB1: mov A, R2 mov B,#0AH div AB mov R2,A mov A,R0 anl A,#0F0H orl A,B swap A mov B,#0AH div AB swap A mov R6,A mov A,R0 anl A,#0FH swap A orl A,B swap A mov B,#0AH div AB orl A,R6 mov R0,A mov A,B add A,#30H inc R5 push ACC mov A,R2 orl A,R0 jnz RSUB1 ; RSUB2: pop ACC mov P2,R3 movx @R1,A inc R1 cjne R1,#0,RSUB3 inc R3 ; RSUB3: djnz R5,RSUB2 ret ; ;****** continue with original code: ***************************************** ; ;*************************************************************** ; HEXOUT: ; Output the hex number in R3:R1, supress leading zeros, if set ; ;*************************************************************** ; ACALL SOUT ;OUTPUT A SPACE MOV C,ZSURP ;GET ZERO SUPPRESSION BIT MOV ADD_IN,C MOV A,R3 ;GET HIGH NIBBLE AND PRINT IT ACALL HOUTHI MOV A,R3 ACALL HOUTLO ; HEX2X: CLR ADD_IN ;DON'T SUPPRESS ZEROS MOV A,R1 ;GET LOW NIBBLE AND PRINT IT ACALL HOUTHI MOV A,R1 ACALL HOUTLO MOV R5,#'H' ;OUTPUT H TO INDICATE HEX MODE ; SOUT_1: AJMP SOUT1 ; HOUT1: CLR ADD_IN ;PRINTED SOMETHING, SO CLEAR ADD_IN ADD A,#90H ;CONVERT TO ASCII DA A ADDC A,#40H DA A ;GOT IT HERE MOV R5,A ;OUTPUT THE BYTE SJMP SOUT_1 ; HOUTHI: SWAP A ;SWAP TO OUTPUT HIGH NIBBLE ; HOUTLO: ANL A,#0FH ;STRIP JNZ HOUT1 ;PRINT IF NOT ZERO JNB ADD_IN,HOUT1 ;OUTPUT A ZERO IF NOT SUPRESSED RET ; ;***************************************************************************** ;******* New baudrate detection ********************************************** ;******* calculate r3:r1=-(Timer2 DIV 16) for serial mode ******************** ;******* Wulf 3 alteration 2 ************************************************* ; SERCALC:mov a,#0F0h mov r3,a mov r1,TH2 anl a,r1 swap a cpl a xch a,r3 anl a,TL2 xch a,r1 anl a,#00Fh orl a,r1 swap a cpl a IF (OldInfineon5xx = ON) mov r1,ADCON ;save BSY bit mov DAPR,#0 ;start A/D for 805xx test ENDIF ;CKCON0 = 8FH Reset Value = 0000 000?B [TWIX2 WDX2 PCAX2 SIX2 T2X2 T1X2 T0X2 X2] ; In Fast Mode, set for /TPS+1 , clear /1 for BOTH Timer & Baud!. IF (LP51RD2_Fast=ON) ; Baud timing done, spare room here MOV CLKCON0,#0000_0111B ; T0,T1 Use /TPS+1 Timer T2 uses /1 for Baud MOV TPS_LP51RD2,#(12-1)*16 ; Div12 for T0,T1 after Baud Sense ELSEIF (LP51RD2_Slow=ON) MOV TPS_LP51RD2,#(12-1)*16 ; Div12 for T0,T1 after Baud Sense ENDIF xch a,r1 ret ; ;***************************************************************************** ; ORG 1F78H ; CKS_I: JB CKS_B,CS_I LJMP 401BH ; CS_I: LJMP 2088H ; E14X: DB 'NO DATA"' ; E11X: DB 128+20 DB 'ARITH. OVERFLOW"' ; E16X: DB 'PROGRAMMING"' ; E15X: DB 'CAN' DB 27H DB 'T CONTINUE"' ; E10X: DB 'INVALID LINE NUMBER"' ; NOROM: DB 'PROM MODE"' ; ;***************************************************************************** ;****** Set a new version message ******************************************** ; ;S_N: DB '*MCS-51(tm) BASIC V1.1*' ; ;S_N: DB '*MCS-BASIC-52 V1.31*"' S_N: DB '*MCS-BASIC-52 V1.32*"' ;TSim51 ; ;***************************************************************************** ; ORG 1FEBH ;FOR LINK COMPATABILITY ; GET_DIGIT_CHECK: ; Get a character, then check for digit ; ACALL GET_DPTR_CHARACTER ; DIGIT_CHECK: ;CHECK FOR A VALID ASCII DIGIT, SET CARRY IF FOUND ; CJNE A,#'9'+1,DC10 ;SEE IF ASCII 9 OR LESS DC10: JC DC1 RET ; DC1: CJNE A,#'0',DC11 ;SEE IF ASCII 0 OR GREATER DC11: CPL C RET ; ORG 1FF8H ; ERS: DB 'ERROR: "' ; ;*************************************************************** ; XSEG ;External Ram ; ;*************************************************************** ; DS 4 IBCNT: DS 1 ;LENGTH OF A LINE IBLN: DS 2 ;THE LINE NUMBER IBUF: DS LINLEN ;THE INPUT BUFFER CONVT: DS 15 ;CONVERSION LOCATION FOR FPIN ; ORG 100H ; GTB: DS 1 ;GET LOCATION ERRLOC: DS 1 ;ERROR TYPE ERRNUM: DS 2 ;WHERE TO GO ON AN ERROR VARTOP: DS 2 ;TOP OF VARIABLE STORAGE ST_ALL: DS 2 ;STORAGE ALLOCATION MT_ALL: DS 2 ;MATRIX ALLOCATION MEMTOP: DS 2 ;TOP OF MEMORY RCELL: DS 2 ;RANDOM NUMBER CELL DS FPSIZ-1 CXTAL: DS 1 ;CRYSTAL DS FPSIZ-1 FPT1: DS 1 ;FLOATINP POINT TEMP 1 DS FPSIZ-1 FPT2: DS 1 ;FLOATING POINT TEMP 2 INTLOC: DS 2 ;LOCATION TO GO TO ON INTERRUPT STR_AL: DS 2 ;STRING ALLOCATION SPV: DS 2 ;SERIAL PORT BAUD RATE TIV: DS 2 ;TIMER INTERRUPT NUM AND LOC PROGS: DS 2 ;PROGRAM A PROM TIME OUT ; ;***************************************************************************** ;****** Disable Intel programming for to get room **************************** ;****** We don't need this, but don't remark it! ***************************** ; IPROGS: DS 2 ;INTELLIGENT PROM PROGRAMMER TIMEOUT ; ;***************************************************************************** ; TM_TOP: DS 1 ; END