Alignment guards

arm/words/2fetch.asm

@@ -11,6 +11,11 @@ SHORT: Fetch cell pair x1 x2 stored at a x2 is stored at a and x1 at the next co
 @------------------------------------------------------------------------------
   CODEWORD  "2@",2FETCH @ Fetch ( addr -- d )
 @------------------------------------------------------------------------------
+
+  ands r0, tos, #0x3     /* cell aligned?         */
+  beq  1f                /* branch if OK          */
+  throw EADRINV          /* not aligned so throw  */
+1:                       /* normal operation      */
   subs psp, #4
   ldr r0, [tos, #4]
   str r0, [psp]

arm/words/2store.asm

@@ -11,6 +11,10 @@ SHORT: Store cell pair x1 x2 at a, with x2 at a and x1 at the next consecutive c
 @------------------------------------------------------------------------------
   CODEWORD  "2!",2STORE @ Store ( d addr -- )
 @------------------------------------------------------------------------------
+  ands r0, tos, #0x3     /* cell aligned?         */
+  beq  1f                /* branch if OK          */
+  throw EADRINV          /* not aligned so throw  */
+1:                       /* normal operation      */
   ldmia psp!, {r1, r2}
   str r1, [tos]
   str r2, [tos, #4]

arm/words/fetch.s

@@ -1,5 +1,10 @@
 @ -----------------------------------------------------------------------------
   CODEWORD "@", FETCH @ ( 32-addr -- x )
 @ -----------------------------------------------------------------------------
+
+  ands r0, tos, #0x3     /* cell aligned?         */
+  beq  1f                /* branch if OK          */
+  throw EADRINV          /* not aligned so throw  */
+1:                       /* normal operation      */ 
   ldr tos, [tos]
 NEXT

arm/words/store.s

@@ -1,5 +1,10 @@
 @ -----------------------------------------------------------------------------
   CODEWORD "!", STORE @ ( x 32-addr -- )
+
+  ands r0, tos, #0x3     /* cell aligned?         */
+  beq  1f                /* branch if OK          */
+  throw EADRINV          /* not aligned so throw  */
+1:                       /* normal operation      */ 
   ldm psp!, {r0, r1} @ X is the new TOS after the store completes.
   str r0, [tos]      @ Popping both saves a cycle.
   movs tos, r1

core/dict_secs.inc

@@ -268,3 +268,5 @@
 
 .include "words/evaluate.s"
 .include "words/break.s"
+
+.include "words/chkdalign.s"

core/words/chkdalign.s

@@ -0,0 +1,21 @@
+# SPDX-License-Identifier: GPL-3.0-only
+/*
+WORD:  chkdalign
+STACK: ( -- ) 
+MOTIF: 
+CATEG: system
+STDID: 
+SHORT: check DP for cell alignment, throw exception (-9) if not 
+*/
+
+COLON "chkdalign", CHKDALIGN 
+	.word XT_DP
+	.word XT_DUP
+	.word XT_ALIGNED
+	.word XT_MINUS
+	.word XT_DOCONDBRANCH,CHKDALIGN_0001 /* if */
+	.word XT_DOLITERAL
+	.word EADRINV
+	.word XT_THROW
+CHKDALIGN_0001: /* then */
+	.word XT_EXIT

core/words/comma.s

@@ -2,7 +2,8 @@
 
 DEFER "(,)", LPARENCOMMARPAREN , XT_NOP  
 
-COLON ",", COMMA 
+COLON ",", COMMA
+    .word XT_CHKDALIGN
     .word XT_MEMMODE
     .word XT_DOCONDBRANCH,COMMA_0001 /* if */
     .word XT_LPARENCOMMARPAREN

core/words/header.s

@@ -2,7 +2,7 @@
 # MFD VALUE "header.flag" , HEADERDOTFLAG, 0x33
 
 COLON "header", HEADER
-
+    .word XT_DALIGN
     .word XT_OVER,XT_GREATERZERO 
     .word XT_DOCONDBRANCH, PFA_HEADER1
     .word XT_EXECUTE

rv/macros.inc

@@ -92,5 +92,9 @@
   NEXT
 .endm
 
-
-
+.macro throw , exception
+    savetos                /* for good order        */
+    li s3,\exception       /* load exception number */
+    la s1, XT_THROW        /* move XT to W reg      */
+    j DO_EXECUTE           /* execute via ITC VM    */
+.endm

rv/words/2fetch.asm

@@ -11,8 +11,18 @@ SHORT: Fetch cell pair x1 x2 stored at a x2 is stored at a and x1 at the next co
 #------------------------------------------------------------------------------
   CODEWORD  "2@",2FETCH # Fetch ( addr -- d )
 #------------------------------------------------------------------------------
+
+  andi t0, s3, 0x3       /* cell aligned ?        */
+  beqz t0, 1f            /* branch if OK          */
+
+  /* handle exception ...                         */
+
+  throw EADRINV
+
+1: /* normal operation ...                        */
+
   addi s4, s4, -4
   lw   t0, 4(s3)
   sw   t0, 0(s4)
   lw   s3, 0(s3)
-NEXT
+  NEXT

rv/words/2store.asm

@@ -11,11 +11,21 @@ SHORT: Store cell pair x1 x2 at a, with x2 at a and x1 at the next consecutive c
 #------------------------------------------------------------------------------
   CODEWORD  "2!",2STORE # Store ( d addr -- )
 #------------------------------------------------------------------------------
+
+  andi t0, s3, 0x3       /* cell aligned ?        */
+  beqz t0, 1f            /* branch if OK          */
+
+  /* handle exception ...                         */
+
+  throw EADRINV
+
+1: /* normal operation ...                        */
+
   lw t0, 0(s4)
   lw t1, 4(s4)
   addi s4, s4, 8
   sw t0, 0(s3)	
   sw t1, 4(s3)	
   lw s3, 0(s4)
   addi s4, s4, 4
-NEXT
+  NEXT

rv/words/fetch.s

@@ -1,4 +1,15 @@
 # SPDX-License-Identifier: GPL-3.0-only
   CODEWORD "@", FETCH # ( a -- n ) MEM: TOS becomes contents of address a 
-  lw s3, 0(s3)
-  NEXT
+
+    andi t0, s3, 0x3       /* cell aligned ?        */
+    beqz t0, 1f            /* branch if OK          */
+
+    /* handle exception ...                         */
+
+    throw EADRINV
+
+1:  /* normal operation ...                         */
+
+    lw s3, 0(s3)
+
+    NEXT

rv/words/store.s

@@ -1,24 +1,19 @@
 # SPDX-License-Identifier: GPL-3.0-only
-  CODEWORD "!", STORE # ( n a -- ) MEM: Store n in memory address a 
-  lw t0, 0(s4)
-  sw t0, 0(s3)
-  lw s3, 4(s4)
-  addi s4, s4, 8
-  NEXT
 
-#   CODEWORD "(!)", BRASTORE # ( n a -- ) MEM: Store n in memory address a 
-#   lw t0, 0(s4)
-#   sw t0, 0(s3)
-#   lw s3, 4(s4)
-#   addi s4, s4, 8
-#   NEXT
+  CODEWORD "!", STORE # ( n a -- ) MEM: Store n in memory address a
+
+    andi t0, s3, 0x3       /* cell aligned ?        */
+    beqz t0, 1f            /* branch if OK          */
+
+    /* handle exception ...                         */
+
+    throw EADRINV
+
+1:  /* normal operation ...                         */
+
+    lw t0, 0(s4)
+    sw t0, 0(s3)
+    lw s3, 4(s4)
+    addi s4, s4, 8
+    NEXT
 
-# COLON "!", STORE
-# 	.word XT_MEMMODE
-# 	.word XT_DOCONDBRANCH,STORE_0001 # if
-#     .word XT_BANGI
-# 	.word XT_DOBRANCH,STORE_0002
-# STORE_0001: # else
-#     .word XT_BRASTORE
-# STORE_0002: # then
-# 	.word XT_EXIT