/***********************************************************************/
/*                                                                     */
/*  startup_SAM7S.S:  

// assembler tests working toward a forth kernel.    
/***********************************************************************/



// *** Startup Code (executed after Reset) ***


// Standard definitions of Mode bits and Interrupt (I & F) flags in PSRs

        .equ    Mode_USR,       0x10
        .equ    Mode_FIQ,       0x11
        .equ    Mode_IRQ,       0x12
        .equ    Mode_SVC,       0x13
        .equ    Mode_ABT,       0x17
        .equ    Mode_UND,       0x1B
        .equ    Mode_SYS,       0x1F

        .equ    I_Bit,          0x80    /* when I bit is set, IRQ is disabled */
        .equ    F_Bit,          0x40    /* when F bit is set, FIQ is disabled */


// Internal Memory Base Addresses
        .equ    FLASH_BASE,     0x00100000   
        .equ    RAM_BASE,       0x00200000


/*
// <h> Stack Configuration
//   <o>  Top of Stack Address  <0x0-0xFFFFFFFF:4>
//   <h>  Stack Sizes (in Bytes)
//     <o1> Undefined Mode      <0x0-0xFFFFFFFF:4>
//     <o2> Supervisor Mode     <0x0-0xFFFFFFFF:4>
//     <o3> Abort Mode          <0x0-0xFFFFFFFF:4>
//     <o4> Fast Interrupt Mode <0x0-0xFFFFFFFF:4>
//     <o5> Interrupt Mode      <0x0-0xFFFFFFFF:4>
//     <o6> User/System Mode    <0x0-0xFFFFFFFF:4>
//   </h>
// </h>
*/
        .equ    Top_Stack,      0x00210000
        .equ    UND_Stack_Size, 0x00000004
        .equ    SVC_Stack_Size, 0x00000100
        .equ    ABT_Stack_Size, 0x00000004
        .equ    FIQ_Stack_Size, 0x00000004
        .equ    IRQ_Stack_Size, 0x00000100
        .equ    USR_Stack_Size, 0x00000100


// Embedded Flash Controller (EFC) definitions
        .equ    EFC_BASE,       0xFFFFFF00  /* EFC Base Address */
        .equ    EFC_FMR,        0x60        /* EFC_FMR Offset */

/*
// <e> Embedded Flash Controller (EFC)
//   <o1.16..23> FMCN: Flash Microsecond Cycle Number <0-255>
//               <i> Number of Master Clock Cycles in 1us
//   <o1.8..9>   FWS: Flash Wait State
//               <0=> Read: 1 cycle / Write: 2 cycles
//               <1=> Read: 2 cycle / Write: 3 cycles
//               <2=> Read: 3 cycle / Write: 4 cycles
//               <3=> Read: 4 cycle / Write: 4 cycles
// </e>
*/
        .equ    EFC_SETUP,      1
        .equ    EFC_FMR_Val,    0x00320100


// Watchdog Timer (WDT) definitions
        .equ    WDT_BASE,       0xFFFFFD40  /* WDT Base Address */
        .equ    WDT_MR,         0x04        /* WDT_MR Offset */

/*
// <e> Watchdog Timer (WDT)
//   <o1.0..11>  WDV: Watchdog Counter Value <0-4095>
//   <o1.16..27> WDD: Watchdog Delta Value <0-4095>
//   <o1.12>     WDFIEN: Watchdog Fault Interrupt Enable
//   <o1.13>     WDRSTEN: Watchdog Reset Enable
//   <o1.14>     WDRPROC: Watchdog Reset Processor
//   <o1.28>     WDDBGHLT: Watchdog Debug Halt
//   <o1.29>     WDIDLEHLT: Watchdog Idle Halt
//   <o1.15>     WDDIS: Watchdog Disable
// </e>
*/
        .equ    WDT_SETUP,      1
        .equ    WDT_MR_Val,     0x00008000


// Power Mangement Controller (PMC) definitions
        .equ    PMC_BASE,       0xFFFFFC00  /* PMC Base Address */
        .equ    PMC_MOR,        0x20        /* PMC_MOR Offset */
        .equ    PMC_MCFR,       0x24        /* PMC_MCFR Offset */
        .equ    PMC_PLLR,       0x2C        /* PMC_PLLR Offset */
        .equ    PMC_MCKR,       0x30        /* PMC_MCKR Offset */
        .equ    PMC_SR,         0x68        /* PMC_SR Offset */
        .equ    PMC_MOSCEN,     (1<<0)      /* Main Oscillator Enable */
        .equ    PMC_OSCBYPASS,  (1<<1)      /* Main Oscillator Bypass */
        .equ    PMC_OSCOUNT,    (0xFF<<8)   /* Main OScillator Start-up Time */
        .equ    PMC_DIV,        (0xFF<<0)   /* PLL Divider */
        .equ    PMC_PLLCOUNT,   (0x3F<<8)   /* PLL Lock Counter */
        .equ    PMC_OUT,        (0x03<<14)  /* PLL Clock Frequency Range */
        .equ    PMC_MUL,        (0x7FF<<16) /* PLL Multiplier */
        .equ    PMC_USBDIV,     (0x03<<28)  /* USB Clock Divider */
        .equ    PMC_CSS,        (3<<0)      /* Clock Source Selection */
        .equ    PMC_PRES,       (7<<2)      /* Prescaler Selection */
        .equ    PMC_MOSCS,      (1<<0)      /* Main Oscillator Stable */
        .equ    PMC_LOCK,       (1<<2)      /* PLL Lock Status */

/*
// <e> Power Mangement Controller (PMC)
//   <h> Main Oscillator
//     <o1.0>      MOSCEN: Main Oscillator Enable
//     <o1.1>      OSCBYPASS: Oscillator Bypass
//     <o1.8..15>  OSCCOUNT: Main Oscillator Startup Time <0-255>
//   </h>
//   <h> Phase Locked Loop (PLL)
//     <o2.0..7>   DIV: PLL Divider <0-255>
//     <o2.16..26> MUL: PLL Multiplier <0-2047>
//                 <i> PLL Output is multiplied by MUL+1
//     <o2.14..15> OUT: PLL Clock Frequency Range
//                 <0=> 80..160MHz  <1=> Reserved
//                 <2=> 150..220MHz <3=> Reserved
//     <o2.8..13>  PLLCOUNT: PLL Lock Counter <0-63>
//     <o2.28..29> USBDIV: USB Clock Divider
//                 <0=> None  <1=> 2  <2=> 4  <3=> Reserved
//   </h>
//   <o3.0..1>   CSS: Clock Source Selection
//               <0=> Slow Clock
//               <1=> Main Clock
//               <2=> Reserved
//               <3=> PLL Clock
//   <o3.2..4>   PRES: Prescaler
//               <0=> None
//               <1=> Clock / 2    <2=> Clock / 4
//               <3=> Clock / 8    <4=> Clock / 16
//               <5=> Clock / 32   <6=> Clock / 64
//               <7=> Reserved
// </e>
*/
        .equ    PMC_SETUP,      1
        .equ    PMC_MOR_Val,    0x00000601
       .equ    PMC_PLLR_Val,   0x00481C0e
