From d00a92eb232b03cc5e19a33c407c0f0efd50b784 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 22:00:43 +0200 Subject: ... --- forth/firmware/ff-atmega.asm | 6092 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 6092 insertions(+) create mode 100644 forth/firmware/ff-atmega.asm (limited to 'forth/firmware/ff-atmega.asm') diff --git a/forth/firmware/ff-atmega.asm b/forth/firmware/ff-atmega.asm new file mode 100644 index 0000000..555e5c2 --- /dev/null +++ b/forth/firmware/ff-atmega.asm @@ -0,0 +1,6092 @@ +;********************************************************************** +; * +; Filename: FlashForth.asm * +; Date: 22.03.2017 * +; File Version: 5.0 * +; MCU: Atmega * +; Copyright: Mikael Nordman * +; Author: Mikael Nordman * +; * +;********************************************************************** +; FlashForth is a standalone Forth system for microcontrollers that +; can flash their own flash memory. +; +; Copyright (C) 2017 Mikael Nordman + +; This program is free software: you can redistribute it and/or modify +; it under the terms of the GNU General Public License version 3 as +; published by the Free Software Foundation. +; +; This program is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. +; +; You should have received a copy of the GNU General Public License +; along with this program. If not, see . +; +; Modified versions of FlashForth must be clearly marked as such, +; in the name of this file, and in the identification +; displayed when FlashForth starts. +;********************************************************************** + +; Include the FlashForth configuration file +.include "config.inc" + +; Define the FF version date string +#define DATE "22.03.2017" + + +; Register definitions + .def upl = r2 ; not in interrupt + .def uph = r3 ; not in interrupt + .def r_zero = r5 ; read only zero + .def r_one = r6 ; read only one + .def r_two = r7 ; read only two + .def t8 = r8 ; Not in interrupt + .def wflags = r9 ; not in interrupt + + .def loadreg0 = r4 ; + .def loadreg1 = r12 + .def loadreg2 = r13 + + + .def ibasel=r10 ; Not in interrupt + .def ibaseh=r11 ; Not in interrupt + .def ms_count = r14 ; Not in interrupt + .def ms_count1 = r15 ; Not in interrupt + .def t0 = r16 + .def t1 = r17 + .def t2 = r0 ; Not in interrupt + .def t3 = r1 ; Not in interrupt + + .def al = r18 + .def ah = r19 + .def pl = r20 ; P Register and FOR..LOOP INDEX variable + .def ph = r21 + + .def FLAGS1 = r22 ; Not in interrupt + .def FLAGS2 = r23 ; Not in interrupt + .def tosl = r24 + .def tosh = r25 +; xl = r26 +; xh = r27 +; yl = r28 ; StackPointer Ylo +; yh = r29 ; StackPointer Yhi +; zl = r30 +; zh = r31 + .def t4 = r26 + .def t5 = r27 + .def t6 = r30 + .def t7 = r31 + +; Macros +.macro poptos + ld tosl, Y+ + ld tosh, Y+ +.endmacro + +.macro pushtos + st -Y, tosh + st -Y, tosl +.endmacro + +.macro in_ +.if (@1 < $40) + in @0,@1 +.else + lds @0,@1 +.endif +.endmacro + +.macro out_ +.if (@0 < $40) + out @0,@1 +.else + sts @0,@1 +.endif +.endmacro + +.macro sbi_ +.if (@0 < $40) + sbi @0,@1 +.else + in_ @2,@0 + ori @2,exp2(@1) + out_ @0,@2 +.endif +.endmacro + +.macro cbi_ +.if (@0 < $40) + cbi @0,@1 +.else + in_ @2,@0 + andi @2,~(exp2(@1)) + out_ @0,@2 +.endif +.endmacro + +.macro lpm_ +.if (FLASHEND < 0x8000) ; Word address + lpm @0,@1 +.else + elpm @0,@1 +.endif +.endmacro + +.macro sub_pflash_z +.if (PFLASH > 0) + subi zh, high(PFLASH) +.endif +.endmacro + +.macro add_pflash_z +.if (PFLASH > 0) + subi zh, high(0x10000-PFLASH) +.endif +.endmacro + +.macro sub_pflash_tos +.if (PFLASH > 0) + subi tosh, high(PFLASH) +.endif +.endmacro + +.macro add_pflash_tos +.if (PFLASH > 0) + subi tosh, high(0x10000-PFLASH) +.endif +.endmacro + +.macro rampv_to_c +.if (FLASHEND >= 0x8000) + bset 0 +.else + bclr 0 +.endif +.endmacro + +.macro fdw + .dw ((@0<<1)+PFLASH) +.endmacro + +.macro m_pop_zh +.ifdef EIND + pop zh +.endif +.endmacro +.macro m_pop_xh +.ifdef EIND + pop xh + .endif +.endmacro +.macro m_pop_t0 +.ifdef EIND + pop t0 + .endif +.endmacro +.macro m_push_t0 +.ifdef EIND + push t0 + .endif +.endmacro +.macro mijmp +.ifdef EIND + eijmp +.else + ijmp +.endif +.endmacro + +; Symbol naming compatilibity +; UART0 symbols for Atmega32 +.ifndef UCSR0A +.equ UCSR0A=UCSRA +.equ UDR0_=UDR +.equ UCSR0B=UCSRB +.equ UCSR0C=UCSRC +.equ RXEN0=RXEN +.equ TXEN0=TXEN +.equ RXCIE0=RXCIE +.equ UCSZ00=UCSZ0 +.equ USBS0=USBS +.equ UBRR0H=UBRRH +.equ UBRR0L=UBRRL +.equ URSEL_=0x80 +.else +.equ UDR0_=UDR0 +.equ URSEL_=0 +.endif + +.ifndef SPMCSR +.equ SPMCSR=SPMCR +.endif + +.ifndef SPMEN +.equ SPMEN=SELFPRGEN +.endif + +.ifndef EEWE +.equ EEWE=EEPE +.endif + +.ifndef EEMWE +.equ EEMWE=EEMPE +.endif + +.if OPERATOR_UART == 1 +.equ OP_TX_=TX1_ +.equ OP_RX_=RX1_ +.equ OP_RXQ=RX1Q +.else +.if OPERATOR_UART == 0 +.equ OP_TX_=TX0_ +.equ OP_RX_=RX0_ +.equ OP_RXQ=RX0Q +.endif +.endif + +#define ubrr0val (FREQ_OSC/16/BAUDRATE0) - 1 +#define ubrr1val (FREQ_OSC/16/BAUDRATE1) - 1 + +.if FREQ_OSC < 16384000 ; Hz +.equ ms_value_tmr0 = ((FREQ_OSC/1000/64) - 1) +.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1) +.equ ms_value_tmr2 = ((FREQ_OSC/1000/64) - 1) +.ifdef TCCR0B +.equ ms_pre_tmr0 = 3 +.endif +.ifdef TCCR0 +.equ ms_pre_tmr0 = 4 +.endif +.ifdef TCCR2B +.equ ms_pre_tmr2 = 4 +.endif +.ifdef TCCR2 +.equ ms_pre_tmr2 = 3 +.endif + +.else ; FREQ_OSC >= 16384000 Hz + +.equ ms_value_tmr0 = ((FREQ_OSC/1000/256) - 1) +.equ ms_value_tmr1 = ((FREQ_OSC/1000) - 1) +.equ ms_value_tmr2 = ((FREQ_OSC/1000/128) - 1) +.ifdef TCCR0B +.equ ms_pre_tmr0 = 4 +.endif +.ifdef TCCR0 +.equ ms_pre_tmr0 = 6 +.endif +.ifdef TCCR2B +.equ ms_pre_tmr2 = 5 +.endif +.ifdef TCCR2 +.equ ms_pre_tmr2 = 4 +.endif +.endif +.equ CPU_LOAD_VAL = (FREQ_OSC*255/100000) +;.............................................................................. +;Program Specific Constants (literals used in code) +;.............................................................................. +; Flash page size +.equ PAGESIZEB=PAGESIZE*2 ; Page size in bytes + +; Forth word header flags +.equ NFA= 0x80 ; Name field mask +.equ IMMED= 0x40 ; Immediate mask +.equ INLINE= 0x20 ; Inline mask for 1 and 2 cell code +.equ INLINE4= 0x00 ; Inline mask for 4 cell code +.equ INLINE5= 0x00 ; Inline mask for 5 cell code +.equ COMPILE= 0x10 ; Compile only mask +.equ NFAmask= 0xf ; Name field length mask + +; FLAGS2 +.equ fIDLE= 6 ; 0 = busy, 1 = idle +.equ fLOAD= 5 ; Load measurement ready +.equ fLOADled= 4 ; 0 = no load led, 1 = load led on +.equ fFC_tx1= 3 ; 0=Flow Control, 1 = no Flow Control +.equ fFC_tx0= 2 ; 0=Flow Control, 1 = no Flow Control +.equ ixoff_tx1= 1 +.equ ixoff_tx0= 0 + +; FLAGS1 +.equ fLIT= 7 ; Literal compiled +.equ noclear= 6 ; dont clear optimisation flags +.equ idup= 5 ; Use dupzeroequal instead of zeroequal +.equ izeroeq= 4 ; Use brne instead of breq if zeroequal +.equ istream= 3 +.equ fLOCK= 2 +.equ fTAILC= 1 +.equ idirty= 0 + +;;; For Flow Control +.equ XON= 0x11 +.equ XOFF= 0x13 + +.equ CR_=0x0d +.equ LF_=0x0a +.equ BS_=0x08 +.equ TAB_=0x09 + +;;; Memory mapping prefixes +.equ PRAM = 0x0000 ; 8 Kbytes of ram (atm2560) +.equ PEEPROM = RAMEND+1 ; 4 Kbytes of eeprom (atm2560) +.if (FLASHEND == 0x1ffff) ; 128 Kwords flash +.equ OFLASH = PEEPROM+EEPROMEND+1 ; 52 Kbytes available for FlashForth(atm2560) +.equ PFLASH = 0 +.equ RAMPZV = 3 +.equ KERNEL_SIZE=0x0d80 +.else +.if (FLASHEND == 0xffff) ; 64 Kwords flash +.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 Kbytes available for FlashForth(atm128) +.equ PFLASH = 0 +.equ RAMPZV = 1 +.equ KERNEL_SIZE=0x0d00 +.else +.if (FLASHEND == 0x7fff) ; 32 Kwords flash +.equ OFLASH = PEEPROM+EEPROMEND+1 ; 56 Kbytes available for FlashForth +.equ PFLASH = 0 +.equ RAMPZV = 0 +.equ KERNEL_SIZE=0x0d00 +.else +.if (FLASHEND == 0x3fff) ; 16 Kwords flash +.equ OFLASH = 0x8000 ; 32 Kbytes available for FlashForth +.equ PFLASH = OFLASH +.equ RAMPZV = 0 +.equ KERNEL_SIZE=0x0c80 +.else +.if (FLASHEND == 0x1fff) ; 8 Kwords flash +.equ OFLASH = 0xC000 ; 16 Kbytes available for FlashForth +.equ PFLASH = OFLASH +.equ RAMPZV = 0 +.equ KERNEL_SIZE=0x0c80 +.endif +.endif +.endif +.endif +.endif +.equ BOOT_SIZE=0x400 +.equ BOOT_START=FLASHEND - BOOT_SIZE + 1 ; atm128: 0xfc00, atm328: 0x3c00 +.equ KERNEL_START=BOOT_START - KERNEL_SIZE + +;;; High values for memory areas +.equ FLASH_HI = 0xffff - (BOOT_SIZE*2) - (KERNEL_SIZE*2) +.equ EEPROM_HI =PEEPROM + EEPROMEND +.equ RAM_HI = RAMEND + +;;; USER AREA for the OPERATOR task +.equ ursize= RETURN_STACK_SIZE +.equ ussize= PARAMETER_STACK_SIZE +.equ utibsize= TIB_SIZE + +;;; User variables and area +.equ us0= -28 ; Start of parameter stack +.equ ur0= -26 ; Start of ret stack +.equ uemit= -24 ; User EMIT vector +.equ ukey= -22 ; User KEY vector +.equ ukeyq= -20 ; User KEY? vector +.equ ubase= -18 ; Number Base +.equ utib= -16 ; TIB address +.equ utask= -14 ; Task area pointer +.equ ustatus= -12 +.equ uflg= -11 +.equ usource= -10 ; Two cells +.equ utoin= -6 ; Input stream +.equ ulink= -4 ; Task link +.equ ursave= -2 ; Saved ret stack pointer +.equ uhp= 0 ; Hold pointer + + +;;; Variables in EEPROM +.equ eeprom= PEEPROM +.equ dp_start= eeprom + 0x0000 ; TURNKEY +.equ dp_flash= eeprom + 0x0002 ; FLASH dictionary pointer +.equ dp_eeprom= eeprom + 0x0004 ; EEPROM dictionary pointer +.equ dp_ram= eeprom + 0x0006 ; RAM dictionary pointer +.equ latest= eeprom + 0x0008 ; Pointer to latest dictionary word +.equ prompt= eeprom + 0x000a ; Deferred prompt +.equ ehere= eeprom + 0x000c + +;**************************************************** +.dseg +ibuf: .byte PAGESIZEB +ivec: .byte INT_VECTORS_SIZE + +rxqueue0: +rbuf0_wr: .byte 1 +rbuf0_rd: .byte 1 +rbuf0_lv: .byte 1 +rbuf0: .byte RX0_BUF_SIZE + +.ifdef UCSR1A +rxqueue1: +rbuf1_wr: .byte 1 +rbuf1_rd: .byte 1 +rbuf1_lv: .byte 1 +rbuf1: .byte RX1_BUF_SIZE +.endif + +litbuf0: .byte 1 +litbuf1: .byte 1 + +dpSTART: .byte 2 +dpFLASH: .byte 2 ; DP's and LATEST in RAM +dpEEPROM: .byte 2 +dpRAM: .byte 2 +dpLATEST: .byte 2 + +iaddrl: .byte 1 +iaddrh: .byte 1 +.ifdef RAMPZ +iaddru: .byte 1 +ibaseu: .byte 1 +.endif + +.if IDLE_MODE == 1 +.if CPU_LOAD == 1 +load_acc: .byte 3 ; Load measurement accumulator +load_res: .byte 3 ; Load result +.endif +.endif + +cse: .byte 1 ; Current data section 0=flash, 1=eeprom, 2=ram +state: .byte 1 ; Compilation state +uvars: .byte (-us0) +up0: .byte 2 +urbuf: .byte ursize +usbuf: .byte ussize +utibbuf: .byte utibsize +dpdata: .byte 2 + +.eseg +.org 0 + .dw 0xffff ; Force first cell of eeprom to 0xffff +;******************************************************************* +; Start of kernel +;******************************************************************* +.cseg +.if (FLASHEND == 0x1ffff) +.org 0x17e80 +.else +.org KERNEL_START +.endif +;*********************************************************** +CMP: + call TOR + rjmp CMP2 +CMP1: + call NEQUALSFETCH + call MINUS + call ZEROSENSE + breq CMP2 + jmp TWODROPZ +CMP2: + call XNEXT + brcc CMP1 + jmp TWODROPNZ + +.if (FLASHEND == 0x1ffff) +.org KERNEL_START+0x0 +.endif +;;; ************************************************* +;;; WARM user area data +.equ warmlitsize= 28 +WARMLIT: + .dw 0x0200 ; cse, state + .dw utibbuf-4 ; S0 + .dw usbuf-1 ; R0 + fdw OP_TX_ + fdw OP_RX_ + fdw OP_RXQ + .dw BASE_DEFAULT ; BASE + .dw utibbuf ; TIB + fdw OPERATOR_AREA ; TASK + .dw 0 ; ustatus & uflg + .dw 0 ; source + .dw 0 ; source + .dw 0 ; TOIN + .dw up0 ; Task link +; M? -- caddr count current data space string +; dw L_DOTBASE +L_MEMQ: + .db NFA|1," " +MEMQ: + call CSE_ + call DOLIT + fdw MEMQADDR_N + call PLUS + call FETCH_A + call CFETCHPP + call DOLIT + .dw NFAmask + jmp AND_ + +.if (FLASHEND == 0x1ffff) + fdw PAUSE_L +WDON_L: + .db NFA|3,"wd+" +WDON: + cli + wdr + lds tosh, WDTCSR + ori tosh, (1<r c@ swap or r> c! +; ; + fdw ICCOMMA_L +MSET_L: + .db NFA|4,"mset",0 +MSET: + movw zl, tosl + poptos + ld t0, z + or t0, tosl + st z, t0 + poptos + ret + +; : mclr ( mask addr -- ) +; dup >r c@ swap invert and r> c! +; ; + fdw MSET_L +MCLR_L: + .db NFA|4,"mclr",0 +MCLR_: + movw zl, tosl + poptos + ld t0, z + com tosl + and t0, tosl + st z, t0 + poptos + ret + +; LSHIFT x1 u -- x2 + fdw MCLR_L +LSHIFT_L: + .db NFA|6,"lshift",0 +LSHIFT: + movw zl, tosl + poptos +LSHIFT1: + sbiw zl, 1 + brmi LSHIFT2 + lsl tosl + rol tosh + rjmp LSHIFT1 +LSHIFT2: + ret + +; RSHIFT x1 u -- x2 + fdw LSHIFT_L +RSHIFT_L: + .db NFA|6,"rshift",0 +RSHIFT: + movw zl, tosl + poptos +RSHIFT1: + sbiw zl, 1 + brmi RSHIFT2 + lsr tosh + ror tosl + rjmp RSHIFT1 +RSHIFT2: + ret + +;********************************************** +NEQUALSFETCH: + rcall CFETCHPP + rcall ROT + rcall CFETCHPP + rjmp ROT +;*************************************************** +; N= c-addr nfa -- n string:name cmp +; n=0: s1==s2, n=ffff: s1!=s2 +; N= is specificly used for finding dictionary entries +; It can also be used for comparing strings shorter than 16 characters, +; but the first string must be in ram and the second in program memory. + fdw RSHIFT_L +NEQUAL_L: + .db NFA|2,"n=",0 +NEQUAL: + rcall NEQUALSFETCH + andi tosl, 0xf + rcall EQUAL + rcall ZEROSENSE + breq NEQUAL5 + rcall ONEMINUS + rcall CFETCHPP + rcall TOR + rjmp NEQUAL4 +NEQUAL2: + rcall NEQUALSFETCH + rcall NOTEQUAL + rcall ZEROSENSE + breq NEQUAL3 + rcall TRUE_ + call LEAVE + rjmp NEQUAL4 +NEQUAL3: + rcall RFETCH + rcall ZEROSENSE + brne NEQUAL4 + rcall FALSE_ +NEQUAL4: + call XNEXT + brcc NEQUAL2 + pop t1 + pop t0 + rjmp NEQUAL6 +NEQUAL5: + rcall TRUE_ +NEQUAL6: + rcall NIP + jmp NIP + +; SKIP c-addr u c -- c-addr' u' +; skip matching chars +; u (count) must be smaller than 256 + fdw NEQUAL_L +SKIP_L: + .db NFA|4,"skip",0 +SKIP: + + rcall TOR +SKIP0: + rcall DUPZEROSENSE + breq SKIP2 + + rcall OVER + rcall CFETCH_A + + rcall DUP + rcall DOLIT + .dw TAB_ + rcall EQUAL + rcall ZEROSENSE + brne SKIP05 + rcall RFETCH + rcall EQUAL + rcall ZEROSENSE + breq SKIP2 + rjmp SKIP1 +SKIP05: + rcall DROP +SKIP1: + rcall ONE + rcall SLASHSTRING + rjmp SKIP0 +SKIP2: + pop t0 + pop t0 + ret + + +; SCAN c-addr u c -- c-addr' u' +; find matching chars + + + fdw SKIP_L +SCAN_L: + .db NFA|4,"scan",0 +SCAN: + rcall STORE_P_TO_R + rcall TOR + rjmp SCAN3 +SCAN1: + rcall CFETCHPP + rcall DUP + rcall DOLIT + .dw TAB_ + rcall EQUAL + rcall ZEROSENSE + breq SCAN2 + rcall DROP + rjmp SCAN25 +SCAN2: + call FETCH_P + rcall EQUAL + rcall ZEROSENSE + breq SCAN3 +SCAN25: + rcall ONEMINUS + rjmp SCAN4 +SCAN3: + call XNEXT + brcc SCAN1 +SCAN4: + rcall RFROM + rcall ONEPLUS + rcall R_TO_P + ret + +; : mtst ( mask addr -- flag ) +; c@ and +; ; + fdw SCAN_L +MTST_L: + .db NFA|4,"mtst",0 +MTST: + movw zl, tosl + ld tosl, z+ + ld t0, Y+ + ld t1, Y+ + and tosl, t0 + clr tosh + ret + + + fdw MTST_L +FCY_L: + .db NFA|3,"Fcy" + rcall DOCREATE + .dw FREQ_OSC / 1000 + +;;; Check parameter stack pointer + .db NFA|3,"sp?" +check_sp: + rcall SPFETCH + call R0_ + rcall FETCH_A + call S0 + rcall FETCH_A + rcall ONEPLUS + rcall WITHIN + rcall XSQUOTE + .db 3,"SP?" + rcall QABORT + ret +;*************************************************** +; EMIT c -- output character to the emit vector + fdw FCY_L +EMIT_L: + .db NFA|4,"emit",0 +EMIT: + rcall UEMIT_ + jmp FEXECUTE + +;*************************************************** +; KEY -- c get char from UKEY vector + fdw EMIT_L +KEY_L: + .db NFA|3,"key" +KEY: + rcall UKEY_ + jmp FEXECUTE + +;*************************************************** +; KEY -- c get char from UKEY vector + fdw KEY_L +KEYQ_L: + .db NFA|4,"key?",0 +KEYQ: + rcall UKEYQ_ + jmp FEXECUTE + + fdw KEYQ_L +EXECUTE_L: + .db NFA|7,"execute" +EXECUTE: + movw zl, tosl + sub_pflash_z + poptos + rampv_to_c + ror zh + ror zl + mijmp + + fdw EXECUTE_L +FEXECUTE_L: + .db NFA|3,"@ex" +FEXECUTE: + rcall FETCH_A + jmp EXECUTE + + fdw FEXECUTE_L +VARIABLE_L: + .db NFA|8,"variable",0 +VARIABLE_: + rcall HERE + rcall CELL + rcall ALLOT + jmp CONSTANT_ + + fdw VARIABLE_L +TWOVARIABLE_L: + .db NFA|9,"2variable" +TWOVARIABLE_: + rcall HERE + rcall DOLIT + .dw 0x4 + rcall ALLOT + jmp CONSTANT_ + + fdw TWOVARIABLE_L +CONSTANT_L: + .db NFA|8,"constant",0 +CONSTANT_: + rcall COLON + call LITERAL + jmp SEMICOLON + + fdw CONSTANT_L +TWOCONSTANT_L: + .db NFA|9,"2constant" +TWOCONSTANT_: + rcall SWOP + rcall COLON + call LITERAL + call LITERAL + jmp SEMICOLON + +; DOCREATE, code action of CREATE +; Fetch the next cell from program memory to the parameter stack +DOCREATE_L: + .db NFA|3, "(c)" +DOCREATE: + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + m_pop_zh + pop zh + pop zl + mijmp + +;;; Resolve the runtime action of the word created by using does> +DODOES_L: + .db NFA|3, "(d)" +DODOES: + m_pop_xh + pop xh + pop xl + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + movw z, x + mijmp ; (z) + +FETCHLIT: + pushtos + lsl zl + rol zh + lpm_ tosl, z+ + lpm_ tosh, z+ + ret + + .db NFA|3, "(,)" +DOCOMMAXT: + m_pop_t0 + pop zh + pop zl + rcall FETCHLIT + ror zh + ror zl + push zl + push zh + m_push_t0 + rjmp COMMAXT + +; SP@ -- addr get parameter stack pointer + fdw TWOCONSTANT_L +SPFETCH_L: + .db NFA|3,"sp@" +SPFETCH: + movw z, y + pushtos + movw tosl, z + ret + +; SP! addr -- store stack pointer + .db NFA|3,"sp!" +SPSTORE: + movw y, tosl + ret + +; RPEMPTY -- EMPTY THE RETURN STACK + .db NFA|3,"rp0" +RPEMPTY: + m_pop_xh + pop xh + pop xl + call R0_ + rcall FETCH_A + out spl, tosl + out sph, tosh + poptos + movw zl, xl + mijmp + +; RP@ Fetch the return stack pointer + fdw SPFETCH_L +RPFETCH_L: + .db NFA|INLINE|COMPILE|3,"rp@" +RPFETCH: + pushtos + in tosl, spl + in tosh, sph + ret + +; >< Swap bytes + fdw RPFETCH_L +SWAPB_L: + .db NFA|INLINE|2,"><",0 +SWAPB: + mov t0, tosl + mov tosl, tosh + mov tosh, t0 + ret + +; DICTIONARY POINTER FOR the current section +; Flash -- sets the data section to flash + fdw SWAPB_L +FLASH_L: +ROM_N: + .db NFA|5,"flash" +ROM_: + sts cse, r_zero + ret + +; EEPROM -- sets the data section to EEPROM data memory + fdw FLASH_L +EEPROM_L: +EROM_N: + .db NFA|6,"eeprom",0 +EROM: + sts cse, r_two + ret + +; RAM -- sets the data section to RAM memory + fdw EEPROM_L +RAM_L: +FRAM_N: + .db NFA|3,"ram" +FRAM: + ldi t0, 4 + sts cse, t0 + ret + +; DP -- a-addr +; Fetched from EEPROM + fdw RAM_L +DP_L: + .db NFA|2,"dp",0 +DP: + rcall IDP + rcall CSE_ + jmp PLUS + + +;;; + .db NFA|3,"cse" +CSE_: + pushtos + lds tosl, cse + clr tosh + ret + +; HERE -- addr get current data space ptr +; DP @ ; + fdw DP_L +HERE_L: + .db NFA|4,"here",0 +HERE: + rcall DP + jmp FETCH + +; , x -- append cell to current data space +; HERE ! CELL ALLOT ; + fdw HERE_L +COMMA_L: + .db NFA|1,"," +COMMA: + rcall HERE + rcall STORE_A + rcall CELL + jmp ALLOT + +; C, c -- append char to current data space +; HERE C! 1 ALLOT ; + fdw COMMA_L +CCOMMA_L: + .db NFA|2,"c,",0 +CCOMMA: + rcall HERE + rcall CSTORE_A + rcall ONE + jmp ALLOT + + +; CELL -- n size of one cell + fdw CCOMMA_L +CELL_L: + .db NFA|4,"cell",0 +CELL: + pushtos + ldi tosl, 2 + ldi tosh, 0 + ret + +; ALIGN -- align DP + fdw CELL_L +ALIGN_L: + .db NFA|5,"align" +ALIGN: + rcall HERE + rcall ALIGNED + rcall DP + jmp STORE + +; ALIGNED addr -- a-addr align given addr + fdw ALIGN_L +ALIGNED_L: + .db NFA|7,"aligned" +ALIGNED: + adiw tosl, 1 + cbr tosl, 1 + ret + +; CELL+ a-addr1 -- a-addr2 add cell size +; 2 + ; + fdw ALIGNED_L +CELLPLUS_L: + .db NFA|INLINE|5,"cell+" +CELLPLUS: + adiw tosl, 2 + ret + +; CELLS n1 -- n2 cells->adrs units + fdw CELLPLUS_L +CELLS_L: + .db NFA|INLINE|5,"cells" +CELLS: + lsl tosl + rol tosh + ret + +; CHAR+ c-addr1 -- c-addr2 add char size + fdw CELLS_L +CHARPLUS_L: + .db NFA|INLINE|5,"char+" +CHARPLUS: + adiw tosl, 1 + ret + +; CHARS n1 -- n2 chars->adrs units + fdw CHARPLUS_L +CHARS_L: + .db NFA|INLINE|5,"chars" +CHARS: ret + + fdw CHARS_L +COMMAXT_L: + .db NFA|3, "cf," +COMMAXT: + rcall DUP + rcall IHERE + rcall MINUS + rcall ABS_ + rcall DOLIT + .dw 0xff0 + rcall GREATER + rcall ZEROSENSE + breq STORECF1 +STORECFF1: +; rcall CALL_ + rcall DOLIT +.ifdef EIND + .dw 0x940F ; On Atmega 2560 all code is on 128 - 256 Kword area. +.else + .dw 0x940E ; call jmp:0x940d +.endif + call ICOMMA + sub_pflash_tos + rampv_to_c + ror tosh + ror tosl + rjmp STORECF2 +STORECF1: + rcall IHERE + rcall MINUS + rcall TWOMINUS + rcall TWOSLASH + ;rcall RCALL_ + andi tosh, 0x0f + ori tosh, 0xd0 +STORECF2: + jmp ICOMMA + + +; !COLON -- change code field to docolon +; -6 IALLOT ; +; .dw link +;link set $ + .db NFA|2,"!:",0 +STORCOLON: + rcall DOLIT + .dw 0xfffa ; -6 + jmp IALLOT + + +; 2@ a-addr -- x1 x2 fetch 2 cells +; DUP @ SWAP CELL+ @ ; +; the lower address will appear on top of stack + fdw COMMAXT_L +TWOFETCH_L: + .db NFA|2,"2@",0 +TWOFETCH: + rcall DUP + rcall FETCH_A + rcall SWOP + rcall CELLPLUS + jmp FETCH_A + +; 2! x1 x2 a-addr -- store 2 cells +; SWAP OVER ! CELL+ ! ; +; the top of stack is stored at the lower adrs + fdw TWOFETCH_L +TWOSTORE_L: + .db NFA|2,"2!",0 +TWOSTORE: + rcall SWOP + rcall OVER + rcall CELLPLUS + rcall STORE_A + jmp STORE + +; 2DROP x1 x2 -- drop 2 cells +; DROP DROP ; + fdw TWOSTORE_L +TWODROP_L: + .db NFA|5,"2drop" +TWODROP: + rcall DROP + jmp DROP + +; 2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells +; OVER OVER ; + fdw TWODROP_L +TWODUP_L: + .db NFA|4,"2dup",0 +TWODUP: + rcall OVER + jmp OVER + +; 2SWAP x1 x2 x3 x4 -- x3 x4 x1 x2 dup top 2 cells + fdw TWODUP_L +TWOSWAP_L: + .db NFA|5,"2swap" +TWOSWAP: + rcall ROT + rcall TOR + rcall ROT + rcall RFROM + ret + +; INPUT/OUTPUT ================================== + +; SPACE -- output a space +; BL EMIT ; + fdw TWOSWAP_L +SPACE_L: + .db NFA|5,"space" +SPACE_: + rcall BL + jmp EMIT + +; SPACES n -- output n spaces +; BEGIN DUP WHILE SPACE 1- REPEAT DROP ; + fdw SPACE_L +SPACES_L: + .db NFA|6,"spaces",0 +SPACES: +SPCS1: + rcall DUPZEROSENSE + breq SPCS2 + rcall SPACE_ + rcall ONEMINUS + rjmp SPCS1 +SPCS2: jmp DROP + + +; umin u1 u2 -- u unsigned minimum +; 2DUP U> IF SWAP THEN DROP ; + fdw SPACES_L +UMIN_L: + .db NFA|4,"umin",0 +UMIN: + rcall TWODUP + rcall UGREATER + rjmp MINMAX + +; umax u1 u2 -- u unsigned maximum +; 2DUP U< IF SWAP THEN DROP ; + fdw UMIN_L +UMAX_L: + .db NFA|4,"umax",0 +UMAX: + rcall TWODUP + rcall ULESS +MINMAX: + rcall ZEROSENSE + breq UMAX1 + rcall SWOP +UMAX1: jmp DROP + + fdw UMAX_L +ONE_L: + .db NFA|INLINE4|1,"1" +ONE: + pushtos + ldi tosl, 1 + ldi tosh, 0 + ret + +; ACCEPT c-addr +n -- +n' get line from terminal + fdw ONE_L +ACCEPT_L: + .db NFA|6,"accept",0 +ACCEPT: + rcall OVER + rcall PLUS + rcall OVER +ACC1: + rcall KEY + + cpi tosl, CR_ + brne ACC_LF + + rcall TRUE_ + rcall FCR + rcall CSTORE_A + rcall DROP + rjmp ACC6 +ACC_LF: + cpi tosl, LF_ + brne ACC2 + rcall DROP + + rcall FCR + rcall CFETCH_A + rcall ZEROSENSE + breq ACC6 + rcall FALSE_ + rcall FCR + rcall CSTORE_A + rjmp ACC1 +ACC2: + rcall FALSE_ + rcall FCR + rcall CSTORE_A + rcall DUP + rcall EMIT + rcall DUP + rcall DOLIT + .dw BS_ + rcall EQUAL + rcall ZEROSENSE + breq ACC3 + rcall DROP + rcall ONEMINUS + rcall TOR + rcall OVER + rcall RFROM + rcall UMAX + rjmp ACC1 +ACC3: + rcall OVER + rcall CSTORE_A + rcall ONEPLUS + rcall OVER + rcall UMIN + rcall TWODUP + rcall NOTEQUAL + rcall ZEROSENSE + brne ACC1 +ACC6: + rcall NIP + rcall SWOP + jmp MINUS + + .db NFA|3,"fcr" +FCR: + rcall DOUSER + .dw uflg + + +; TYPE c-addr u -- type line to terminal u < $100 +; : type for c@+ emit next drop ; + + fdw ACCEPT_L +TYPE_L: + .db NFA|4,"type",0 +TYPE: + rcall TOR + rjmp TYPE2 ; XFOR +TYPE1: + rcall CFETCHPP + rcall EMIT +TYPE2: + call XNEXT + brcc TYPE1 + pop t1 + pop t0 + jmp DROP + + +; (S" -- c-addr u run-time code for S" + .db NFA|3,"(s",0x22 +XSQUOTE: + m_pop_zh + pop zh + pop zl + lsl zl + rol zh + lpm_ t0, z+ + pushtos + movw tosl, zl + add_pflash_tos + pushtos + mov tosl, t0 + clr tosh + add zl, t0 + adc zh, tosh + adiw zl, 1 + rampv_to_c + ror zh + ror zl + mijmp + + fdw TYPE_L +SQUOTE_L: + .db NFA|IMMED|COMPILE|2,"s",0x22,0 +SQUOTE: + rcall DOCOMMAXT + fdw XSQUOTE + rcall ROM_ + rcall CQUOTE + jmp FRAM + + fdw SQUOTE_L +CQUOTE_L: + .db NFA|2,",",0x22,0 +CQUOTE: + rcall DOLIT + .dw 0x22 + rcall PARSE + rcall HERE + rcall OVER + rcall ONEPLUS + rcall ALIGNED + rcall ALLOT + jmp PLACE + + + fdw CQUOTE_L +DOTQUOTE_L: + .db NFA|IMMED|COMPILE|2,".",0x22,0 +DOTQUOTE: + rcall SQUOTE + rcall DOCOMMAXT + fdw TYPE + ret + + fdw DOTQUOTE_L +ALLOT_L: + .db NFA|5,"allot" +ALLOT: + rcall DP + jmp PLUSSTORE + + fdw ALLOT_L +DROP_L: + .db NFA|INLINE|4,"drop",0 +DROP: + poptos + ret + + fdw DROP_L +SWOP_L: + .db NFA|INLINE5|4,"swap",0 +SWOP: + ld t0, y+ + ld t1, y+ + pushtos + movw tosl, t0 + ret + + fdw SWOP_L +OVER_L: + .db NFA|INLINE4|4,"over",0 +OVER: + pushtos + ldd tosl, y+2 + ldd tosh, y+3 + ret + + fdw OVER_L +ROT_L: + .db NFA|3, "rot" +ROT: + rcall TOR + rcall SWOP + rcall RFROM + jmp SWOP + + fdw ROT_L +TOR_L: + .db NFA|COMPILE|2,">r",0 +TOR: + m_pop_zh + pop zh + pop zl + push tosl + push tosh + poptos + mijmp + + fdw TOR_L +RFROM_L: + .db NFA|COMPILE|2,"r>",0 +RFROM: + m_pop_zh + pop zh + pop zl + pushtos + pop tosh + pop tosl + mijmp + + fdw RFROM_L +RFETCH_L: + .db NFA|COMPILE|2,"r@",0 +RFETCH: + m_pop_zh + pop zh + pop zl + pushtos + pop tosh + pop tosl + push tosl + push tosh + mijmp + +; ABS n --- n1 absolute value of n + fdw DUP_L +ABS_L: + .db NFA|3,"abs" +ABS_: + rcall DUP + jmp QNEGATE + + fdw ABS_L +PLUS_L: + .db NFA|INLINE4|1, "+" + +PLUS: + ld t0, Y+ + ld t1, Y+ + add tosl, t0 + adc tosh, t1 + ret + +; m+ ( d n -- d1 ) + fdw PLUS_L +MPLUS_L: + .db NFA|2, "m+",0 +MPLUS: + rcall STOD + jmp DPLUS + + fdw MPLUS_L +MINUS_L: + .db NFA|INLINE5|1, "-" +MINUS: + ld t0, Y+ + ld t1, Y+ + sub t0, tosl + sbc t1, tosh + movw tosl, t0 + ret + +FROM_LITBUF: + lds r0, litbuf0 + lds r1, litbuf1 + ret +PLUSC_: + rcall FROM_LITBUF + com r0 + com r1 + add r0, r_one + adc r1, r_zero + rcall ANDIC1 + rjmp MINUSC_1 +MINUSC_: + rcall ANDIC0 +MINUSC_1: + ori tosh, 0x50 + rcall ICOMMA_ + rcall DUP + mov tosl, r1 + rcall ANDIC2 + ori tosl, 0x90 + ori tosh, 0x40 + rjmp ICOMMA_ +ANDIC0: + rcall FROM_LITBUF +ANDIC1: + rcall IDPMINUS + rcall IDPMINUS + mov tosl, r0 +ANDIC2: + mov tosh, tosl + swap tosh + andi tosl, 0x0f + andi tosh, 0x0f + ori tosl, 0x80 + ret +ANDIC_: + rcall ANDIC0 + ori tosh, 0x70 + rcall ICOMMA_ + rcall DUP + mov tosl, r1 + rcall ANDIC2 + ori tosl, 0x90 + ori tosh, 0x70 + rjmp ICOMMA_ +ORIC_: + rcall ANDIC0 + ori tosh, 0x60 + rcall ICOMMA_ + rcall DUP + mov tosl, r1 + rcall ANDIC2 + ori tosl, 0x90 + ori tosh, 0x60 +ICOMMA_: + jmp ICOMMA + + fdw MINUS_L +AND_L: + .db NFA|INLINE4|3, "and" +AND_: + ld t0, Y+ + ld t1, Y+ + and tosl, t0 + and tosh, t1 + ret + + fdw AND_L +OR_L: + .db NFA|INLINE4|2, "or",0 +OR_: + ld t0, Y+ + ld t1, Y+ + or tosl, t0 + or tosh, t1 + ret + + fdw OR_L +XOR_L: + .db NFA|INLINE4|3, "xor" +XOR_: + ld t0, Y+ + ld t1, Y+ + eor tosl, t0 + eor tosh, t1 + ret + + fdw XOR_L +INVERT_L: + .db NFA|INLINE|6, "invert",0 +INVERT: + com tosl + com tosh + ret + + fdw INVERT_L +NEGATE_L: + .db NFA|6, "negate",0 +NEGATE: + com tosl + com tosh + adiw tosl, 1 + ret + + fdw NEGATE_L +ONEPLUS_L: + .db NFA|INLINE|2, "1+",0 +ONEPLUS: + adiw tosl, 1 + ret + + fdw ONEPLUS_L +ONEMINUS_L: + .db NFA|INLINE|2, "1-",0 +ONEMINUS: + sbiw tosl, 1 + ret + + fdw ONEMINUS_L +TWOPLUS_L: + .db NFA|INLINE|2, "2+",0 +TWOPLUS: + adiw tosl, 2 + ret + + fdw TWOPLUS_L +TOBODY_L: + .db NFA|INLINE|5, ">body" +TOBODY: + adiw tosl, 4 + ret + + fdw TOBODY_L +TWOSTAR_L: + .db NFA|INLINE|2, "2*",0 +TWOSTAR: + lsl tosl + rol tosh + ret + + fdw TWOSTAR_L +TWOSLASH_L: + .db NFA|INLINE|2, "2/",0 +TWOSLASH: + asr tosh + ror tosl + ret + + fdw TWOSLASH_L +PLUSSTORE_L: + .db NFA|2,"+!",0 +PLUSSTORE: + rcall SWOP + rcall OVER + rcall FETCH_A + rcall PLUS + rcall SWOP + jmp STORE + + fdw PLUSSTORE_L +WITHIN_L: + .db NFA|6,"within",0 +WITHIN: + rcall OVER + rcall MINUS + rcall TOR + rcall MINUS + rcall RFROM + jmp ULESS + + fdw WITHIN_L +NOTEQUAL_L: + .db NFA|2,"<>",0 +NOTEQUAL: + rcall EQUAL + jmp ZEROEQUAL + + fdw ZEROLESS_L +EQUAL_L: + .db NFA|1, "=" +EQUAL: + rcall MINUS + jmp ZEROEQUAL + + + fdw EQUAL_L +LESS_L: + .db NFA|1,"<" +LESS: + rcall MINUS + jmp ZEROLESS + + fdw LESS_L +GREATER_L: + .db NFA|1,">" +GREATER: + rcall SWOP + jmp LESS + + fdw GREATER_L +ULESS_L: + .db NFA|2,"u<",0 +ULESS: + rcall MINUS ; Carry is valid after MINUS + sbc tosl, tosl + sbc tosh, tosh + ret + + fdw ULESS_L +UGREATER_L: + .db NFA|2, "u>",0 +UGREATER: + rcall SWOP + jmp ULESS + + fdw UGREATER_L +STORE_P_L: + .db NFA|2,"!p",0 +STORE_P: + movw pl, tosl + poptos + ret + + fdw STORE_P_L +STORE_P_TO_R_L: + .db NFA|COMPILE|4,"!p>r",0 +STORE_P_TO_R: + m_pop_zh + pop zh + pop zl + push pl + push ph + movw pl, tosl + poptos + mijmp + + fdw STORE_P_TO_R_L +R_TO_P_L: + .db NFA|COMPILE|3,"r>p" +R_TO_P: + m_pop_zh + pop zh + pop zl + pop ph + pop pl + mijmp + + fdw R_TO_P_L +PFETCH_L: + .db NFA|2,"p@",0 +PFETCH: + pushtos + movw tosl, pl + jmp FETCH + + fdw PFETCH_L +PSTORE_L: + .db NFA|2,"p!",0 +PSTORE: + pushtos + movw tosl, pl + jmp STORE + + fdw PSTORE_L +PCSTORE_L: + .db NFA|3,"pc!" +PCSTORE: + pushtos + movw tosl, pl + jmp CSTORE + + fdw PCSTORE_L +PPLUS_L: + .db NFA|INLINE|2,"p+",0 +PPLUS: + add pl, r_one + adc ph, r_zero + ret + + fdw PPLUS_L +PNPLUS_L: + .db NFA|3,"p++" +PNPLUS: + add pl, tosl + adc ph, tosh + poptos + ret + + fdw PNPLUS_L +UEMIT_L: + .db NFA|5,"'emit" +UEMIT_: + rcall DOUSER + .dw uemit + + fdw UEMIT_L +UKEY_L: + .db NFA|4,"'key",0 +UKEY_: + rcall DOUSER + .dw ukey + + fdw UKEY_L +UKEYQ_L: + .db NFA|5,"'key?" +UKEYQ_: + rcall DOUSER + .dw ukeyq + + .db NFA|3,"?0=" +ZEROSENSE: + sbiw tosl, 0 + poptos + ret + + .db NFA|3,"d0=" +DUPZEROSENSE: + sbiw tosl, 0 + ret + + fdw UKEYQ_L +UMSTAR_L: + .db NFA|3,"um*" +UMSTAR: + jmp umstar0 + + fdw UMSTAR_L +UMSLASHMOD_L: + .db NFA|6,"um/mod",0 +UMSLASHMOD: + jmp umslashmod0 + + + fdw UMSLASHMOD_L +USLASHMOD_L: + .db NFA|5,"u/mod" +USLASHMOD: + rcall FALSE_ + rcall SWOP + jmp umslashmod0 + + fdw USLASHMOD_L +STAR_L: + .db NFA|1,"*" +STAR: + rcall UMSTAR + jmp DROP + + fdw STAR_L +USLASH_L: + .db NFA|2,"u/",0 +USLASH: + rcall USLASHMOD + jmp NIP + + fdw USLASH_L +USSMOD_L: + .db NFA|6,"u*/mod",0 +USSMOD: + rcall TOR + rcall UMSTAR + rcall RFROM + jmp UMSLASHMOD + + + fdw USSMOD_L +SLASH_L: + .db NFA|1,"/" +SLASH: + rcall TWODUP + rcall XOR_ + rcall TOR + rcall ABS_ + rcall SWOP + rcall ABS_ + rcall SWOP + rcall USLASH + rcall RFROM + jmp QNEGATE + + fdw SLASH_L +NIP_L: + .db NFA|INLINE|3,"nip" +NIP: + ld t0, y+ + ld t0, y+ + ret + + fdw NIP_L +TUCK_L: + .db NFA|4,"tuck",0 +TUCK: + rcall SWOP + jmp OVER + + fdw TUCK_L +QNEGATE_L: + .db NFA|7,"?negate" +QNEGATE: + rcall ZEROLESS + rcall ZEROSENSE + breq QNEGATE1 + rcall NEGATE +QNEGATE1: + ret + + fdw QNEGATE_L +MAX_L: + .db NFA|3,"max" +MAX: rcall TWODUP + rcall LESS + rjmp MINMAX + + fdw MAX_L +MIN_L: + .db NFA|3,"min" +MIN: rcall TWODUP + rcall GREATER + rjmp MINMAX + + .db NFA|2,"c@",0 +CFETCH_A: + jmp CFETCH + + .db NFA|2,"c!",0 +CSTORE_A: + jmp CSTORE + + fdw MIN_L +UPTR_L: + .db NFA|2,"up",0 +UPTR: rcall DOCREATE + .dw 2 ; upl + + fdw UPTR_L +HOLD_L: + .db NFA|4,"hold",0 +HOLD: rcall TRUE_ + rcall HP + rcall PLUSSTORE + rcall HP + rcall FETCH_A + jmp CSTORE + +; <# -- begin numeric conversion +; PAD HP ! ; (initialize Hold Pointer) + fdw HOLD_L +LESSNUM_L: + .db NFA|2,"<#",0 +LESSNUM: + rcall PAD + rcall HP + jmp STORE + +; digit n -- c convert to 0..9a..z + fdw LESSNUM_L +TODIGIT_L: + .db NFA|5,"digit" +TODIGIT: + cpi tosl, 0xa + brlt TODIGIT1 + adiw tosl, 0x27 +TODIGIT1: + adiw tosl, 0x30 + ret + +; # ud1 -- ud2 convert 1 digit of output +; base @ ud/mod rot >digit hold ; + fdw TODIGIT_L +NUM_L: + .db NFA|1,"#" +NUM: + rcall BASE + rcall FETCH_A + rcall UDSLASHMOD + rcall ROT + rcall TODIGIT + jmp HOLD + +; #S ud1 -- ud2 convert remaining digits +; begin # 2dup or 0= until ; + fdw NUM_L +NUMS_L: + .db NFA|2,"#s",0 +NUMS: + rcall NUM + rcall TWODUP + rcall OR_ + rcall ZEROSENSE + brne NUMS + ret + +; #> ud1 -- c-addr u end conv., get string +; 2drop hp @ pad over - ; + fdw NUMS_L +NUMGREATER_L: + .db NFA|2,"#>", 0 +NUMGREATER: + rcall TWODROP + rcall HP + rcall FETCH_A + rcall PAD + rcall OVER + jmp MINUS + +; SIGN n -- add minus sign if n<0 +; 0< IF 2D HOLD THEN ; + fdw NUMGREATER_L +SIGN_L: + .db NFA|4,"sign",0 +SIGN: + cpi tosh, 0 + brpl SIGN1 + rcall DOLIT + .dw 0x2D + rcall HOLD +SIGN1: + jmp DROP + +; U. u -- display u unsigned +; <# 0 #S #> TYPE SPACE ; + fdw SIGN_L +UDOT_L: + .db NFA|2,"u.",0 +UDOT: + rcall LESSNUM + rcall FALSE_ + rcall NUMS + rcall NUMGREATER + rcall TYPE + jmp SPACE_ + + +; U.R u +n -- display u unsigned in field of n. 1 type space ; + fdw UDOT_L +UDOTR_L: + .db NFA|3,"u.r" +UDOTR: + rcall LESSNUM + rcall ONEMINUS + rcall TOR + rcall FALSE_ + rjmp UDOTR2 +UDOTR1: + rcall NUM +UDOTR2: + rcall XNEXT + brcc UDOTR1 + pop t1 + pop t0 + rcall NUMS + rcall NUMGREATER + rcall TYPE + jmp SPACE_ + +; . n -- display n signed +; <# DUP ABS #S SWAP SIGN #> TYPE SPACE ; + fdw UDOTR_L +DOT_L: + .db NFA|1,"." +DOT: rcall LESSNUM + rcall DUP + rcall ABS_ + rcall FALSE_ + rcall NUMS + rcall ROT + rcall SIGN + rcall NUMGREATER + rcall TYPE + jmp SPACE_ + + FDW DOT_L +DECIMAL_L: + .db NFA|7,"decimal" +DECIMAL: + rcall TEN + rcall BASE + jmp STORE + +; HEX -- set number base to hex +; #16 BASE ! ; + Fdw DECIMAL_l +HEX_L: + .db NFA|3,"hex" +HEX: + rcall DOLIT + .dw 16 + rcall BASE + jmp STORE + +; BIN -- set number base to binary +; #2 BASE ! ; + Fdw HEX_L +BIN_L: + .db NFA|3,"bin" +BIN: rcall CELL + rcall BASE + jmp STORE + +; RSAVE -- a-addr Saved return stack pointer + fdw BIN_L +RSAVE_L: + .db NFA|5,"rsave" +RSAVE_: rcall DOUSER + .dw ursave + + +; ULINK -- a-addr link to next task + fdw RSAVE_L +ULINK_L: + .db NFA|5,"ulink" +ULINK_: rcall DOUSER + .dw ulink + + +; TASK -- a-addr TASK pointer + fdw ULINK_L +TASK_L: + .db NFA|4,"task",0 +TASK: rcall DOUSER + .dw utask + + +; HP -- a-addr HOLD pointer + fdw TASK_L +HP_L: + .db NFA|2,"hp",0 +HP: rcall DOUSER + .dw uhp + +; PAD -- a-addr User Pad buffer + fdw HP_L +PAD_L: + .db NFA|3,"pad" +PAD: + rcall TIB + rcall TIBSIZE + jmp PLUS + +; BASE -- a-addr holds conversion radix + fdw PAD_L +BASE_L: + .db NFA|4,"base",0 +BASE: + rcall DOUSER + .dw ubase + +; USER n -- + fdw BASE_L +USER_L: + .db NFA|4,"user",0 +USER: + rcall CREATE + rcall CELL + rcall NEGATE + rcall IALLOT + rcall ICOMMA_ + rcall XDOES +DOUSER: + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + add tosl, upl + adc tosh, uph + ret + +; SOURCE -- adr n current input buffer +; 'SOURCE 2@ ; length is at higher adrs + fdw USER_L +SOURCE_L: + .db NFA|6,"source",0 +SOURCE: + rcall TICKSOURCE + jmp TWOFETCH + + +; /STRING a u n -- a+n u-n trim string +; swap over - >r + r> + fdw SOURCE_L +SLASHSTRING_L: + .db NFA|7,"/string" +SLASHSTRING: + rcall SWOP + rcall OVER + rcall MINUS + rcall TOR + rcall PLUS + rcall RFROM + ret + +; \ Skip the rest of the line + fdw SLASHSTRING_L +BSLASH_L: + .db NFA|IMMED|1,0x5c +BSLASH: + rcall SOURCE + rcall TOIN + rcall STORE_A + sbr FLAGS1, (1<C nfa -- cfa name adr -> code field + fdw FETCHPP_L +NTOC_L: + .db NFA|3,"n>c" +NFATOCFA: + rcall CFETCHPP + andi tosl, 0x0f + rcall PLUS + jmp ALIGNED + +; C>N cfa -- nfa code field addr -> name field addr + fdw NTOC_L +CTON_L: + .db NFA|3,"c>n" +CFATONFA: + rcall TWOMINUS + rcall DUP + rcall CFETCH_A + call TO_A + sbrs al, 7 + breq CFATONFA + ret + +; findi c-addr nfa -- c-addr 0 if not found +; xt 1 if immediate +; xt -1 if "normal" + fdw CTON_L +BRACFIND_L: + .db NFA|3,"(f)" +findi: +findi1: +FIND_1: + rcall TWODUP + rcall NEQUAL + rcall DUPZEROSENSE + breq findi2 + rcall DROP + rcall TWOMINUS ;;; NFATOLFA + rcall FETCH_A + rcall DUP +findi2: + rcall ZEROSENSE + brne findi1 + rcall DUPZEROSENSE + breq findi3 + rcall NIP + rcall DUP + rcall NFATOCFA + rcall SWOP + rcall IMMEDQ + rcall ZEROEQUAL + rcall ONE + rcall OR_ +findi3: + ret + +; IMMED? nfa -- f fetch immediate flag + fdw BRACFIND_L +IMMEDQ_L: + .db NFA|6,"immed?",0 +IMMEDQ: + rcall CFETCH_A + mov wflags, tosl ; COMPILE and INLINE flags for the compiler + andi tosl, IMMED + ret + +; FIND c-addr -- c-addr 0 if not found +; xt 1 if immediate +; xt -1 if "normal" + fdw IMMEDQ_L +FIND_L: + .db NFA|4,"find",0 +FIND: + rcall DOLIT + fdw kernellink + rcall findi + rcall DUPZEROSENSE + brne FIND1 + rcall DROP + rcall LATEST_ + rcall FETCH_A + rcall findi +FIND1: + ret + +; DIGIT? c -- n -1 if c is a valid digit + fdw FIND_L +DIGITQ_L: + .db NFA|6,"digit?",0 +DIGITQ: + ; 1 = 0x31 a = 0x61 + cpi tosl, 0x40 + brlt DIGITQ1 + sbiw tosl, 0x27 +DIGITQ1: + sbiw tosl, 0x30 ; 1 + brpl DIGITQ2 + rjmp FALSE_ +DIGITQ2: + rcall DUP ; 1 1 + rcall BASE ; 1 1 base + rcall FETCH_A ; 1 1 10 + jmp LESS ; 1 ffff + + +; SIGN? adr n -- adr' n' f get optional sign +; + leaves $0000 flag +; - leaves $0002 flag + fdw DIGITQ_L +SIGNQ_L: + .db NFA|5,"sign?" +SIGNQ: + rcall OVER + rcall CFETCH_A + mov t0, tosl + rcall DROP + cpi t0, '-' + breq SIGNQMINUS + cpi t0, '+' + breq SIGNQPLUS + rjmp SIGNQEND +SIGNQMINUS: + rcall SLASHONE + rjmp TRUE_ +SIGNQPLUS: + rcall SLASHONE +SIGNQEND: + jmp FALSE_ +SLASHONE: + rcall ONE + jmp SLASHSTRING + +; UD* ud u -- ud + fdw SIGNQ_L +UDSTAR_L: + .db NFA|3,"ud*" +UDSTAR: + push tosl + push tosh + rcall UMSTAR + rcall DROP + rcall SWOP + rcall RFROM + rcall UMSTAR + rcall ROT + jmp PLUS + +; UD/MOD ud u --u(rem) ud(quot) + fdw UDSTAR_L +UDSLASHMOD_L: + .db NFA|6,"ud/mod",0 +UDSLASHMOD: + rcall TOR ; ud.l ud.h + rcall FALSE_ ; ud.l ud.h 0 + rcall RFETCH ; ud.l ud.h 0 u + rcall UMSLASHMOD ; ud.l r.h q.h + rcall ROT ; r.h q.h ud.l + rcall ROT ; q.h ud.l r.h + rcall RFROM ; q.h ud.l r.h u + rcall UMSLASHMOD ; q.h r.l q.l + jmp ROT ; r.l q.l q.h + +; >NUMBER 0 0 adr u -- ud.l ud.h adr' u' +; convert string to number + fdw UDSLASHMOD_L +TONUMBER_L: + .db NFA|7,">number" +TONUMBER: + ldi al, 1 +TONUM1: + rcall DUPZEROSENSE ; ud.l ud.h adr u + breq TONUM3 + rcall TOR + push tosl ; dup >r + push tosh ; ud.l ud.h adr + rcall CFETCH_A + cpi tosl, '.' + breq TONUM_SKIP + rcall DIGITQ ; ud.l ud.h digit flag + rcall ZEROSENSE + brne TONUM2 + rcall DROP + rcall RFROM + rcall RFROM + rjmp TONUM3 +TONUM2: + rcall TOR ; ud.l ud.h digit + rcall BASE + rcall FETCH_A + rcall UDSTAR + rcall RFROM + rcall MPLUS + ldi al, 0 + rjmp TONUM_CONT +TONUM_SKIP: + rcall DROP +TONUM_CONT: + rcall RFROM + rcall RFROM + rcall SLASHONE + rjmp TONUM1 +TONUM3: + add tosl, al + ret + +; NUMBER? c-addr -- n 1 +; -- dl dh 2 +; -- c-addr 0 if convert error + fdw TONUMBER_L +NUMBERQ_L: + .db NFA|7,"number?" +NUMBERQ: + rcall DUP ; a a + rcall FALSE_ ; a a 0 0 + rcall FALSE_ ; a a 0 0 + rcall ROT ; a 0 0 a + rcall CFETCHPP ; a 0 0 a' u + rcall SIGNQ ; a 0 0 a' u f + rcall TOR ; a 0 0 a' u + + rcall BASE + rcall FETCH_A + rcall TOR ; a 0 0 a' u + + rcall OVER + rcall CFETCH_A + + sbiw tosl, '#' + cpi tosl, 3 + brsh BASEQ1 + + rcall CELLS + rcall DOLIT + fdw BASEQV + rcall PLUS + rcall FEXECUTE + + rcall SLASHONE + rjmp BASEQ2 +BASEQ1: + rcall DROP +BASEQ2: ; a 0 0 a' u + rcall TONUMBER ; a ud.l ud.h a' u + rcall RFROM ; a ud.l ud.h a' u oldbase + rcall BASE ; a ud.l ud.h a' u oldbase addr + rcall STORE_A ; a ud.l ud.h a' u + rcall ZEROSENSE ; a ud.l ud.h a' u + breq QNUMD +QNUM_ERR: ; Not a number + rcall RFROM ; a ud.l ud.h a' u sign + rcall TWODROP + rcall TWODROP + rcall FALSE_ ; a 0 Not a number + rjmp QNUM3 +QNUMD: ; Single or Double number + ; a ud.l ud.h a' + sbiw tosl, 1 + rcall CFETCH_A ; a ud.l ud.h c + call TO_A + rcall RFROM ; a a' u ud.l ud.d sign + rcall ZEROSENSE + breq QNUMD1 + rcall DNEGATE +QNUMD1: + cpi al, '.' ; a d.l d.h + brne QNUM1 + rcall ROT ; d.l d.h a + ldi tosl, 2 + ldi tosh, 0 ; d.l d.h 2 Double number + rjmp QNUM3 +QNUM1: ; single precision dumber + ; a d.l d.h + rcall DROP ; a n + rcall NIP ; n + rcall ONE ; n 1 Single number +QNUM3: + ret + + + .db NFA|4,"swap",0 +SWOP_A: + jmp SWOP + +; TI# -- n size of TIB +; : ti# task @ 8 + @ ; + fdw NUMBERQ_L +TIBSIZE_L: + .db NFA|3,"ti#" +TIBSIZE: + rcall TASK + rcall FETCH_A + adiw tosl, 8 + jmp FETCH + +; TIB -- a-addr Terminal Input Buffer + fdw TIBSIZE_L +TIB_L: + .db NFA|3,"tib" +TIB: + rcall TIU + jmp FETCH + +; TIU -- a-addr Terminal Input Buffer user variable + fdw TIB_L +TIU_L: + .db NFA|3,"tiu" +TIU: + rcall DOUSER + .dw utib ; pointer to Terminal input buffer + +; >IN -- a-addr holds offset into TIB +; In RAM + fdw TIU_L +TOIN_L: + .db NFA|3,">in" +TOIN: + rcall DOUSER + .dw utoin + +; 'SOURCE -- a-addr two cells: len, adrs +; In RAM ? + fdw TOIN_L +TICKSOURCE_L: + .db NFA|7,"'source" +TICKSOURCE: + rcall DOUSER + .dw usource ; two cells !!!!!! + +WORDQ: + rcall DUP + m_pop_t0 + pop zh + pop zl + rcall FETCHLIT + ror zh + ror zl + rcall EQUAL + rcall ZEROSENSE + mijmp + +; INTERPRET c-addr u -- interpret given buffer + fdw TICKSOURCE_L +INTERPRET_L: + .db NFA|9,"interpret" +INTERPRET: + rcall TICKSOURCE + rcall TWOSTORE + rcall FALSE_ + rcall TOIN + rcall STORE_A +IPARSEWORD: + rcall INIT_012 + rcall BL + rcall WORD + + rcall DUP + rcall CFETCH_A + rcall ZEROSENSE + brne IPARSEWORD1 + rjmp INOWORD +IPARSEWORD1: + rcall FIND ; sets also wflags + rcall DUPZEROSENSE ; 0 = not found, -1 = normal, 1 = immediate + brne IPARSEWORD2 ; NUMBER? + rjmp INUMBER +IPARSEWORD2: + rcall ONEPLUS ; 0 = normal 2 = immediate + rcall STATE_ + rcall ZEROEQUAL + rcall OR_ + rcall ZEROSENSE + breq ICOMPILE_1 ; Compile a word + + ; Execute a word + ; immediate&compiling or interpreting + sbrs wflags, 4 ; Compile only check + rjmp IEXECUTE ; Not a compile only word + rcall STATE_ ; Compile only word check + rcall XSQUOTE + .db 12,"COMPILE ONLY",0 + rcall QABORT +IEXECUTE: + cbr FLAGS1, (1< type +;;; <# [char] > hold cse @ #s #> type base ! ; + fdw INLINED_L +DOTSTATUS_L: + .db NFA|3,".st" +DOTSTATUS: + rcall DOLIT + .dw '<' + rcall EMIT + call DOTBASE + rcall EMIT + rcall DOLIT + .dw ',' + rcall EMIT + call MEMQ + rcall TYPE + rcall DOLIT + .dw '>' + rcall EMIT + jmp DOTS + + .db NFA|2,">r",0 +TOR_A: jmp TOR + + +;;; TEN ( -- n ) Leave decimal 10 on the stack +; .db NFA|1,"a" +TEN: + rcall DOCREATE + .dw 10 + +; dp> ( -- ) Copy ini, dps and latest from eeprom to ram +; .dw link +; link set $ + .db NFA|3,"dp>" +DP_TO_RAM: + rcall DOLIT + .dw dp_start + rcall INI + rcall TEN + jmp CMOVE + +; >dp ( -- ) Copy only changed turnkey, dp's and latest from ram to eeprom +; .dw link +; link set $ + .db NFA|3,">dp" +DP_TO_EEPROM: + rcall DOLIT + .dw dp_start + rcall STORE_P_TO_R + rcall INI + rcall DOLIT + .dw 4 + rcall TOR +DP_TO_EEPROM_0: + rcall FETCHPP + rcall DUP + rcall PFETCH + rcall NOTEQUAL + rcall ZEROSENSE + breq DP_TO_EEPROM_1 +.if DEBUG_FLASH == 1 + rcall DOLIT + .dw 'E' + call EMIT +.endif + rcall PSTORE + rjmp DP_TO_EEPROM_2 +DP_TO_EEPROM_1: + rcall DROP +DP_TO_EEPROM_2: + rcall PTWOPLUS +DP_TO_EEPROM_3: + rcall XNEXT + brcc DP_TO_EEPROM_0 + pop t1 + pop t0 + rcall R_TO_P + jmp DROP + + fdw DOTSTATUS_L +FALSE_L: + .db NFA|5,"false" +FALSE_: ; TOS is 0000 (FALSE) + pushtos + clr tosl + clr tosh + ret + + fdw FALSE_L +TRUE_L: + .db NFA|4,"true",0 +TRUE_: ; TOS is ffff (TRUE) + pushtos + ser tosl + ser tosh + ret + +; QUIT -- R: i*x -- interpret from kbd + fdw TRUE_L +QUIT_L: + .db NFA|4,"quit",0 +QUIT: + rcall RPEMPTY + rcall LEFTBRACKET + rcall FRAM +QUIT0: + ;; Copy INI and DP's from eeprom to ram + rcall DP_TO_RAM +QUIT1: + rcall check_sp + rcall CR + rcall TIB + rcall DUP + rcall TIBSIZE + sbiw tosl, 10 ; Reserve 10 bytes for hold buffer + rcall ACCEPT + rcall SPACE_ + rcall INTERPRET + rcall STATE_ + rcall ZEROSENSE + brne QUIT1 + rcall IFLUSH + rcall DP_TO_EEPROM + + rcall XSQUOTE + .db 3," ok" + rcall TYPE + rcall PROMPT_ + jmp QUIT0 + + + fdw QUIT_L +PROMPT_L: + .db NFA|6,"prompt",0 +PROMPT_: + call DEFER_DOES + .dw prompt + +; ABORT i*x -- R: j*x -- clear stk & QUIT + fdw PROMPT_L +ABORT_L: + .db NFA|5,"abort" +ABORT: + rcall S0 + rcall FETCH_A + rcall SPSTORE + jmp QUIT ; QUIT never rets + +; ?ABORT f -- abort & print ? + fdw ABORT_L +QABORTQ_L: + .db NFA|7,"?abort?" +QABORTQ: + rcall XSQUOTE + .db 1,"?" + jmp QABORT + + +; ?ABORT f c-addr u -- abort & print msg if flag is false + fdw QABORTQ_L +QABORT_L: + .db NFA|6,"?abort",0 +QABORT: + rcall ROT + rcall ZEROSENSE + brne QABO1 +QABORT1: + rcall SPACE_ + rcall TYPE + rcall ABORT ; ABORT never returns +QABO1: jmp TWODROP + +; ABORT" i*x 0 -- i*x R: j*x -- j*x x1=0 +; i*x x1 -- R: j*x -- x1<>0 + fdw QABORT_L +ABORTQUOTE_L: + .db NFA|IMMED|COMPILE|6,"abort",0x22,0 +ABORTQUOTE: + rcall SQUOTE + rcall DOCOMMAXT + fdw QABORT + ret + +;*************************************************** +; LIT -- x fetch inline 16 bit literal to the stack + fdw ABORTQUOTE_L +DOLIT_L: + .db NFA|3, "lit" +DOLIT: + m_pop_zh + pop zh + pop zl + rcall FETCHLIT + ror zh + ror zl + mijmp ; (z) + +; DUP must not be reachable from user code with rcall + fdw RFETCH_L +DUP_L: + .db NFA|INLINE|3, "dup" +DUP: + pushtos + ret + + fdw NOTEQUAL_L +ZEROEQUAL_L: + .db NFA|2, "0=",0 +ZEROEQUAL: + sbiw tosl, 1 + sbc tosl, tosl + sbc tosh, tosh + ret + + fdw ZEROEQUAL_L +ZEROLESS_L: + .db NFA|2, "0<",0 +ZEROLESS: + lsl tosh + sbc tosl, tosl + sbc tosh, tosh + ret + + +; ' -- xt find word in dictionary + fdw DOLIT_L +TICK_L: + .db NFA|1,0x27 ; 27h = ' +TICK: + rcall BL + rcall WORD + rcall FIND + jmp QABORTQ + +; CHAR -- char parse ASCII character + fdw TICK_L +CHAR_L: + .db NFA|4,"char",0 +CHAR: + rcall BL + rcall PARSE + rcall DROP + jmp CFETCH + +; ( -- skip input until ) + fdw CHAR_L +PAREN_L: + .db NFA|IMMED|1,"(" +PAREN: + rcall DOLIT + .dw ')' + rcall PARSE + sbr FLAGS1, (1< swap cells + ; +; ram table table_a flash table table_b eeprom table table_c +; ram variable qqq +; eeprom variable www ram +; flash variable rrr ram +; eeprom create calibrationtable 30 allot ram +; + fdw CR_L +CREATE_L: + .db NFA|6,"create",0 +CREATE: + rcall BL + rcall WORD ; Parse a word + + rcall DUP ; Remember parsed word at rhere + rcall FIND + rcall NIP + rcall ZEROEQUAL + rcall XSQUOTE + .db 15,"ALREADY DEFINED" + rcall QABORT ; ABORT if word has already been defined + rcall DUP ; Check the word length + rcall CFETCH_A + rcall ONE + rcall DOLIT + .dw 16 + rcall WITHIN + rcall QABORTQ ; Abort if there is no name for create + + rcall IHERE + rcall ALIGNED + rcall IDP ; Align the flash DP. + rcall STORE_A + + rcall LATEST_ + rcall FETCH_A + rcall ICOMMA_ ; Link field + rcall CFETCHPP ; str len + rcall IHERE + rcall DUP + rcall LATEST_ ; new 'latest' link + rcall STORE_A ; str len ihere + rcall PLACE ; + rcall IHERE ; ihere + rcall CFETCH_A + rcall DOLIT + .dw NFA + rcall SHB + rcall ONEPLUS + rcall ALIGNED + rcall IALLOT ; The header has now been created + rcall DOLIT + fdw DOCREATE ; compiles the runtime routine to fetch the next dictionary cell to the parameter stack + rcall STORECFF1 ; Append an exeution token, CALL ! + rcall ALIGN + rcall HERE ; compiles the current dataspace dp into the dictionary + rcall CSE_ + rcall ZEROSENSE + brne CREATE2 + rcall TWOPLUS +CREATE2: + jmp ICOMMA ; dp now points to a free cell + +;*************************************************************** +; POSTPONE + fdw CREATE_L +POSTPONE_L: + .db NFA|IMMED|COMPILE|8,"postpone",0 +POSTPONE: + rcall BL + rcall WORD + rcall FIND + rcall DUP + rcall QABORTQ + rcall ZEROLESS + rcall ZEROSENSE + breq POSTPONE1 + rcall DOCOMMAXT + fdw DOCOMMAXT + rjmp ICOMMA_ +POSTPONE1: + jmp COMMAXT + + +IDP_L: + .db NFA|3,"idp" +IDP: + rcall DOCREATE + .dw dpFLASH + +;*************************************************************** +; (DOES>) -- run-time action of DOES> +; .dw link +;link set $ + .db NFA|7,"(does>)" +XDOES: + m_pop_zh + rcall RFROM + rcall LATEST_ + rcall FETCH_A + rcall NFATOCFA + rcall IDP + rcall FETCH_A + rcall TOR_A + rcall IDP + rcall STORE_A + lsl tosl + rol tosh + rcall STORECFF1 ; Always stores a 4 byte call + rcall RFROM + rcall IDP + jmp STORE + + +; DOES> -- change action of latest def'n + fdw POSTPONE_L +DOES_L: + .db NFA|IMMED|COMPILE|5,"does>" +DOES: rcall DOCOMMAXT + fdw XDOES + rcall DOCOMMAXT + fdw DODOES + ret + + +;***************************************************************** +; [ -- enter interpretive state + fdw DOES_L +LEFTBRACKET_L: + .db NFA|IMMED|1,"[" +LEFTBRACKET: + sts state, r_zero + ret + + +; ] -- enter compiling state + fdw LEFTBRACKET_L +RIGHTBRACKET_L: + .db NFA|1,"]" +RIGHTBRACKET: + sts state, r_one + ret + +; : -- begin a colon definition + fdw RIGHTBRACKET_L +COLON_L: + .db NFA|1,":" +COLON: + rcall CREATE + rcall RIGHTBRACKET + jmp STORCOLON + +; :noname -- a define headerless forth code + fdw COLON_L +NONAME_L: + .db NFA|7,":noname" +NONAME: + rcall IHERE + jmp RIGHTBRACKET + +; ; -- end a colon definition + fdw NONAME_L +SEMICOLON_L: + .db NFA|IMMED|COMPILE|1,";" +SEMICOLON: + rcall LEFTBRACKET + sbrc FLAGS1, fTAILC + rjmp ADD_RETURN_1 + rcall IHERE + rcall MINUS_FETCH + movw t0, tosl + andi t1, 0xf0 + subi t1, 0xd0 + breq RCALL_TO_JMP + poptos + rcall MINUS_FETCH +.ifdef EIND + subi tosl, 0x0f +.else + subi tosl, 0x0e +.endif + sbci tosh, 0x94 + brne ADD_RETURN +CALL_TO_JMP: +.ifdef EIND + ldi tosl, 0x0d +.else + ldi tosl, 0x0c +.endif + ldi tosh, 0x94 + rcall SWOP + jmp STORE +RCALL_TO_JMP: + rcall NIP + andi tosh, 0x0f + sbrc tosh, 3 + ori tosh, 0xf0 + rcall TWOSTAR + rcall IHERE + rcall PLUS + rcall DOLIT + .dw -2 + rcall IALLOT + rcall DOLIT +.ifdef EIND + .dw 0x940d +.else + .dw 0x940c ; jmp:0x940c +.endif + rcall ICOMMA__ + sub_pflash_tos + rampv_to_c + ror tosh + ror tosl + rjmp ICOMMA__ +ADD_RETURN: + rcall TWODROP +ADD_RETURN_1: + rcall DOLIT ; Compile a ret + .dw 0x9508 +ICOMMA__: + jmp ICOMMA + + + + fdw SEMICOLON_L +MINUS_FETCH_L: + .db NFA|2,"-@",0 +MINUS_FETCH: + rcall TWOMINUS + rcall DUP + jmp FETCH + +; ['] -- find word & compile as DOLITeral + fdw MINUS_FETCH_L +BRACTICK_L: + .db NFA|IMMED|COMPILE|3,"[']" +BRACTICK: + rcall TICK ; get xt of 'xxx' + jmp LITERAL + +; 2- n -- n-2 + fdw BRACTICK_L +TWOMINUS_L: + .db NFA|INLINE|2,"2-",0 +TWOMINUS: + sbiw tosl, 2 + ret + + +; BL -- char an ASCII space + fdw TWOMINUS_L +BL_l: + .db NFA|2,"bl",0 +BL: + call DOCREATE + .dw ' ' + +; STATE -- flag holds compiler state + fdw BL_L +STATE_L: + .db NFA|5,"state" +STATE_: + pushtos + lds tosl, state + lds tosh, state + ret + +; LATEST -- a-addr + fdw STATE_L +LATEST_L: + .db NFA|6,"latest",0 +LATEST_: + call DOCREATE + .dw dpLATEST + +; S0 -- a-addr start of parameter stack + fdw LATEST_L +S0_L: + .db NFA|2,"s0",0 +S0: + rcall DOUSER + .dw us0 + +; R0 -- a-addr start of parameter stack + fdw S0_L +R0_L: + .db NFA|2,"r0",0 +R0_: + rcall DOUSER + .dw ur0 + +; ini -- a-addr ini variable contains the user-start xt +; In RAM +; .dw link +;link set $ + .db NFA|3,"ini" +INI: + call DOCREATE + .dw dpSTART + +; ticks -- u system ticks (0-ffff) in milliseconds + fdw R0_L +TICKS_L: + .db NFA|5,"ticks" +TICKS: + pushtos + in_ t0, SREG + cli + mov tosl, ms_count + mov tosh, ms_count1 + out_ SREG, t0 + ret + + +; ms +n -- Pause for n millisconds +; : ms ( +n -- ) +; ticks - +; begin +; pause dup ticks - 0< +; until drop ; +; + fdw TICKS_L +MS_L: + .db NFA|2,"ms",0 +MS: + rcall TICKS + rcall PLUS +MS1: + rcall PAUSE + rcall DUP + rcall TICKS + rcall MINUS + rcall ZEROLESS + rcall ZEROSENSE + breq MS1 + jmp DROP + +; .id ( nfa -- ) + fdw MS_L +DOTID_L: + .db NFA|3,".id" +DOTID: + rcall CFETCHPP + andi tosl, 0x0f + rcall TOR + rjmp DOTID3 +DOTID1: + rcall CFETCHPP + rcall TO_PRINTABLE + rcall EMIT_A +DOTID3: + rcall XNEXT + brcc DOTID1 + pop t1 + pop t0 + jmp DROP + + ; >pr c -- c Filter a character to printable 7-bit ASCII + fdw DOTID_L +TO_PRINTABLE_L: + .db NFA|3,">pr" +TO_PRINTABLE: + clr tosh + cpi tosl, 0 + brmi TO_PRINTABLE1 + cpi tosl, 0x20 + brpl TO_PRINTABLE2 +TO_PRINTABLE1: + ldi tosl, '.' +TO_PRINTABLE2: + ret + +;;;;;;;;;;;;;; +LIKEQ: + rcall CFETCHPP + rcall DOLIT + .dw 0x0f + rcall AND_ + rcall SWOP + rcall STORE_P + rcall SWOP + rcall CFETCHPP + rcall ROT + rcall OVER + rcall MINUS + rcall ONEPLUS + rcall FALSE_ + rcall MAX + rcall TOR + rjmp LIKEQ3 +LIKEQ1: + rcall TWODUP + rcall FETCH_P + rcall PPLUS + rcall SWOP + call CMP + breq LIKEQ3 +TWODROPNZ: + clz + rjmp LIKEQ4 +LIKEQ3: + rcall XNEXT + brcc LIKEQ1 +TWODROPZ: + sez +LIKEQ4: + pop t1 + pop t0 + rjmp TWODROP__ + +;;;;;;;;;;;;;;;;;;;; +LIKES: + rcall TWODUP + rcall LIKEQ + breq LIKES1 + rcall DUP + rcall DOTID + rcall SPACE_ +LIKES1: + rcall TWOMINUS + rcall FETCH_A + rcall DUPZEROSENSE + brne LIKES +TWODROP__: + jmp TWODROP + + ; WORDS -- filter + fdw TO_PRINTABLE_L +WORDS_L: + .db NFA|5,"words" + rcall BL + rcall WORD + rcall DUP + rcall DOLIT + fdw kernellink + rcall WDS1 + rcall LATEST_ + rcall FETCH_A +WDS1: rcall CR + jmp LIKES + +; .S -- print stack contents +; : .s space sp@ s0 @ 2- begin 2dup < while -@ u. repeat 2drop ; + fdw WORDS_L +DOTS_L: + .db NFA|2,".s",0 +DOTS: + rcall SPACE_ + rcall DUP + call SPFETCH + rcall S0 + rcall FETCH_A + rcall TWOMINUS +DOTS1: + rcall TWODUP + rcall LESS + rcall ZEROSENSE + breq DOTS2 + rcall MINUS_FETCH + rcall UDOT + rjmp DOTS1 +DOTS2: + rcall DROP + jmp TWODROP + +; DUMP ADDR U -- DISPLAY MEMORY + fdw DOTS_L +DUMP_L: + .db NFA|4,"dump",0 +DUMP: + rcall DOLIT + .dw 16 + rcall USLASH + rcall TOR + rjmp DUMP7 +DUMP1: + rcall CR + rcall DUP + rcall DOLIT + .dw 4 + rcall UDOTR + rcall DOLIT + .dw ':' + rcall EMIT_A + rcall DOLIT + .dw 15 + rcall TOR +DUMP2: + rcall CFETCHPP + rcall DOLIT + .dw 2 + rcall UDOTR + rcall XNEXT + brcc DUMP2 + pop t1 + pop t0 + + rcall DOLIT + .dw 16 + rcall MINUS + rcall DOLIT + .dw 15 + rcall TOR +DUMP4: + rcall CFETCHPP + rcall TO_PRINTABLE + rcall EMIT_A + rcall XNEXT + brcc DUMP4 + pop t1 + pop t0 +DUMP7: + rcall XNEXT + brcc DUMP1 + pop t1 + pop t0 + jmp DROP + +; IALLOT n -- allocate n bytes in ROM +; .dw link +;link set $ + .db NFA|1," " +IALLOT: + rcall IDP + jmp PLUSSTORE + + +;*************************************************************** +; Store the execcution vector addr to the return stack +; leave the updated return stack pointer on the data stack +; x>r ( addr rsp -- rsp' ) + fdw DUMP_L +X_TO_R_L: + .db NFA|3,"x>r" +X_TO_R: + movw zl, tosl + poptos + rcall TO_XA + adiw zl, 1 + st -z, tosl + st -z, tosh +.ifdef EIND + st -z, r_one +.endif + st -z, r_zero + movw tosl, zl + ret +;*************************************************************** + fdw X_TO_R_L +TO_XA_L: + .db NFA|3,">xa" +TO_XA: + sub_pflash_tos + rampv_to_c + ror tosh + ror tosl + ret + + fdw TO_XA_L +XA_FROM_L: + .db NFA|3,"xa>" +XA_FROM: + lsl tosl + rol tosh + add_pflash_tos + ret +;*************************************************************** + fdw XA_FROM_L +PFL_L: + .db NFA|3,"pfl" +PFL: + call DOCREATE + .dw OFLASH +;*************************************************************** + fdw PFL_L +ZFL_L: + .db NFA|3, "zfl" +ZFL: + call DOCREATE + .dw RAMPZV +;*************************************************************** +; ,?0= -- addr Compile ?0= and make make place for a branch instruction + .db NFA|4, ",?0=",0 ; Just for see to work ! +COMMAZEROSENSE: + sbrc FLAGS1, idup + rjmp COMMAZEROSENSE1 + rcall DOLIT + fdw ZEROSENSE + rjmp COMMAZEROSENSE2 +COMMAZEROSENSE1: + rcall IDPMINUS + rcall DOLIT + fdw DUPZEROSENSE +COMMAZEROSENSE2: + cbr FLAGS1, (1< while i, repeat 2drop ; + fdw INLINE_L +INLINEC_L: + .db NFA|3,"in," +INLINE0: + rcall FETCHPP + rcall DUP + rcall DOLIT + .dw 0x9508 + rcall NOTEQUAL + rcall ZEROSENSE + breq INLINE1 + rcall ICOMMA + rjmp INLINE0 +INLINE1: + jmp TWODROP + +; FOR -- bc-addr bra-addr + fdw INLINEC_L +FOR_L: + .db NFA|IMMED|COMPILE|3,"for" +FOR: + call DOCOMMAXT + fdw TOR + rcall IHERE + rcall FALSE_ + rcall RJMPC + rcall IHERE + jmp SWOP + +; NEXT bra-addr bc-addr -- + fdw FOR_L +NEXT_L: + .db NFA|IMMED|COMPILE|4,"next", 0 +NEXT: + rcall THEN_ + call DOCOMMAXT + fdw XNEXT + rcall BRCCC + + rcall AGAIN_ + + rcall DOLIT + fdw XNEXT1 + jmp INLINE0 +; (next) decrement top of return stack + .db NFA|7,"(next) " +XNEXT: + m_pop_zh + pop zh + pop zl + pop xh + pop xl + sbiw xl, 1 + push xl + push xh + mijmp + ret +XNEXT1: + pop t1 + pop t0 + ret + +; leave clear top of return stack + fdw NEXT_L +LEAVE_L: + .db NFA|COMPILE|5,"endit" +LEAVE: + m_pop_zh + pop zh + pop zl + pop t1 + pop t0 + push r_zero + push r_zero + mijmp +;*************************************************** +; RDROP compile a pop + fdw LEAVE_L +RDROP_L: + .db NFA|IMMED|COMPILE|5,"rdrop" +RDROP: + rcall DOLIT + fdw XNEXT1 + jmp INLINE0 +;*************************************************** + fdw RDROP_L +STOD_L: + .db NFA|3,"s>d" +STOD: + sbrs tosh, 7 + rjmp FALSE_ + rjmp TRUE_ +;*************************************************** + fdw STOD_L +DNEGATE_L: + .db NFA|7,"dnegate" +DNEGATE: + rcall DINVERT + call ONE + jmp MPLUS +;*************************************************** + fdw DNEGATE_L +QDNEGATE_L: + .db NFA|8,"?dnegate",0 +QDNEGATE: + rcall ZEROLESS + rcall ZEROSENSE + breq QDNEGATE1 + rcall DNEGATE +QDNEGATE1: + ret + +;*************************************************** + fdw QDNEGATE_L +DABS_L: + .db NFA|4,"dabs",0 +DABS: + rcall DUP + jmp QDNEGATE +;*************************************************** + fdw DABS_L +DPLUS_L: + .db NFA|2,"d+",0 +DPLUS: + ld xl, Y+ + ld xh, Y+ + ld t6, Y+ + ld t7, Y+ + ld t0, Y+ + ld t1, Y+ + add xl, t0 + adc xh, t1 + adc tosl, t6 + adc tosh, t7 + st -Y, xh + st -Y, xl + ret + +;*************************************************** + fdw DPLUS_L +DMINUS_L: + .db NFA|2,"d-",0 +DMINUS: + rcall DNEGATE + jmp DPLUS +;*************************************************** + fdw DMINUS_L +DTWOSLASH_L: + .db NFA|3,"d2/" + ld t0, y+ + ld t1, y+ + asr tosh + ror tosl + ror t1 + ror t0 + st -y, t1 + st -y, t0 + ret +;*************************************************** + fdw DTWOSLASH_L +DTWOSTAR_L: + .db NFA|3,"d2*" + ld t0, y+ + ld t1, y+ + lsl t0 + rol t1 + rol tosl + rol tosh + st -y, t1 + st -y, t0 + ret +;*************************************************** + fdw DTWOSTAR_L +DINVERT_L: + .db NFA|7,"dinvert" +DINVERT: + ld t0, y+ + ld t1, y+ + com t0 + com t1 + com tosl + com tosh + st -y, t1 + st -y, t0 + ret +;*************************************************** + fdw DINVERT_L +DZEROEQUAL_L: + .db NFA|3,"d0=" +DZEROEQUAL: + ld xl, y+ + ld xh, y+ + or tosl, tosh + or tosl, xl + or tosl, xh + brne DZEROLESS_FALSE +DZEROEQUAL_TRUE: + ser tosl + ser tosh + ret + +;*************************************************** + fdw DZEROEQUAL_L +DZEROLESS_L: + .db NFA|3,"d0<" +DZEROLESS: + ld xl, y+ + ld xh, y+ + cpi tosh, 0 + brmi DZEROEQUAL_TRUE +DZEROLESS_FALSE: + clr tosl + clr tosh + ret +;*************************************************** + fdw DZEROLESS_L +DEQUAL_L: + .db NFA|2,"d=",0 + rcall DMINUS + jmp DZEROEQUAL +;*************************************************** + fdw DEQUAL_L +DLESS_L: + .db NFA|2,"d<",0 +DLESS: + rcall DMINUS + jmp DZEROLESS +;*************************************************** + fdw DLESS_L +DGREATER_L: + .db NFA|2,"d>",0 +DGREATER: + call TWOSWAP + jmp DLESS +;*************************************************** + fdw DGREATER_L +UDDOT_L: + .db NFA|3,"ud." + rcall LESSNUM + rcall NUMS + rcall NUMGREATER + call TYPE + jmp SPACE_ +;*************************************************** + fdw UDDOT_L +DDOT_L: + .db NFA|2,"d.",0 + rcall LESSNUM + push tosl ; dup >r + push tosh + rcall DABS + rcall NUMS + call RFROM + rcall SIGN + rcall NUMGREATER + call TYPE + jmp SPACE_ +;**************************************************** + fdw DDOT_L +MEMHI_L: + .db NFA|2,"hi",0 +MEMHI: + rcall DOLIT + fdw FLASHHI + call CSE_ + call PLUS + jmp FETCH +FLASHHI: + .dw FLASH_HI + .dw EEPROM_HI + .dw RAM_HI + +.if FLASHEND > 0x3fff +;;; x@ ( addrl addru -- x ) + fdw A_FROM_L +XFETCH_L: + .db NFA|2, "x@",0 +.ifdef RAMPZ + out_ RAMPZ, tosl +.endif + poptos + movw z, tosl + lpm_ tosl, z+ ; Fetch from Flash directly + lpm_ tosh, z+ +.ifdef RAMPZ + ldi t0, RAMPZV + out_ RAMPZ, t0 +.endif + ret + +;;; x! ( x addrl addru -- ) + fdw XFETCH_L +XSTORE_L: + .db NFA|2, "x!",0 + mov t0, tosl + call DROP + rcall XUPDATEBUF + rjmp ISTORE1 +.endif + +;*************************************************** + + fdw MEMHI_L +L_FETCH_P: + .db NFA|INLINE|2,"@p", 0 +FETCH_P: + pushtos + movw tosl, pl + ret +;*************************************************** + fdw L_FETCH_P +L_PCFETCH: + .db NFA|3,"pc@" ; ( -- c ) Fetch char from pointer +PCFETCH: + pushtos + movw tosl, pl + jmp CFETCH +;*************************************************** + fdw L_PCFETCH +L_PTWOPLUS: +kernellink: + .db NFA|INLINE|3,"p2+" ; ( n -- ) Add 2 to p +PTWOPLUS: + add pl, r_two + adc ph, r_zero + ret + +;*************************************************** +; marker --- name + .dw 0 +L_MARKER: +lastword: + .db NFA|6,"marker",0 +MARKER: + call ROM_ + rcall CREATE + rcall DOLIT + .dw dp_start + call HERE + rcall TEN + rcall CMOVE + rcall TEN + call ALLOT + call FRAM + rcall XDOES + call DODOES + rcall INI + rcall TEN + jmp CMOVE + +.if IDLE_MODE == 1 +.if CPU_LOAD_LED == 1 +;;; Enable load led + fdw BUSY_L +LOADON_L: + .db NFA|5,"load+" + sbr FLAGS2, (1<>8)&0xff +; de dpeeprom&0xff, (dpeeprom>>8)&0xff +; de (dpdata)&0xff, ((dpdata)>>8)&0xff +; de lastword_lo, lastword_hi +; de DOTSTATUS;&0xff;, (DOTSTATUS>>8)&0xff + +; .end +;********************************************************** +.cseg +.org BOOT_START +RESET_: jmp WARM_ +.org BOOT_START + 0x02 + rcall FF_ISR +.org BOOT_START + 0x04 + rcall FF_ISR +.org BOOT_START + 0x06 + rcall FF_ISR +.org BOOT_START + 0x08 +.if MS_TIMER_ADDR == 0x08 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x0a + rcall FF_ISR +.org BOOT_START + 0x0c + rcall FF_ISR +.org BOOT_START + 0x0e +.if MS_TIMER_ADDR == 0x0e + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x10 + rcall FF_ISR +.org BOOT_START + 0x12 +.if MS_TIMER_ADDR == 0x12 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x14 +.if MS_TIMER_ADDR == 0x14 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x16 +.if MS_TIMER_ADDR == 0x16 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x18 +.if MS_TIMER_ADDR == 0x18 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x1a +.if MS_TIMER_ADDR == 0x1a + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x1c +.if MS_TIMER_ADDR == 0x1c + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x1e +.if MS_TIMER_ADDR == 0x1e + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x20 +.if MS_TIMER_ADDR == 0x20 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x22 +.if MS_TIMER_ADDR == 0x22 + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.org BOOT_START + 0x24 + rcall FF_ISR +.if 0x26 < INT_VECTORS_SIZE +.org BOOT_START + 0x26 + rcall FF_ISR +.endif +.if 0x28 < INT_VECTORS_SIZE +.org BOOT_START + 0x28 + rcall FF_ISR +.endif +.if 0x2a < INT_VECTORS_SIZE +.org BOOT_START + 0x2a +.if MS_TIMER_ADDR == 0x2a + rjmp MS_TIMER_ISR +.else + rcall FF_ISR +.endif +.endif +.if 0x2c < INT_VECTORS_SIZE +.org BOOT_START + 0x2c + rcall FF_ISR +.endif +.if 0x2e < INT_VECTORS_SIZE +.org BOOT_START + 0x2e + rcall FF_ISR +.endif +.if 0x30 < INT_VECTORS_SIZE +.org BOOT_START + 0x30 + rcall FF_ISR +.endif +.if 0x32 < INT_VECTORS_SIZE +.org BOOT_START + 0x32 + rcall FF_ISR +.endif +.if 0x34 < INT_VECTORS_SIZE +.org BOOT_START + 0x34 + rcall FF_ISR +.endif +.if 0x36 < INT_VECTORS_SIZE +.org BOOT_START + 0x36 + rcall FF_ISR +.endif +.if 0x38 < INT_VECTORS_SIZE +.org BOOT_START + 0x38 + rcall FF_ISR +.endif +.if 0x3a < INT_VECTORS_SIZE +.org BOOT_START + 0x3a + rcall FF_ISR +.endif +.if 0x3c < INT_VECTORS_SIZE +.org BOOT_START + 0x3c + rcall FF_ISR +.endif +.if 0x3e < INT_VECTORS_SIZE +.org BOOT_START + 0x3e + rcall FF_ISR +.endif +.if 0x40 < INT_VECTORS_SIZE +.org BOOT_START + 0x40 + rcall FF_ISR +.endif +.if 0x42 < INT_VECTORS_SIZE +.org BOOT_START + 0x42 + rcall FF_ISR +.endif +.if 0x44 < INT_VECTORS_SIZE +.org BOOT_START + 0x44 + rcall FF_ISR +.endif +.if 0x46 < INT_VECTORS_SIZE +.org BOOT_START + 0x46 + rcall FF_ISR +.endif +.if 0x48 < INT_VECTORS_SIZE +.org BOOT_START + 0x48 + rcall FF_ISR +.endif +.if 0x4a < INT_VECTORS_SIZE +.org BOOT_START + 0x4a + rcall FF_ISR +.endif +.if 0x4c < INT_VECTORS_SIZE +.org BOOT_START + 0x4c + rcall FF_ISR +.endif +.if 0x4e < INT_VECTORS_SIZE +.org BOOT_START + 0x4e + rcall FF_ISR +.endif +.if 0x50 < INT_VECTORS_SIZE +.org BOOT_START + 0x50 + rcall FF_ISR +.endif +.if 0x52 < INT_VECTORS_SIZE +.org BOOT_START + 0x52 + rcall FF_ISR +.endif +.if 0x54 < INT_VECTORS_SIZE +.org BOOT_START + 0x54 + rcall FF_ISR +.endif +.if 0x56 < INT_VECTORS_SIZE +.org BOOT_START + 0x56 + rcall FF_ISR +.endif +.if 0x58 < INT_VECTORS_SIZE +.org BOOT_START + 0x58 + rcall FF_ISR +.endif +.if 0x5a < INT_VECTORS_SIZE +.org BOOT_START + 0x5a + rcall FF_ISR +.endif +.if 0x5c < INT_VECTORS_SIZE +.org BOOT_START + 0x5c + rcall FF_ISR +.endif +.if 0x5e < INT_VECTORS_SIZE +.org BOOT_START + 0x5e + rcall FF_ISR +.endif +.if 0x60 < INT_VECTORS_SIZE +.org BOOT_START + 0x60 + rcall FF_ISR +.endif +.if 0x62 < INT_VECTORS_SIZE +.org BOOT_START + 0x62 + rcall FF_ISR +.endif +.if 0x64 < INT_VECTORS_SIZE +.org BOOT_START + 0x64 + rcall FF_ISR +.endif +.if 0x66 < INT_VECTORS_SIZE +.org BOOT_START + 0x66 + rcall FF_ISR +.endif +.if 0x68 < INT_VECTORS_SIZE +.org BOOT_START + 0x68 + rcall FF_ISR +.endif +.if 0x6a < INT_VECTORS_SIZE +.org BOOT_START + 0x6a + rcall FF_ISR +.endif +.if 0x6c < INT_VECTORS_SIZE +.org BOOT_START + 0x6c + rcall FF_ISR +.endif +.if 0x6e < INT_VECTORS_SIZE +.org BOOT_START + 0x6e + rcall FF_ISR +.endif +.if 0x70 < INT_VECTORS_SIZE +.org BOOT_START + 0x70 + rcall FF_ISR +.endif + +.org BOOT_START + INT_VECTORS_SIZE - 1 +FF_ISR_EXIT: + pop tosh + pop tosl + pop t1 + pop t0 + pop zh + pop zl +MS_TIMER_ISR_EXIT: + ld xl, y+ + ld xh, y+ + out_ SREG, xh + ld xh, y+ + reti + +FF_ISR: +.if IDLE_MODE == 1 +.if CPU_LOAD == 1 + out_ TCCR1B, r_one ; Start load counter +.endif +.endif + st -y, xh + in_ xh, SREG + st -y, xh + st -y, xl + m_pop_xh + pop xh + pop xl + push zl + push zh + push t0 + push t1 + push tosl + push tosh +.if low(ivec) == 0x80 + ldi xh, low(ivec-1) + add xl, xh +.else + subi xl, 1 +.endif + ldi xh, high(ivec) + ld zl, x+ + ld zh, x+ + mijmp ;(z) + +;;; ************************************************* +MS_TIMER_ISR: +.if IDLE_MODE == 1 +.if CPU_LOAD == 1 + out_ TCCR1B, r_one ; Start load counter +.endif +.endif + st -y, xh + in_ xh, SREG + st -y, xh + st -y, xl + add ms_count, r_one + adc ms_count1, r_zero +.if CPU_LOAD == 1 +LOAD_ADD: + in_ xl, TCNT1L + in_ xh, TCNT1H + out_ TCNT1H, r_zero + out_ TCNT1L, r_two + + add loadreg0, xl + adc loadreg1, xh + adc loadreg2, r_zero + + tst ms_count + brne LOAD_ADD_END + sbr FLAGS2, (1<a",0 +TO_A: + mov al, tosl + mov ah, tosh + poptos + ret + + fdw TO_A_L +STORE_L: + .db NFA|1, "!" +STORE: + cpi tosh, high(PEEPROM) + brcc STORE1 +STORE_RAM: + movw zl, tosl + poptos +STORE_RAM_2: + std Z+1, tosh + std Z+0, tosl + poptos + ret +STORE1: + rcall LOCKEDQ + cpi tosh, high(OFLASH) + brcc ISTORE +ESTORE: + call TWODUP + rcall ECSTORE + adiw tosl, 1 + ldd t0, Y+1 + std y+0, t0 + rjmp ECSTORE + +LOCKEDQ: + sbrs FLAGS1, fLOCK + ret + rcall DOTS + call XSQUOTE + .db 3,"AD?" + call TYPE + rjmp STARTQ2 ; goto ABORT + +;*********************************************************** +IFETCH: + movw z, tosl + sub_pflash_z +.ifdef RAMPZ + lds t0, ibaseu + cpi t0, RAMPZV + brne IIFETCH +.endif + cpse zh, ibaseh + rjmp IIFETCH + mov t0, zl + andi t0, ~(PAGESIZEB-1) + cp t0, ibasel + brne IIFETCH + ldi xl, low(ibuf) + ldi xh, high(ibuf) + andi zl, (PAGESIZEB-1) + add xl, zl + ld tosl, x+ + ld tosh, x+ + ret +IIFETCH: + lpm_ tosl, z+ ; Fetch from Flash directly + lpm_ tosh, z+ + ret + + fdw STORE_L +A_FROM_L: + .db NFA|2, "a>",0 +A_FROM: + pushtos + mov tosl, al + mov tosh, ah + ret + +.if FLASHEND > 0x3fff + fdw XSTORE_L +.else + fdw A_FROM_L +.endif +FETCH_L: + .db NFA|1, "@" +FETCH: + cpi tosh, high(PEEPROM) + brcc FETCH1 +FETCH_RAM: + movw zl, tosl +FETCH_RAM_2: + ld tosl, z+ + ld tosh, z+ + ret +FETCH1: + cpi tosh, high(OFLASH) + brcc IFETCH +EFETCH: + sbic eecr, eewe + rjmp EFETCH + subi tosh, high(PEEPROM) + out eearl, tosl + out eearh, tosh + sbi eecr, eere + in t0, eedr + inc tosl + out eearl, tosl + sbi eecr, eere + in tosh, eedr + mov tosl, t0 + ret + +ICFETCH: + rcall IFETCH + clr tosh + ret + + fdw FETCH_L +CFETCH_L: + .db NFA|2, "c@",0 +CFETCH: + cpi tosh, high(PEEPROM) + brcc CFETCH1 +CFETCH_RAM: + movw zl, tosl + ld tosl, z+ + clr tosh + ret +CFETCH1: + cpi tosh, high(OFLASH) + brcc ICFETCH +ECFETCH: + rcall EFETCH + clr tosh + ret + +ICSTORE: + rcall IUPDATEBUF + poptos + ldi xl, low(ibuf) + ldi xh, high(ibuf) + lds t0, iaddrl + andi t0, (PAGESIZEB-1) + add xl, t0 + st x+, tosl +ICSTORE_POP: + sbr FLAGS1, (1< 16/16 division +umslashmod0: + clt + tst tosl + brne umslashmodstart + tst tosh + brne umslashmodstart + set ; Set T flag + jmp WARM_ +umslashmodstart: + movw t4, tosl + + ld t3, Y+ + ld t6, Y+ + + ld tosl, Y+ + ld tosh, Y+ + +; unsigned 32/16 -> 16/16 division + ; set loop counter + ldi t0,$10 ;6 + +umslashmod1: + ; shift left, saving high bit + clr t7 + lsl tosl + rol tosh + rol t3 + rol t6 + rol t7 + + ; try subtracting divisor + cp t3, t4 + cpc t6, t5 + cpc t7,r_zero + + brcs umslashmod2 + + ; dividend is large enough + ; do the subtraction for real + ; and set lowest bit + inc tosl + sub t3, t4 + sbc t6, t5 + +umslashmod2: + dec t0 + brne umslashmod1 ;16=17=272 + +umslashmod3: + ; put remainder on stack + st -Y,t6 + st -Y,t3 + ; Quotient is already in tos ; 6 + 272 + 4 =282 cycles + ret +BASEQV: + fdw DECIMAL + fdw HEX + fdw BIN + + +;;; ************************************* +;;; EMPTY dictionary data +; ******************************************************************* +.equ coldlitsize=12 +COLDLIT: +STARTV: .dw 0 +DPC: .dw OFLASH +DPE: .dw ehere +DPD: .dw dpdata +LW: fdw lastword +STAT: fdw DOTSTATUS +;******************************************************************* +; BOOT sector END ************************************************** + +KERNEL_END: -- cgit v1.2.3