From 166588d4167314db3bde2a17aa91c2405f031edc Mon Sep 17 00:00:00 2001 From: surfblink Date: Thu, 29 Jan 2026 11:25:28 +0000 Subject: [PATCH 1/5] alignment guards --- arm/words/fetch.s | 5 +++++ arm/words/store.s | 5 +++++ core/dict_secs.inc | 2 ++ core/words/chkdalign.s | 21 +++++++++++++++++++++ core/words/comma.s | 3 ++- core/words/header.s | 2 +- rv/words/fetch.s | 13 ++++++++++++- rv/words/store.s | 37 ++++++++++++++++--------------------- 8 files changed, 64 insertions(+), 24 deletions(-) create mode 100644 core/words/chkdalign.s diff --git a/arm/words/fetch.s b/arm/words/fetch.s index 7262fd2..487110f 100644 --- a/arm/words/fetch.s +++ b/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 -9 /* not aligned so throw */ +1: /* normal operation */ ldr tos, [tos] NEXT diff --git a/arm/words/store.s b/arm/words/store.s index f57961a..ff58b06 100644 --- a/arm/words/store.s +++ b/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 -9 /* 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 diff --git a/core/dict_secs.inc b/core/dict_secs.inc index 5c9862a..749e965 100644 --- a/core/dict_secs.inc +++ b/core/dict_secs.inc @@ -268,3 +268,5 @@ .include "words/evaluate.s" .include "words/break.s" + +.include "words/chkdalign.s" diff --git a/core/words/chkdalign.s b/core/words/chkdalign.s new file mode 100644 index 0000000..78a66e5 --- /dev/null +++ b/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 -9 + .word XT_THROW +CHKDALIGN_0001: # then + .word XT_EXIT diff --git a/core/words/comma.s b/core/words/comma.s index 94574e3..a915b02 100644 --- a/core/words/comma.s +++ b/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 diff --git a/core/words/header.s b/core/words/header.s index 65d9fe5..3a2f1b5 100644 --- a/core/words/header.s +++ b/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 diff --git a/rv/words/fetch.s b/rv/words/fetch.s index 2445ea2..06bd621 100644 --- a/rv/words/fetch.s +++ b/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) + + andi t0, s3, 0x3 /* cell aligned ? */ + beqz t0, 1f /* branch if OK */ + + /* handle exception ... */ + + throw -9 + +1: /* normal operation ... */ + + lw s3, 0(s3) + NEXT diff --git a/rv/words/store.s b/rv/words/store.s index 5b94472..9ca1c9f 100644 --- a/rv/words/store.s +++ b/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 -9 + +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 From 95492d376d157f6c1268df5e019815d19748006e Mon Sep 17 00:00:00 2001 From: surfblink Date: Thu, 29 Jan 2026 11:31:59 +0000 Subject: [PATCH 2/5] add modified macros.inc --- rv/macros.inc | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/rv/macros.inc b/rv/macros.inc index 7699bfa..68e47e2 100644 --- a/rv/macros.inc +++ b/rv/macros.inc @@ -92,5 +92,9 @@ NEXT .endm - - \ No newline at end of file +.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 \ No newline at end of file From d6c1b69c8c6171ceb3729c032775760cb4fa03a4 Mon Sep 17 00:00:00 2001 From: surfblink Date: Thu, 29 Jan 2026 11:36:10 +0000 Subject: [PATCH 3/5] fix comments --- core/words/chkdalign.s | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/words/chkdalign.s b/core/words/chkdalign.s index 78a66e5..5d732e7 100644 --- a/core/words/chkdalign.s +++ b/core/words/chkdalign.s @@ -13,9 +13,9 @@ COLON "chkdalign", CHKDALIGN .word XT_DUP .word XT_ALIGNED .word XT_MINUS - .word XT_DOCONDBRANCH,CHKDALIGN_0001 # if + .word XT_DOCONDBRANCH,CHKDALIGN_0001 /* if */ .word XT_DOLITERAL .word -9 .word XT_THROW -CHKDALIGN_0001: # then +CHKDALIGN_0001: /* then */ .word XT_EXIT From 084fc479c92d51f24357e356253c4dbd995bdb01 Mon Sep 17 00:00:00 2001 From: surfblink Date: Thu, 29 Jan 2026 11:54:41 +0000 Subject: [PATCH 4/5] fix EOL warning --- rv/macros.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rv/macros.inc b/rv/macros.inc index 68e47e2..34d5cbf 100644 --- a/rv/macros.inc +++ b/rv/macros.inc @@ -97,4 +97,4 @@ li s3,\exception /* load exception number */ la s1, XT_THROW /* move XT to W reg */ j DO_EXECUTE /* execute via ITC VM */ -.endm \ No newline at end of file +.endm From 981a8d771a84c932c49fb056b7ae259902100953 Mon Sep 17 00:00:00 2001 From: surfblink Date: Thu, 29 Jan 2026 17:20:22 +0000 Subject: [PATCH 5/5] use symbols, add guards to asm versions of 2@ 2! --- arm/words/2fetch.asm | 5 +++++ arm/words/2store.asm | 4 ++++ arm/words/fetch.s | 2 +- arm/words/store.s | 2 +- core/words/chkdalign.s | 2 +- rv/words/2fetch.asm | 12 +++++++++++- rv/words/2store.asm | 12 +++++++++++- rv/words/fetch.s | 6 +++--- rv/words/store.s | 2 +- 9 files changed, 38 insertions(+), 9 deletions(-) diff --git a/arm/words/2fetch.asm b/arm/words/2fetch.asm index b63c072..736210a 100644 --- a/arm/words/2fetch.asm +++ b/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] diff --git a/arm/words/2store.asm b/arm/words/2store.asm index 7999425..27b5137 100644 --- a/arm/words/2store.asm +++ b/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] diff --git a/arm/words/fetch.s b/arm/words/fetch.s index 487110f..f43decb 100644 --- a/arm/words/fetch.s +++ b/arm/words/fetch.s @@ -4,7 +4,7 @@ ands r0, tos, #0x3 /* cell aligned? */ beq 1f /* branch if OK */ - throw -9 /* not aligned so throw */ + throw EADRINV /* not aligned so throw */ 1: /* normal operation */ ldr tos, [tos] NEXT diff --git a/arm/words/store.s b/arm/words/store.s index ff58b06..a6647a0 100644 --- a/arm/words/store.s +++ b/arm/words/store.s @@ -3,7 +3,7 @@ ands r0, tos, #0x3 /* cell aligned? */ beq 1f /* branch if OK */ - throw -9 /* not aligned so throw */ + 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. diff --git a/core/words/chkdalign.s b/core/words/chkdalign.s index 5d732e7..23f45fe 100644 --- a/core/words/chkdalign.s +++ b/core/words/chkdalign.s @@ -15,7 +15,7 @@ COLON "chkdalign", CHKDALIGN .word XT_MINUS .word XT_DOCONDBRANCH,CHKDALIGN_0001 /* if */ .word XT_DOLITERAL - .word -9 + .word EADRINV .word XT_THROW CHKDALIGN_0001: /* then */ .word XT_EXIT diff --git a/rv/words/2fetch.asm b/rv/words/2fetch.asm index 08e6696..6506c9a 100644 --- a/rv/words/2fetch.asm +++ b/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 diff --git a/rv/words/2store.asm b/rv/words/2store.asm index 09af2cd..133b836 100644 --- a/rv/words/2store.asm +++ b/rv/words/2store.asm @@ -11,6 +11,16 @@ 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 @@ -18,4 +28,4 @@ SHORT: Store cell pair x1 x2 at a, with x2 at a and x1 at the next consecutive c sw t1, 4(s3) lw s3, 0(s4) addi s4, s4, 4 -NEXT + NEXT diff --git a/rv/words/fetch.s b/rv/words/fetch.s index 06bd621..1bc75c1 100644 --- a/rv/words/fetch.s +++ b/rv/words/fetch.s @@ -6,10 +6,10 @@ /* handle exception ... */ - throw -9 + throw EADRINV 1: /* normal operation ... */ lw s3, 0(s3) - - NEXT + + NEXT diff --git a/rv/words/store.s b/rv/words/store.s index 9ca1c9f..fd81c61 100644 --- a/rv/words/store.s +++ b/rv/words/store.s @@ -7,7 +7,7 @@ /* handle exception ... */ - throw -9 + throw EADRINV 1: /* normal operation ... */