//  .equ    PMC_PLLR_Val,   0x00419C05
        .equ    PMC_MCKR_Val,   0x00000007



#if defined(VECTORS_IN_RAM) && defined(ROM_RUN)

/* 
 Exception Vectors to be placed in RAM - added by mt
 -> will be used after remapping in ROM_RUN
 -> not needed for RAM_RUN
 Mapped to Address 0 after remapping in ROM_RUN
 Absolute addressing mode must be used.
 Dummy Handlers are implemented as infinite loops which can be modified.
 VECTORS_IN_RAM defined in makefile/by commandline 
*/
			.text
			.arm
			.section .vectram, "ax"
			
VectorsRAM:     LDR     PC,Reset_AddrR
//		B Reset_Handler
                LDR     PC,Undef_AddrR
                LDR     PC,SWI_AddrR
                LDR     PC,PAbt_AddrR
                LDR     PC,DAbt_AddrR
                NOP                            /* Reserved Vector */
                LDR     PC,[PC,#-0xF20]        /* Vector From AIC_IVR */
                LDR     PC,[PC,#-0xF20]        /* Vector From AIC_FVR */

Reset_AddrR:     .word   Reset_Handler
Undef_AddrR:     .word   Undef_HandlerR
SWI_AddrR:       .word   SWI_HandlerR
PAbt_AddrR:      .word   PAbt_HandlerR
DAbt_AddrR:      .word   DAbt_HandlerR
//               .word   0xdeadbeef     /* Test Reserved Address */
                 .word   0     /* Reserved Address */
IRQ_AddrR:       .word   IRQ_HandlerR
FIQ_AddrR:       .word   FIQ_HandlerR

Undef_HandlerR:  B       Undef_HandlerR
SWI_HandlerR:    B       SWI_HandlerR
PAbt_HandlerR:   B       PAbt_HandlerR
DAbt_HandlerR:   B       DAbt_HandlerR
IRQ_HandlerR:    B       IRQ_HandlerR
FIQ_HandlerR:    B       FIQ_HandlerR

#endif /* VECTORS_IN_RAM && ROM_RUN */

/*
 Exception Vectors 
 - for ROM_RUN: placed in 0x00000000 
 - for RAM_RUN: placed at 0x00200000 (on AT91SAM7S64)
 -> will be used during startup before remapping with target ROM_RUN
 -> will be used "always" in code without remapping or with target RAM_RUN
 Mapped to Address relative address 0 of .text
 Absolute addressing mode must be used.
 Dummy Handlers are implemented as infinite loops which can be modified.
*/
			.text
			.arm
			.section .vectrom, "ax"

Vectors:		LDR     PC,Reset_Addr
//		B Reset_Handler      
                LDR     PC,Undef_Addr
                LDR     PC,SWI_Addr
                LDR     PC,PAbt_Addr
                LDR     PC,DAbt_Addr
                NOP                            /* Reserved Vector */
//                LDR     PC,IRQ_Addr
                LDR     PC,[PC,#-0xF20]        /* Vector From AIC_IVR */
//                LDR     PC,FIQ_Addr
                LDR     PC,[PC,#-0xF20]        /* Vector From AIC_FVR */

Reset_Addr:     .word   Reset_Handler
Undef_Addr:     .word   Undef_Handler
SWI_Addr:       .word   SWI_Handler
PAbt_Addr:      .word   PAbt_Handler
DAbt_Addr:      .word   DAbt_Handler
                .word   0                      /* Reserved Address */
IRQ_Addr:       .word   IRQ_Handler
FIQ_Addr:       .word   FIQ_Handler

Undef_Handler:  B       Undef_Handler
SWI_Handler:    B       SWI_Handler
PAbt_Handler:   B       PAbt_Handler
DAbt_Handler:   B       DAbt_Handler
IRQ_Handler:    B       IRQ_Handler
FIQ_Handler:    B       FIQ_Handler


// "eddie's variables and constants - space reserved in flash to mirror ram.
.equ DSTCK, Top_Stack - 0X400
.equ RAMoffset,0x100000 
// buffers
.equ tobsize, 128
.equ tibsize, 128
.equ padsize, 128
RESTIB: .skip tibsize				// text input buffer
.equ TIB, RESTIB+RAMoffset 
RESTOB: .skip tobsize				// text ouptut buffer
.equ TOB, RESTOB+RAMoffset 
RESPAD: .skip padsize				// PAD buffer
.equ PAD, RESPAD+RAMoffset 
// byte variables
RESINPTR: .skip 1
.equ INPTR, RESINPTR+RAMoffset 
RESOUTPTR: .skip 1
.equ OUTPTR, RESOUTPTR+RAMoffset

.align
// word variables.
RESDP: .word 	_etext+0X80+(RAM_BASE-FLASH_BASE)
.equ	VARDP, RESDP+RAMoffset
RESCONTEXT: .word 	lastword
.equ	VARCONTEXT, RESCONTEXT+RAMoffset

//' existing startup code
// Starupt Code must be linked first at Address at which it expects to run.

		.text
		.arm
		.section .init, "ax"
	
		.global _startup
		.func   _startup
_startup:


// Reset Handler
                LDR     pc, =Reset_Handler
Reset_Handler:

// Setup EFC
.if EFC_SETUP
                LDR     R0, =EFC_BASE
                LDR     R1, =EFC_FMR_Val
                STR     R1, [R0, #EFC_FMR]
.endif


// Setup WDT
.if WDT_SETUP
                LDR     R0, =WDT_BASE
                LDR     R1, =WDT_MR_Val
                STR     R1, [R0, #WDT_MR]
.endif


// Setup PMC
.if PMC_SETUP
                LDR     R0, =PMC_BASE

//  Setup Main Oscillator
                LDR     R1, =PMC_MOR_Val
                STR     R1, [R0, #PMC_MOR]

//  Wait until Main Oscillator is stablilized
.if (PMC_MOR_Val & PMC_MOSCEN)
MOSCS_Loop:     LDR     R2, [R0, #PMC_SR]
                ANDS    R2, R2, #PMC_MOSCS
                BEQ     MOSCS_Loop
.endif

//  Setup the PLL
.if (PMC_PLLR_Val & PMC_MUL)
                LDR     R1, =PMC_PLLR_Val
                STR     R1, [R0, #PMC_PLLR]

//  Wait until PLL is stabilized
PLL_Loop:       LDR     R2, [R0, #PMC_SR]
                ANDS    R2, R2, #PMC_LOCK
                BEQ     PLL_Loop
.endif

//  Select Clock
                LDR     R1, =PMC_MCKR_Val
                STR     R1, [R0, #PMC_MCKR]
.endif


// Setup Stack for each mode

                LDR     R0, =Top_Stack

//  Enter Undefined Instruction Mode and set its Stack Pointer
                MSR     CPSR_c, #Mode_UND|I_Bit|F_Bit
                MOV     SP, R0
                SUB     R0, R0, #UND_Stack_Size

//  Enter Abort Mode and set its Stack Pointer
                MSR     CPSR_c, #Mode_ABT|I_Bit|F_Bit
                MOV     SP, R0
                SUB     R0, R0, #ABT_Stack_Size

//  Enter FIQ Mode and set its Stack Pointer
                MSR     CPSR_c, #Mode_FIQ|I_Bit|F_Bit
                MOV     SP, R0
                SUB     R0, R0, #FIQ_Stack_Size

//  Enter IRQ Mode and set its Stack Pointer
                MSR     CPSR_c, #Mode_IRQ|I_Bit|F_Bit
                MOV     SP, R0
                SUB     R0, R0, #IRQ_Stack_Size

//  Enter Supervisor Mode and set its Stack Pointer
                MSR     CPSR_c, #Mode_SVC|I_Bit|F_Bit
                MOV     SP, R0
                SUB     R0, R0, #SVC_Stack_Size

//  Enter User Mode and set its Stack Pointer
                MSR     CPSR_c, #Mode_USR
                MOV     SP, R0

// Setup a default Stack Limit (when compiled with "-mapcs-stack-check")
                SUB     SL, SP, #USR_Stack_Size
/*


#ifdef ROM_RUN
// Relocate .data section (Copy from ROM to RAM)
                LDR     R1, =_etext	// 001008d0 A _etext
                LDR     R2, =_data	// 00200000 D _data
                LDR     R3, =_edata	// 00200058 A _edata
LoopRel:        CMP     R2, R3
                LDRLO   R0, [R1], #4
                STRLO   R0, [R2], #4
                BLO     LoopRel
#endif

// Clear .bss section (Zero init)
                MOV     R0, #0
                LDR     R1, =__bss_start__
                LDR     R2, =__bss_end__
LoopZI:         CMP     R1, R2
                STRLO   R0, [R1], #4
                BLO     LoopZI
*/

#if defined(VECTORS_IN_RAM) || defined(RAM_RUN)
/* 
   *** Remap ***
   ROM_RUN: exception vectors for RAM have been already copied 
     to 0x00200000 by the .data copy-loop 
   RAM_RUN: exception vectors are already placed at 0x0020000 by
     linker settings
*/
				.equ    MC_BASE,0xFFFFFF00  /* MC Base Address */
				.equ    MC_RCR, 0x00        /* MC_RCR Offset */

				LDR     R0, =MC_BASE
				MOV     R1, #1
				STR     R1, [R0, #MC_RCR]   // Remap
#endif /* VECTORS_IN_RAM || RAM_RUN */

// "eddie's code starts here.


// Relocate Flash to RAM section (Copy from ROM to RAM)
                LDR     R1, =	FLASH_BASE
                LDR     R2, =	RAM_BASE	// 00200000 D _data
                LDR     R3, =	DSTCK		// 
LoopRel:        CMP     R2, R3
                LDRLO   R0, [R1], #4
                STRLO   R0, [R2], #4
                BLO     LoopRel
				
//				ldr		r0,=RAM_BASE-FLASH_BASE
//				add		pc,r0	// start executing in RAM

.macro ResetDstack 
			ldr r7,=DSTCK
.endm

.macro plus1 
			add r6,#1	// add one to top
.endm	

.macro plus2 
			add r6,#2	// add one to top
.endm

.macro sub1
			sub r6,#1	// sub 1 
.endm

.macro sub2
			sub r6,#2	// sub 2 
.endm

.macro div2
			lsr r6,#1	// div 2
.endm

.macro mul2
			lsl r6,#1	// mul 2
.endm

.macro 	Top2R0		
			// top to ro, without poping stack. 
			mov r0,r6
.endm	

.macro AT 
		ldr r6,[r6]
.endm 
		
.macro CAT 
		ldrb r6,[r6]
.endm 
		
// ========== Register definition for PMC peripheral ========== 

.equ PMC_PCER, 0xFFFFFC10 // (PMC) Peripheral Clock Enable Register
.equ ID_PIOA,    2 // Parallel IO Controller bit
.equ ID_US0,     6 // USART 0
.equ ID_US1,     7 // USART 0
	// enable the clock of the PIO (mt:) and UART0
//	AT91F_PMC_EnablePeriphClock ( AT91C_BASE_PMC, ( 1 << AT91C_ID_PIOA ) | ( 1 << AT91C_ID_US0 ) ) ;
// IO Controller definitions

.equ PIO_PER, 0xFFFFF400 // (PIOA) PIO Enable Register
.equ PIO_OER, 0xFFFFF410 // (PIOA) Output Enable Register
.equ PIO_CODR,0xFFFFF434 // (PIOA) Clear Output Data Register
.equ PIO_SODR,0xFFFFF430 // (PIOA) Set Output Data Register
// ========== Register definition for PIOA peripheral ==========
.equ PIOA_PDR,  0xFFFFF404 // (PIOA) PIO Disable Register

// ========== Register definition for usart peripheral ==========
.equ US_RSTRX, 1 <<  2 // (DBGU) Reset Receiver
.equ US_RSTTX, 1 <<  3 // (DBGU) Reset Transmitter
.equ US_RXEN,  1 <<  4 // (DBGU) Receiver Enable
.equ US_RXDIS, 1 <<  5 // (DBGU) Receiver Disable
.equ US_TXEN,  1 <<  6 // (DBGU) Transmitter Enable
.equ US_TXDIS, 1 <<  7 // (DBGU) Transmitter Disable
.equ RSTSTA,   1 <<  8 // (DBGU) Reset Status Bits

.equ PA5_RXD0, 1 <<  5
.equ PA6_TXD0, 1 <<  6
.equ PA21_RXD1, 1 <<  21
.equ PA22_TXD1, 1 <<  22

.equ BASE_US0, 	0xFFFC0000 // (US0) Base Address
.equ BASE_US1, 	0xFFFC4000 // (US1) Base Address
.equ US_MR,    	0x4
.equ US_CSR,   	0x14
.equ US_RHR,   	0x18
.equ US_THR,   	0x1C
.equ US_BRGR,  	0x20

.equ US_USMODE_NORMAL, 0x0 // (USART) Normal
.equ US_CLKS_CLOCK,    0x0 <<  4 // (USART) Clock
.equ US_NBSTOP_1_BIT,  0x0 << 12 // (USART) 1 stop bit
.equ US_PAR_NONE,      0x4 <<  9 // (DBGU) No Parity
.equ US_CHRL_8_BITS,   0x3 <<  6 // (USART) Character Length: 8 bit
.equ US_RXRDY,         0x1 <<  0 // (DBGU) RXRDY Interrupt
.equ US_TXRDY,         0x1 <<  1 // (DBGU) TXRDY Interrupt

//   Enable RxD0 Pin  Enable TxD0 Pin */
				LDR     R0, =PIOA_PDR
				LDR     R1, =PA5_RXD0|PA6_TXD0|PA21_RXD1|PA22_TXD1
				STR     R1, [R0] 
/*
// set up usart 0
// Reset Receiver Reset Transmitter  Receiver Disable  Transmitter Disable 
				LDR     R0, =BASE_US0 		// same as US_CR 
				MOV     R1, #US_RSTRX|US_RSTTX|US_RXDIS|US_TXDIS;
				STR     R1, [R0]

// Normal Mode Clock = MCK No Parity 1 Stop Bit  
				MOV     R1, #US_USMODE_NORMAL|US_CLKS_CLOCK|US_CHRL_8_BITS|US_PAR_NONE|US_NBSTOP_1_BIT;  
				STR     R1, [R0,#US_MR]
//  Baud Rate Divisor 38.4Kbd with 48mhz clock = 78
				MOV     R1, #78;  
				STR     R1, [R0,#US_BRGR]

//  Receiver Enable  Transmitter Enable  
				MOV     R1, #US_RXEN|US_TXEN;
				STR     R1, [R0]

*/				
// set up usart 1
// Reset Receiver Reset Transmitter  Receiver Disable  Transmitter Disable 
				LDR     R0, =BASE_US1 		// same as US_CR 
				MOV     R1, #US_RSTRX|US_RSTTX|US_RXDIS|US_TXDIS;
				STR     R1, [R0]

// Normal Mode Clock = MCK No Parity 1 Stop Bit  
				MOV     R1, #US_USMODE_NORMAL|US_CLKS_CLOCK|US_CHRL_8_BITS|US_PAR_NONE|US_NBSTOP_1_BIT;  
				STR     R1, [R0,#US_MR]
//  Baud Rate Divisor 38.4Kbd with 48mhz clock = 78
				MOV     R1, #78;  
				STR     R1, [R0,#US_BRGR]

//  Receiver Enable  Transmitter Enable  
				MOV     R1, #US_RXEN|US_TXEN;
				STR     R1, [R0]
								
				
//  p_pPMC->PMC_PCER = 1 << AT91C_ID_PIOA;
				LDR     R0, =PMC_PCER
				MOV     R1, #1<<ID_PIOA| 1 << ID_US0 | 1 << ID_US1 
				STR     R1, [R0] 

//  p_pPio->PIO_PER = BIT8;    //Enable PA8
				LDR     R0, =PIO_PER
				MOV     R1, #1<<8
				STR     R1, [R0]   

//  p_pPio->PIO_OER = BIT8;    //Configure in Output

				STR     R1, [R0,#(PIO_OER-PIO_PER)] 
						
.equ base_RSTC,		0xFFFFFD00	
.equ RSTC_MR, 		0x8	
.equ RSTC_URSTEN, 1
//*AT91C_RSTC_RMR = (0xA5000000|AT91C_RSTC_URSTEN);
				LDR     R0, =base_RSTC+RSTC_MR
				ldr     R1, =0xA5000000|RSTC_URSTEN 
				STR     R1, [R0] 
				ResetDstack
//' Switch to thumb mode
	add	R1,PC,#1 	//;Load address of SUB_BRANCH, Set for THUMB by adding 1
  	BX 	R1 			//;R1 contains address of SUB_BRANCH+1
//;Assembler-specific instruction to switch to Thumb
.thumb
SUB_BRANCH:	
teststart:	

	//		BL 		RTliteral
	//		.align
	//		.word 	_etext+0X80+(RAM_BASE-FLASH_BASE)
	//		BL 		RTliteral
	//		.align
	//		.word 	VARDP	
	//		BL 		store
	//	
	//		BL 		RTliteral
	//		.align
	//		.word 	lastword
	//		BL 		RTliteral
	//		.align
	//		.word 	VARCONTEXT	
	//		BL 		store
	//		
			BL 		RTSliteral
			.word 	0
			BL 		RTliteral
			.align	
			.word 	OUTPTR
			bl Cstore
			
			ldr 	r4,=0x10 
ledloop:	
			bl flashled
			sub r4,r4, #1	//**
			bne ledloop	
	LDR R0,=0X41
	BL sout
//	b ledloop
			bl dotquote
.byte 19 
.ascii "SAM7 Thumb ekm 2006"
.align 1
			bl 		CR
		BL 		RTliteral
		.align
		.word 	RAM_BASE-FLASH_BASE			
		bl DpopR0
		add PC,r0
		
			mov 	r0,pc
			bl		DpushR0
			bl		dothex32
			bl		CR
			bl 		VLIST
			mov 	r0,pc
			bl		DpushR0
			bl		dothex32
			bl		CR
			B 		QUIT

//'************************************************************************

//' Start of FORTH dictionary
//( LINK , FLAGS , CNT , NAME , BODY/POINTER )
//( 32bit(aligned),   BYTE,    BYTE,  ?BYTES,  32bit (aligned) )	
	
//4	CONSTANT F_REMT	( remote flag ie headerless code or alias )
.equ F_REMT, 	4
.equ F_THUMB, 	0x20

dictionary:
.align
CRHead:
	.word 0						// null link at beginning of dic.
	.byte F_REMT|F_THUMB		// flags
	.byte 2 
.ascii "CR"
.align
	.word CR+RAMoffset				// Code field
	
DUPHead:
	.word CRHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB 		// flags
	.byte 3 
.ascii "DUP"
.align
	.word DUP+RAMoffset					// Code field
	
SWAPHead:
	.word DUPHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "SWAP"
.align
	.word SWAP+RAMoffset					// Code field
	
OVERHead:
	.word SWAPHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "OVER"
.align
	.word OVER+RAMoffset					// Code field
	
DROPHead:
	.word OVERHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "DROP"
.align
	.word DROP+RAMoffset					// Code field
	
storeHead:	
	.word DROPHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii "!"		
.align
	.word store+RAMoffset					// Code field

CstoreHead:	
	.word storeHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 2 
.ascii "C!"		
.align
	.word Cstore+RAMoffset				// Code field
		
commaHead:		
	.word CstoreHead+RAMoffset			// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii ","		
.align
	.word comma+RAMoffset					// Code field

CcommaHead:		
	.word commaHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 2 
.ascii "C,"		
.align
	.word Ccomma+RAMoffset				// Code field

HcommaHead:		
	.word CcommaHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 2 
.ascii "H,"		
.align
	.word Hcomma+RAMoffset				// Code field

addHead:
	.word HcommaHead+RAMoffset			// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii "+"		
.align
	.word add+RAMoffset					// Code field

subHead:
	.word addHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii "-"		
.align
	.word sub+RAMoffset					// Code field

ANDHead:
	.word subHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 3 
.ascii "AND"		
.align
	.word AND+RAMoffset

SPACEHead:
	.word ANDHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 5 
.ascii "SPACE"	
.align
	.word SPACE+RAMoffset					// Code field

EMITHead:
	.word SPACEHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "EMIT"	
.align
	.word EMIT+RAMoffset					// Code field

TYPEHead:
	.word EMITHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "TYPE"	
.align
	.word TYPE+RAMoffset					// Code field
	
ATHead:
	.word TYPEHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii "@"		
.align	
	.word Iat+RAMoffset					// Code field
	
CATHead:
	.word ATHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 2 
.ascii "C@"	
.align	
	.word Icat+RAMoffset					// Code field

DOTHead:
	.word CATHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii "."	
.align	
	.word dothex32+RAMoffset				// Code field

WORDHead:
	.word DOTHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "WORD"
.align
	.word WORD+RAMoffset					// Code field
	
CONTEXTHead:
		.word WORDHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB			// flags
	.byte 7 
.ascii "CONTEXT"
.align
	.word CONTEXT+RAMoffset					// Code field

DUMPHead:
	.word CONTEXTHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "DUMP"
.align	
	.word DUMP+RAMoffset						// Code field
	
SPstorehead:
	.word DUMPHead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 3 
.ascii "SP!"
.align	
	.word	SPstore+RAMoffset					// Code field

dotShead:
	.word SPstorehead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 2 
.ascii ".S"	
.align	
	.word	dotS+RAMoffset				// Code field

DPhead:
	.word dotShead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 2 
.ascii "DP"		
.align	
	.WORD DP+RAMoffset					// Code field

tickhead:
	.word DPhead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii "'"	
.align	
	.word	tick+RAMoffset				// Code field

cfahead:
	.word tickhead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 6 
.ascii "LFA>CA"	
.align	
	.word	lfa2ca+RAMoffset				// Code field

commenthead:
	.word cfahead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 1 
.ascii "("	
.align	
	.word	comment+RAMoffset				// Code field

swapdrophead:
	.word commenthead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 8 
.ascii "SWAPDROP"					
.align	
	.word	DROPNXT+RAMoffset		// same as swap drop
	
DpopR0head:
	.word swapdrophead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "T>R0"					// Name field
.align	
	.word	DpopR0+RAMoffset			// pop   top to ro, pop dstack into top 

DpopR0R1head:
	.word DpopR0head+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 7 
.ascii "TN>R0R1"				
.align	
	.word	DpopR0R1+RAMoffset	// pop top and next to r0,r1

DpushR0head:
	.word DpopR0R1head+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "R0>T"					
.align	
	.word	DpushR0+RAMoffset	// push ro to top, top onto dstack

slithead:
	.word DpushR0head+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 6 
.ascii "[SLIT]"					
.align	
	.word	RTSliteral+RAMoffset	// push short literal stack
	
lithead:
	.word slithead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 5 
.ascii "[LIT]"					
.align	
	.word	RTliteral+RAMoffset	// push LIT to stack
	
EXECUTEhead:
	.word lithead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 7 
.ascii "EXECUTE"					
.align	
	.word	EXECUTE+RAMoffset	// EXECUTE address at top

NUMBERhead:
	.word EXECUTEhead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 6 
.ascii "NUMBER"					
.align	
	.word	NUMBER+RAMoffset	// EXECUTE address at top

GETLINEhead:
	.word NUMBERhead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 7 
.ascii "GETLINE"					
.align	
	.word	GETLINE+RAMoffset	// EXECUTE address at top

FINDhead:
	.word GETLINEhead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 4 
.ascii "FIND"					
.align	
	.word	FIND+RAMoffset	// EXECUTE address at top

printhead:
	.word FINDhead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 3 
.ascii "[.]"					
.align	
	.word	dotquote+RAMoffset	// EXECUTE address at top

VLISTHead:
	.word printhead+RAMoffset				// Link Field
	.byte F_REMT|F_THUMB		// flags
	.byte 5 
.ascii "VLIST"					
.align	
	.word VLIST+RAMoffset					// Code field

.equ lastword, VLISTHead+RAMoffset

DUMP:		// addr len -- MT ; hex dump memory
			push 	{lr}
			BL 		DpopR0R1		// len/top in R0, addr/next in R1
			mov 	r3,r0			// mov len to r3.
dumpline:	mov 	r0,r1			// copy addr to r0
			bl 		DpushR0			// push addr for printing
			bl		CR
			bl 		dothex32
			ldr		r4,=0x10		// load byte counter.
dumpbyte:	sub		r3,#1
			bmi		enddump
			ldrb	r0,[r1]
			add		r1,#1
			bl 		DpushR0			// push addr for printing
			bl 		dothex8
			sub		r4,#1
			beq		dumpline			
			b		dumpbyte
enddump:	bl		CR
			pop 	{pc}
			
//--------------------------------------------------------------------------	
	
VLIST:		push	{lr}
			bl		CONTEXT			// get the link to vocab onto top.
loopVL:		AT						// @ it to get the address of the first word
			bl 		DUP
			bl 		dothex32
			cmp 	r6,#0			// check for zero - ie end of list
			beq		endvlist
			bl 		DUP				// copy link
			add 	r6,#5			// advance to word Cstring
			bl 		TYPE			// type it out 
			bl 		CR				// new line
			b		loopVL			// loop back	
endvlist:	bl 		DROP			// drop zero (use ?dup in forth version.
			pop		{pc}
//--------------------------------------------------------------------------			
store:		push 	{lr}
			bl 		DpopR0R1		// get top and next
			str		r1,[r0]
			pop 	{pc}
//--------------------------------------------------------------------------			
			
Cstore:		push 	{lr}
			bl 		DpopR0R1		// get top and next
			strb	r1,[r0]
			pop 	{pc}	

//--------------------------------------------------------------------------			
	
DUP:	// duplicate top.
			str 	r5,[r7]
			add 	r7,#4
			mov 	r5,r6			
			mov 	pc,lr
//--------------------------------------------------------------------------			
			
SWAP:		push 	{r6,lr}
			mov 	r6,r5
			pop 	{r5,pc}
//--------------------------------------------------------------------------			
			
OVER:		mov 	r0,r5	// T N --> N T N 			
DpushR0:	// push ro to top, top onto dstack
			str 	r5,[r7]
			add 	r7,#4
			mov 	r5,r6			
			mov 	r6,r0
			mov 	pc,lr
//--------------------------------------------------------------------------			

DpopR0R1:// pop top and next to r0,r1
			mov		r0,r6
			mov		r1,r5
			sub		r7,#8
			ldr		r5,[r7]
			ldr		r6,[r7,#4]
			mov 	pc,lr
//--------------------------------------------------------------------------			
			
DpopR0:					// pop   top to ro, pop dstack into top 
			mov 	r0,r6
DROP:		mov 	r6,r5		// drop top.	
DROPNXT:	sub 	r7,#4		// same as swap drop.
			ldr 	r5,[r7]
			mov 	pc,lr
//--------------------------------------------------------------------------			
			
AND:		// add top and next adjust stack
			and 	r6,r5
			b 		DROPNXT
//--------------------------------------------------------------------------			
			
add:		// add top and next adjust stack
			add 	r6,r5
			b 		DROPNXT
//--------------------------------------------------------------------------			
			
sub:		// SUB top from next adjust stack
			sub 	r6,r5,r6
			b 		DROPNXT		
//--------------------------------------------------------------------------			
	
SPACE:		push {lr}	// emit one space to TOB
			ldr r0,=0x20
			bl emitr0
			pop {pc}
//--------------------------------------------------------------------------			
			
EMIT:		push {lr}
			bl DpopR0
			bl emitr0
			pop {pc}
//--------------------------------------------------------------------------			

				
dotquote:	// forth style text output, sout for now buffered later.
			// link reg points to count byte
				mov r1,lr		// copy lr because lr will be needed for bl
				sub r1,#1		// in thumb mode lsb is set..	
				ldrb r2,[r1]	// get the count to r2
charoutloop:	add r1, #1				
				ldrb r0,[r1]	// get the chr to r0
				bl emitr0
//bl sout
				sub r2,#1
				bne charoutloop
				add	r1,#2			// align to word boundary
				ldr r0,=1			// lsb high for thumb
				orr r1,r0
				mov pc,r1

sout:		// send char in r0 to serial (uart one)
				push {R1,R2,r3,LR}
				LDR     R1, =BASE_US1 	// load base address to usart one.
wait4tx1rdy:	LDR		r2,[R1,#US_CSR]	// wait for ready to send
				ldr 	r3,=US_TXRDY
				AND    R2, R3
                BEQ     wait4tx1rdy
				STRB     R0, [R1,#US_THR]	
				pop {R1,R2,r3,PC}

sin:		// return serial char in r0 (uart one)
				push {R1,R2,LR}
				LDR     R1, =BASE_US1 	// load base address to usart one.
wait4rx:		LDR		r2,[R1,#US_CSR] // wait for char
				ldr 	r0,=US_RXRDY
				AND    	R2, R0
				BEQ     wait4rx
				LDRB	r0,[R1,#US_RHR]
				pop {R1,R2,PC}
				
delaysub:  		ldr r2,=0x80000 
delay:			sub r2,#1	
				bne delay
				mov pc,lr
				
ledon:			LDR     R0, =PIO_CODR
				B doled				
ledoff:			LDR     R0, =PIO_SODR
doled:			push {R1,LR}
				ldr     R1,=1<<8
				STR     R1, [R0]
				pop {R1,PC}	

flashled:		push {LR}
				bl 		ledon
				bl 		delaysub
				bl		ledoff
				bl 		delaysub
				pop {PC}	
				
tick:			push {LR} // find word in dict.
				BL 		RTSliteral
				.word 	0x20		// push space code.
				BL		WORD
				CAT
				bl 		DpopR0
				cmp 	r0,#0
				beq		tickerr
				bl 		FIND
				bl 		DpopR0
				cmp 	r0,#0
				beq		tickerr
				pop {PC}	
tickerr:		bl dotquote
				.byte 3 
				.ascii "???"
				.align 1
				bl CR
				pop {pc}			
//--------------------------------------------------------------------------
				
NUMBER:			push 	{lr}
				ldr 	r3,=PAD	// -- false or  True NUM ;only hex in this version. 
				ldrb	r2,[r3]		// get len at PAD
				ldr		r1,=0		// build number here.
				ldr		r4,=1		// neg flag
				add		r3,#1		// inc char pointer to first char.
				ldrb	r0,[r3]		// get char
				cmp		r0,#0x2D
				bne		noinc		// not "-"
				ldr		r4,=0	
				sub		r2,#1
Numloop:		add		r3,#1		// inc char pointer.
noinc:			lsl		r1,#4	
				ldrb	r0,[r3]		// get chars, left char first.
				sub		r0,#0x30	// ie ascii for zero is hex 30.
				bmi		badnum
				cmp		r0,#9		// is is 0 to 9 ?
				ble		addit
				sub		r0,#7		// ascii A is 41
				cmp		r0,#0xf
				bgt		badnum
				cmp		r0,#0xa
				bmi		badnum
addit:			add		r1,r0
				sub		r2,#1
				bgt		Numloop
				cmp		r4,#0
				bne		notneg
				sub		r0,r4,r0
				b		pushnum
notneg:			mov		r0,r1
pushnum:		bl		DpushR0
				ldr		r0,=1
				bl		DpushR0				
				pop		{pc}
badnum:			ldr		r0,=0
				bl		DpushR0				
				pop		{pc}
								
//////////////////////////////////////////////////////////

WORD:								// delim -- padaddr
				push	{lr}
				ldr 	r1,=INPTR
				ldrb	R1,[R1]
				ldr 	r2,=TIB
				ldr 	r3,=PAD
				ldr 	r4,=0		// word len		
	
skiploop:		ldrb	r0,[r1,r2] 	// get char
				cmp		r0,r6		// compare top to skip leading delim
				bne 	wordloop
				cmp		r1,#tibsize
				bge		lineend
				cmp		r0,#0x20
				bmi		lineend	// done when control char found
				add		r1,#1
				b 		skiploop
				
wordloop:		cmp		r0,r6		// compare with top	
				beq		worddone	// done when delim found
				cmp		r0,#0x20
				bmi		lineend	// done when control char found
				add		r3,#1		// inc PADptr
				strb	r0,[r3]		// store char in pad
				add		r4,#1		// inc word length
				add		r1,#1		// inc inptr	
				ldrb	r0,[r1,r2] 	// get char
		
				b		wordloop
				
worddone:		add		r1,#1
lineend:		ldr 	r3,=PAD				
				strb 	r4,[r3]		// set length 
				ldr		r4,=INPTR
				strb	r1,[r4]		// save inptr
				mov		r6,r3		// replace top with PAD address
//				mov 	pc,lr
				pop 	{pc}
				
//--------------------------------------------------------------------------

TYPE:		// addr -- ; note cmforth left the next address at top. ans doesn't
				push 	{lr}
				bl 		DpopR0
				mov 	r2,r0		// mov so emit can use r0
				ldrb	r1,[r2]		// get count
typeloop:		sub		r1,#1
				bmi		typedone
				add		r2,#1
				ldrb	r0,[r2]
//				bl		sout
				bl		emitr0
				b		typeloop
typedone:		pop		{pc}

//--------------------------------------------------------------------------

lfa2ca:			add 	r6,#4			// advance to flags	
				ldrb	r1,[r6]			// get flags to r1
				add 	r6,#1			// advance to word Cstring
				ldrb	r0,[r6]			// get length
				add 	r6,r0			// advance r6 to last char.
				ldr		r0,=F_REMT
				and		r1,r0 		// check the remote flag.
				bne		remoteCA		// if set the code is remote.
				ldr		r0,=1			// local - halfword align.
				orr		r6,r0
				add		r6,#1
				mov		pc,lr
remoteCA:		ldr		r0,=3		// Remote - word aligh and fetch
				orr		r6,r0
				add		r6,#1
				AT
				mov		pc,lr
				
//--------------------------------------------------------------------------
EXECUTE:		push	{lr}		// we need to push lr for [CON] etc to work properly.
				bl 		DpopR0
				add		r0,#1			// lsb set for thumb mode, OR have odd address in dic.
				add		r1,pc,#4
				mov		lr,r1
				bx		r0
				add		r0,#0			// a nop
				pop 	{pc}

INTERPRET:		push {lr}
interloop:		ldr 	r0,=0x20
				bl		DpushR0
				bl 		WORD
				CAT
				bl 		DpopR0
				cmp 	r0,#0
				beq		leaveinterp
				bl 		FIND
				bl 		DpopR0
				cmp 	r0,#0
				beq		notfound
				bl		lfa2ca
	//			bl		DpopR0
				bl 		EXECUTE
		//		BL 		flashled
				b		interloop
notfound:		bl		NUMBER
				bl		DpopR0
				cmp		r0,#0
				bne		interloop
				ldr 	r0,=PAD
				bl 		DpushR0
				bl		TYPE
				bl dotquote
				.byte 3 
				.ascii " ??"
				.align 1
				bl CR
leaveinterp:	pop {pc}

GETLINE:		push {lr}
				ldr r0,=0				// reset in text buffer pointer		
				ldr r1,=INPTR
				strb R0,[R1]
				ldr r1,=TIB
keygetloop:		bl sin
				cmp r0,#0x9			// convert tabs to spaces
				bne notab
				ldr r0,=0x20
notab:			strb r0,[r1]
				add r1,#1
				cmp r0,#0xd
				bne keygetloop	
				pop {pc}

QUIT:
				bl GETLINE
				bl CR				
				bl INTERPRET	
			
//		DEPTH
//		0 < IF ABORT" DATA STACK UNDERFLOW!!" THEN
//		ECHO @ IF ." ok " CR THEN
//	AGAIN
//;
//				bl flashled
				bl SPACE
				bl dotquote
.byte 2 
.ascii "OK"
.align 1
				bl CR				
				B QUIT
		
Iat:	// @ for interpreter
			AT
			mov pc,lr
Icat:	// C@ for interpreter
			CAT
			mov pc,lr	


emitr0:			push {R1,R2,r3,LR}
				ldr r3,=OUTPTR			// load address of out char pointer
				ldrb r2,[r3]			// load the pointer
				cmps r2,#(tobsize)
				bge endemit
				ldr r1,=TOB
				strb r0,[r1,r2]
				add r2,r2,#1
				strb r2,[r3]
endemit:		pop {R1,R2,r3,PC}
				
CR:				push {R1,R2,r3,LR}
				ldr r3,=OUTPTR		// load address of out char pointer
				ldrb r2,[r3]		// load the pointer
				ldr r1,=TOB			// load the buffer address
crloop:			sub r2,#1			// dec the pointer - used as loop cnt
				bmi endcr			// leave if zero		
				ldrb r0,[r1]	// get char from buffer, inc bufferptr
				add r1, #1
				bl sout				// send it
				b crloop			// loop back
endcr:			ldr r0,=0xd			// send cr lf
				bl sout
				ldr r0,=0xa
				bl sout
				ldrb r2,=0			// set char point to zero
				strb r2,[r3]	
				pop {R1,R2,r3,PC}
				
RTliteral:		// get the word at LR to top and advance LR.
				mov 	r1,lr			// we can't use LR with ldr so copy it
				add	 	r1,#2			// LR/R1 will be odd in thumb
				ldr		r2,=-4			// word align
				and		r1,r2
				ldr 	r0,[r1]
				add		r1,#5			// adjust to next inst plus one.
				mov 	lr,r1
				b		DpushR0

RTSliteral:		// get the word at LR to top and advance LR.
				mov 	r1,lr			// we can't use LR with ldr so copy it
				ldr		r2,=-2			// hword align
				and		r1,r2
				ldrh 	r0,[r1]
				add		r1,#3			// adjust to next inst plus one.
				mov 	lr,r1
				b		DpushR0
//--------------------------------------------------------------------------			
SPstore:		// reset data stack
	ResetDstack
	mov pc,lr	
	
	//--------------------------------------------------------------------------			
			
comma:		push 	{lr}
			bl		DP		//	-- VAL DP	

			bl		SWAP	//  -- DP VAL
			bl		OVER	//  -- DP VAL DP
			AT				//  -- DP VAL *DP
			add		r6,#3
			ldr		r2,=-4			// word align
			and		r6,r2
			bl		SWAP	//  -- DP *DP VAL
			bl		OVER	//  -- DP *DP VAL *DP
			bl		store	//  -- DP *DP

			add		r6,#4	//	--  DP Nextfree
			bl		SWAP	//  --  NF DP
			bl		store	//	-- 
			pop		{pc}
			
Ccomma:		push 	{lr}
			bl		DP		//	-- VAL DP	
			bl		SWAP	//  -- DP VAL
			bl		OVER	//  -- DP VAL DP
			AT				//  -- DP VAL *DP
			bl		Cstore	//  -- DP
			
			bl		DUP		//	--  DP DP
			AT				//	--  DP *DP 
			add		r6,#1	//	--  DP Nextfree
			bl		SWAP	//  --  NF DP
			bl		store	//	-- 
			pop		{pc}
			
Hcomma:		push 	{lr}
			bl		DP		//	-- VAL DP	
			bl		SWAP	//  -- DP VAL
			bl		OVER	//  -- DP VAL DP
			AT				//  -- DP VAL *DP
			bl		OVER
			bl		OVER


			
			bl		Cstore	//  -- DP		
			add		r6,#1	//	-- DP Nextfree
			asr		r5,#8			
			bl		Cstore	//  -- DP
			
			bl		DUP		//	--  DP DP
			AT				//	--  DP *DP 
			add		r6,#2	//	--  DP Nextfree
			bl		SWAP	//  --  NF DP
			bl		store	//	-- 
			pop		{pc}

comment:	push 	{lr} // Scan for ) or end of line
				ldr 	r0,=0x29
				bl		DpushR0
				bl 		WORD
				bl 		DpopR0
			pop		{pc}
//--------------------------------------------------------------------------			

FIND:		push	{lr}

			bl		CONTEXT			// get the link to vocab onto top.
loopfind:	AT						// @ it to get the address of the first word
			cmp 		r6,#0			// check for zero - ie end of list
			beq			endfind			// if so word was not found.
			add 		R4,r6,#5			// advance to word Cstring
			// now compare PAD with word.
			ldr 		r3,=PAD
			ldrb		r1,[r4]		// get dic word count to r1
			ldrb		r0,[r3]		// get len at PAD
			cmp			r0,r1		// compare length
			bne			loopfind	// not equal try next word.	
wrdcmplp:	ldrb		r0,[r4,r1]		//  r1 = count.
			ldrb		r2,[r3,r1]
			cmp			r0,r2
			bne			loopfind		// not equal try next word.
			sub			r1,#1
			beq			foundit
			b			wrdcmplp		// loop back
foundit:	ldr			r0,=1
			bl			DpushR0			// push true flag onto stack.
endfind:	pop			{pc}			// top has true+LFA or false		

CONTEXT:	ldr		r0,=VARCONTEXT
			b 		DpushR0	

DP:			ldr		r0,=VARDP
			b 		DpushR0		
			
//' debuging code which will be removed from finished kernel.
pushhex:		push 	{r1,lr}
				ldr		r1,=0xf
				and		r0,r1
				cmp		r0,#9
				ble		underA
				add		r0,#7
underA:			
				add		r0,#0x30
				bl		DpushR0
				pop  	{r1,pc}
 
dothexN:		PUSH	{R1}
				mov r2,r6
				bl DpopR0
dohexdigit:
				mov r0,r2
				bl pushhex					
				lsr r2,r2,#4
				sub r1,#1
				bne dohexdigit

				POP	{r1}
hexout:			bl EMIT
				sub	r1,#1
				bne hexout
				bl SPACE
				pop {R1,R2,pc}

dothex8:// print top as 2 hex digits
				push {r1,R2,lr}
				ldr	r1,=2
				b dothexN

dothex32:// print top as 8 hex digits
		push {r1,R2,lr}
		ldr	r1,=8
		b dothexN		
//--------------------------------------------------------------------------

dotS:			push	{lr}
				ldr		r1,=DSTCK
				cmp		R1,R7
				bge		leavedots	
				mov		r0,r6
				bl		DpushR0
				bl		dothex32
				bl 		CR
				add		r1,#4
				cmp		R1,R7
				bge		leavedots	
				mov		r0,r5
				bl		DpushR0
				bl		dothex32
				bl 		CR
				mov		r1,R7
dotSloop:		sub		r1,#4
				ldr 	r0,=DSTCK+4
				cmp		R1,r0
				ble		leavedots
				ldr		r0,[r1]			
				bl		DpushR0
				bl		dothex32
				bl 		CR
				b		dotSloop
leavedots:		pop 	{pc}

B leavedots

	mov r0,lr
self: b self
.arm