[OpenSPARC-T2-SAM] / obp / obp / pkg / fcode / memtest.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: memtest.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)memtest.fth 2.16 01/04/06
purpose: 
copyright: Copyright 1999-2001 Sun Microsystems, Inc.  All Rights Reserved

\ TODO: Make this interruptible

\ Generic memory test module.  This will test pretty much any memory
\ array, given the address, size, and width of the array.
\
\ Variables:
\   mask		Contains a bit mask with ones for each data bit
\			which is implemented in the memory array.  Examples:
\			A 32-bit memory array would use mask = (hex)ffffffff.
\			A 24-bit memory array would use mask = (hex)00ffffff.
\
\   mem@		Defer word which by default executes l@ .  Change this
\			if your memory cannot handle 32-bit operations.
\
\   mem!		Defer word which by default executes l! .  Change this
\			if your memory cannot handle 32-bit operations.
\
\ Tests:
\
\ mem-addr-test  ( membase memsize -- fail-flag )
\			In the memory array starting at membase, tests
\			the address lines for the following static
\			faults:
\			a) Address line stuck
\			b) Address line shorted to another address line
\			c) Address line shorted to a data line
\
\			This test is quite fast; it's execution time is
\			O(#add-lines).
\
\ mem-data-test  ( membase -- fail-flag )
\			"Walking Ones and Zeroes" data line test.  Tests
\			each data line for static "stuck-at" faults.  The
\			value contained in the "mask" variable controls
\			which data lines are tested.
\
\ mem-size-test  ( membase -- fail-status )
\			Verifies that memory can be accessed either as
\			bytes, shortwords, or longwords.  Writes the
\			hex number 12345678 to the location at membase,
\			one byte at a time.  Then reads it back as a longword
\			and checks the value.  Then does the same thing
\			writing one shortword at a time.
\			The "mask" variable selects which data bits are
\			significant.
\
\ mem-bits-test  ( membase memsize -- status )
\			Within the range membase .. membase+memsize-1, tests
\			each location to ensure that no bits are stuck at
\			either one or zero.  This is done by verifying that the
\			location can contain both the value ffffffff and
\			the value 0.  The "mask" variable selects which data
\			bits are significant.
\
\ address=data-test  ( membase memsize -- fail-flag )
\			Within the range membase .. membase+memsize-1,
\			writes each longword location with it's own address,
\			then verifies.  The "mask" variable selects which
\			data lines are significant during the verify step.
\			This test checks for the uniqueness of individual
\			locations with RAM chips.  "Stuck" address lines
\			external to RAM chips would presumably be detected
\			more quickly by "mem-addr-test".
\
\ mats-test  ( membase memsize pattern -- fail-flag )
\			Within the range membase .. membase+memsize-1, tests
\			groups of 3 consecutive locations.  The first and third
\                       locations in the group are written with "pattern"
\			and the second location is written with the bitwise
\			inverse of "pattern".  Verifies the data bits selected
\			by the "mask" variable.
\			I'm not sure what kind of failures that this test
\			can catch, other than failures that are more easily
\			detected by other tests.
\
\ memory-test-suite  ( membase memsize -- status )
\			Performs a series of tests on the range of memory
\			from membase to membase+memsize-1.

hex

headerless
defer mem!  ' l! is mem!
defer mem@  ' l@ is mem@
headers
: display-status ( n -- )  drop  ;
variable group-code
nuser mask  mask on
headerless

: maskit  ( value -- masked-value )  mask @ n->l  and  ;

nuser mem-address
nuser mem-expected
nuser mem-observed

nuser failed		\ Local
: .mem-test-failure ( -- )
   ??cr
   ." Addr ="  mem-address  @ .lx
   ."  Exp ="  mem-expected @ dup .lx
   ."  Obs ="  mem-observed @ dup .lx
   ."  Xor ="  xor .lx
   ??cr
;

: ?failed  ( observed expected -- )
   2dup  <>  if
       mem-expected !  mem-observed !  failed on
   else
       2drop
   then
;

: mem-test  ( value address -- )
   dup mem-address !  mem@ maskit  swap maskit  ?failed
;

\ "Walking Address Line" test ( quick )

\ The following routine tests an individual address line for the
\ following static faults:
\    a) stuck at either 0 or 1
\    b) shorted to a data line
\    c) shorted to another address line
\ Sets the failed variable if a failure is detected

nuser add-base
nuser add-top
: address-line-test  ( addr# -- )

   \ First we write all zeroes to the top and bottom memory locations
   0 add-base @ mem!   0 add-top  @ mem!

   \ Now we write all ones to 2 locations: the location whose address
   \ differs from the bottom address only by the address line under test,
   \ and the location whose address differs from the top address only by
   \ the address line under test.

   1 over <<			( addr# offset )
   add-base @ over +  ffffffff swap mem! \ store ones at "base + [1 << addr#]"
   add-top  @ over -  ffffffff swap mem! \ store ones at "top  - [1 << addr#]"
				( addr# offset )

   \ Now we check to see if either of the top or bottom locations got
   \ clobbered when we wrote the other two locations.  This tests for
   \ address uniqueness in the one address line, and also for that address
   \ line stuck to a data line.

   0  add-base @  mem-test
   0  add-top  @  mem-test

   \ Finally, we do the whole thing again, except that we use the opposite
   \ data values.  This allows us to distinguish a stuck address line
   \ from an address line shorted to a data line.  We don't actually
   \ use this distinction, since the only output from this entire test
   \ is "good" or "bad".

				( addr# offset )
   ffffffff add-base @ mem!	\ store all ones into bottom of memory
   ffffffff add-top  @ mem!	\ store all ones into top of memory

   add-base @ over +  0 swap mem! \ store 0 at location "base + [ 1 << addr#]"
   add-top  @ over -  0 swap mem! \ store 0 at location "top - [ 1 << addr#]"

   ffffffff add-base @  mem-test
   ffffffff add-top  @  mem-test
				( addr# offset )

   \ If more detailed failure analysis were desired, we could distinguish
   \ between the various places where the test could fail.
   \ For now, we just return pass or fail.

   ( addr# offset )  2drop  ( )
;

\ This test loops over all the address lines, testing each of them
\ with the above "address-line-test"

: mem-addr-test  ( membase memsize -- fail-flag )
   "     Address quick test" diag-type

   failed off			\ set failed flag false

   tuck bounds			( memsize memtop membase )
   add-base !  /l - add-top !   ( memsize )

   \ Calculate the number of address lines to test
   log2				( #adr-lines )

   \ Loop over the address line numbers  2  ..  #adr-lines - 1
   \ Address lines 0 and 1 are byte and word selectors, which are
   \ not appropriate to test with this procedure

   ( #adr-lines )  2  do  i address-line-test  loop
   failed @			\ place failed flag on stack
;

: mem-size-test  ( membase -- fail-status )
   "     Data size test" diag-type

   failed off		\ set failed flag to false

   \ write data in word size
   h# 1234 over w!  h# 5678 over wa1+ w!     ( membase )

   h# 12345678  over  mem-test               ( membase )

   \ write data in byte size
   h# 12 over 0 ca+ c!  h# 34 over 1 ca+ c!
   h# 56 over 2 ca+ c!  h# 78 over 3 ca+ c!  ( membase )

   h# 12345678  over  mem-test               ( membase )
   drop
   failed @			\ place failed flag on stack
;

: mem-data-test ( membase -- fail-status )
   "     Data lines test" diag-type
   failed off			\ set failed flag to false

   \ Walking ones
    				( membase )
   d# 32 0 do			\ loop over all 32 data lines
      1 i <<  over  mem!	( membase )
      1 i <<  over  mem-test	( membase )
   loop                         ( membase )

   \ Walking zeroes
   d# 32 0 do			 \ loop over all 32 data lines
      1 i << invert  over  mem!	     ( membase )
      1 i << invert  over  mem-test  ( membase )
   /l +  loop                        ( membase )

   drop                         ( )
   failed @			\ put failed flag onto the stack
;

: mem-bits-test  ( membase memsize -- fail-status )
   "     Data bits test" diag-type
   failed off			\ set failed flag to false

   bounds			( memtop membase )
   2dup  ?do  h# ffffffff  i  2dup mem!  mem-test  /l +loop	\ stuck at 0 test
         ?do  h# 00000000  i  2dup mem!  mem-test  /l +loop	\ stuck at 1 test

   failed @			\ put failed flag onto the stack
;

: address=data-test  ( membase memsize -- status )
   "     Address=data test"  diag-type

   bounds  2dup  do  i i mem!  /l +loop	( memtop membase )

   failed off
   do  i i mem-test  /l +loop
   failed @			\ return failed flag on stack
;

\ This test writes groups of 3 consecutive locations.  The first and
\ third locations in the group are written with a pattern, and the second
\ location is written with the inverse of the pattern.

nuser mats-pattern
: mats-test  ( membase memsize pattern -- status )
   "     Mats test"  diag-type
   mats-pattern !

   bounds  2dup  do
      mats-pattern @
      dup          i       mem!
      dup  invert  i 1 la+ mem!
                   i 2 la+ mem!
   /l 3 * +loop

   failed off		( memtop membase )
   do
      mats-pattern @
      dup         i       mem-test
      dup  invert i 1 la+ mem-test
                  i 2 la+ mem-test
   /l 3 * +loop
   failed @
;

warning @ warning off 
nuser failed	\ Intentional redefinition
warning !
: ?fail  ( flag -- )
   ?dup  if
      failed @  max  failed !  ( )
      "  -- failed."  diag-type
   else
      "  -- succeeded." diag-type
   then  diag-cr
;
headers
: memory-test-suite  ( membase memsize -- status )
   failed off

   over  mem-data-test  ?fail   ( membase memsize )
   2dup  mem-addr-test  ?fail   ( membase memsize )
   over  mem-size-test  ?fail   ( membase memsize )
   diagnostic-mode?  if
      2dup mem-bits-test      ?fail   ( membase memsize )
      2dup address=data-test  ?fail   ( membase memsize )
\ Don't do the mats test, because I'm not convinced that it is useful
\       2dup h# a5a5a5a5  mats-test  ?fail   ( membase memsize )
   then
   2drop

   failed @
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: memtest.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)memtest.fth 2.16 01/04/06
	43	purpose:
	44	copyright: Copyright 1999-2001 Sun Microsystems, Inc. All Rights Reserved
	45
	46	\ TODO: Make this interruptible
	47
	48	\ Generic memory test module. This will test pretty much any memory
	49	\ array, given the address, size, and width of the array.
	50	\
	51	\ Variables:
	52	\ mask Contains a bit mask with ones for each data bit
	53	\ which is implemented in the memory array. Examples:
	54	\ A 32-bit memory array would use mask = (hex)ffffffff.
	55	\ A 24-bit memory array would use mask = (hex)00ffffff.
	56	\
	57	\ mem@ Defer word which by default executes l@ . Change this
	58	\ if your memory cannot handle 32-bit operations.
	59	\
	60	\ mem! Defer word which by default executes l! . Change this
	61	\ if your memory cannot handle 32-bit operations.
	62	\
	63	\ Tests:
	64	\
65	\ mem-addr-test ( membase memsize -- fail-flag )
66	\ In the memory array starting at membase, tests
67	\ the address lines for the following static
68	\ faults:
69	\ a) Address line stuck
70	\ b) Address line shorted to another address line
71	\ c) Address line shorted to a data line
72	\
73	\ This test is quite fast; it's execution time is
74	\ O(#add-lines).
75	\
76	\ mem-data-test ( membase -- fail-flag )
77	\ "Walking Ones and Zeroes" data line test. Tests
78	\ each data line for static "stuck-at" faults. The
79	\ value contained in the "mask" variable controls
80	\ which data lines are tested.
81	\
82	\ mem-size-test ( membase -- fail-status )
83	\ Verifies that memory can be accessed either as
84	\ bytes, shortwords, or longwords. Writes the
85	\ hex number 12345678 to the location at membase,
86	\ one byte at a time. Then reads it back as a longword
87	\ and checks the value. Then does the same thing
88	\ writing one shortword at a time.
89	\ The "mask" variable selects which data bits are
90	\ significant.
91	\
92	\ mem-bits-test ( membase memsize -- status )
93	\ Within the range membase .. membase+memsize-1, tests
94	\ each location to ensure that no bits are stuck at
95	\ either one or zero. This is done by verifying that the
96	\ location can contain both the value ffffffff and
97	\ the value 0. The "mask" variable selects which data
98	\ bits are significant.
99	\
100	\ address=data-test ( membase memsize -- fail-flag )
101	\ Within the range membase .. membase+memsize-1,
102	\ writes each longword location with it's own address,
103	\ then verifies. The "mask" variable selects which
104	\ data lines are significant during the verify step.
105	\ This test checks for the uniqueness of individual
106	\ locations with RAM chips. "Stuck" address lines
107	\ external to RAM chips would presumably be detected
108	\ more quickly by "mem-addr-test".
109	\
110	\ mats-test ( membase memsize pattern -- fail-flag )
111	\ Within the range membase .. membase+memsize-1, tests
112	\ groups of 3 consecutive locations. The first and third
113	\ locations in the group are written with "pattern"
114	\ and the second location is written with the bitwise
115	\ inverse of "pattern". Verifies the data bits selected
116	\ by the "mask" variable.
117	\ I'm not sure what kind of failures that this test
118	\ can catch, other than failures that are more easily
119	\ detected by other tests.
120	\
121	\ memory-test-suite ( membase memsize -- status )
122	\ Performs a series of tests on the range of memory
123	\ from membase to membase+memsize-1.
124
125	hex
126
127	headerless
128	defer mem! ' l! is mem!
129	defer mem@ ' l@ is mem@
130	headers
131	: display-status ( n -- ) drop ;
132	variable group-code
133	nuser mask mask on
134	headerless
135
136	: maskit ( value -- masked-value ) mask @ n->l and ;
137
138	nuser mem-address
139	nuser mem-expected
140	nuser mem-observed
141
142	nuser failed \ Local
143	: .mem-test-failure ( -- )
144	??cr
145	." Addr =" mem-address @ .lx
146	." Exp =" mem-expected @ dup .lx
147	." Obs =" mem-observed @ dup .lx
148	." Xor =" xor .lx
149	??cr
150	;
151
152	: ?failed ( observed expected -- )
153	2dup <> if
154	mem-expected ! mem-observed ! failed on
155	else
156	2drop
157	then
158	;
159
160	: mem-test ( value address -- )
161	dup mem-address ! mem@ maskit swap maskit ?failed
162	;
163
164	\ "Walking Address Line" test ( quick )
165
166	\ The following routine tests an individual address line for the
167	\ following static faults:
168	\ a) stuck at either 0 or 1
169	\ b) shorted to a data line
170	\ c) shorted to another address line
171	\ Sets the failed variable if a failure is detected
172
173	nuser add-base
174	nuser add-top
175	: address-line-test ( addr# -- )
176
177	\ First we write all zeroes to the top and bottom memory locations
178	0 add-base @ mem! 0 add-top @ mem!
179
180	\ Now we write all ones to 2 locations: the location whose address
181	\ differs from the bottom address only by the address line under test,
182	\ and the location whose address differs from the top address only by
183	\ the address line under test.
184
185	1 over << ( addr# offset )
186	add-base @ over + ffffffff swap mem! \ store ones at "base + [1 << addr#]"
187	add-top @ over - ffffffff swap mem! \ store ones at "top - [1 << addr#]"
188	( addr# offset )
189
190	\ Now we check to see if either of the top or bottom locations got
191	\ clobbered when we wrote the other two locations. This tests for
192	\ address uniqueness in the one address line, and also for that address
193	\ line stuck to a data line.
194
195	0 add-base @ mem-test
196	0 add-top @ mem-test
197
198	\ Finally, we do the whole thing again, except that we use the opposite
199	\ data values. This allows us to distinguish a stuck address line
200	\ from an address line shorted to a data line. We don't actually
201	\ use this distinction, since the only output from this entire test
202	\ is "good" or "bad".
203
204	( addr# offset )
205	ffffffff add-base @ mem! \ store all ones into bottom of memory
206	ffffffff add-top @ mem! \ store all ones into top of memory
207
208	add-base @ over + 0 swap mem! \ store 0 at location "base + [ 1 << addr#]"
209	add-top @ over - 0 swap mem! \ store 0 at location "top - [ 1 << addr#]"
210
211	ffffffff add-base @ mem-test
212	ffffffff add-top @ mem-test
213	( addr# offset )
214
215	\ If more detailed failure analysis were desired, we could distinguish
216	\ between the various places where the test could fail.
217	\ For now, we just return pass or fail.
218
219	( addr# offset ) 2drop ( )
220	;
221
222	\ This test loops over all the address lines, testing each of them
223	\ with the above "address-line-test"
224
225	: mem-addr-test ( membase memsize -- fail-flag )
226	" Address quick test" diag-type
227
228	failed off \ set failed flag false
229
230	tuck bounds ( memsize memtop membase )
231	add-base ! /l - add-top ! ( memsize )
232
233	\ Calculate the number of address lines to test
234	log2 ( #adr-lines )
235
236	\ Loop over the address line numbers 2 .. #adr-lines - 1
237	\ Address lines 0 and 1 are byte and word selectors, which are
238	\ not appropriate to test with this procedure
239
240	( #adr-lines ) 2 do i address-line-test loop
241	failed @ \ place failed flag on stack
242	;
243
244	: mem-size-test ( membase -- fail-status )
245	" Data size test" diag-type
246
247	failed off \ set failed flag to false
248
249	\ write data in word size
250	h# 1234 over w! h# 5678 over wa1+ w! ( membase )
251
252	h# 12345678 over mem-test ( membase )
253
254	\ write data in byte size
255	h# 12 over 0 ca+ c! h# 34 over 1 ca+ c!
256	h# 56 over 2 ca+ c! h# 78 over 3 ca+ c! ( membase )
257
258	h# 12345678 over mem-test ( membase )
259	drop
260	failed @ \ place failed flag on stack
261	;
262
263	: mem-data-test ( membase -- fail-status )
264	" Data lines test" diag-type
265	failed off \ set failed flag to false
266
267	\ Walking ones
268	( membase )
269	d# 32 0 do \ loop over all 32 data lines
270	1 i << over mem! ( membase )
271	1 i << over mem-test ( membase )
272	loop ( membase )
273
274	\ Walking zeroes
275	d# 32 0 do \ loop over all 32 data lines
276	1 i << invert over mem! ( membase )
277	1 i << invert over mem-test ( membase )
278	/l + loop ( membase )
279
280	drop ( )
281	failed @ \ put failed flag onto the stack
282	;
283
284	: mem-bits-test ( membase memsize -- fail-status )
285	" Data bits test" diag-type
286	failed off \ set failed flag to false
287
288	bounds ( memtop membase )
289	2dup ?do h# ffffffff i 2dup mem! mem-test /l +loop \ stuck at 0 test
290	?do h# 00000000 i 2dup mem! mem-test /l +loop \ stuck at 1 test
291
292	failed @ \ put failed flag onto the stack
293	;
294
295	: address=data-test ( membase memsize -- status )
296	" Address=data test" diag-type
297
298	bounds 2dup do i i mem! /l +loop ( memtop membase )
299
300	failed off
301	do i i mem-test /l +loop
302	failed @ \ return failed flag on stack
303	;
304
305	\ This test writes groups of 3 consecutive locations. The first and
306	\ third locations in the group are written with a pattern, and the second
307	\ location is written with the inverse of the pattern.
308
309	nuser mats-pattern
310	: mats-test ( membase memsize pattern -- status )
311	" Mats test" diag-type
312	mats-pattern !
313
314	bounds 2dup do
315	mats-pattern @
316	dup i mem!
317	dup invert i 1 la+ mem!
318	i 2 la+ mem!
319	/l 3 * +loop
320
321	failed off ( memtop membase )
322	do
323	mats-pattern @
324	dup i mem-test
325	dup invert i 1 la+ mem-test
326	i 2 la+ mem-test
327	/l 3 * +loop
328	failed @
329	;
330
331	warning @ warning off
332	nuser failed \ Intentional redefinition
333	warning !
334	: ?fail ( flag -- )
335	?dup if
336	failed @ max failed ! ( )
337	" -- failed." diag-type
338	else
339	" -- succeeded." diag-type
340	then diag-cr
341	;
342	headers
343	: memory-test-suite ( membase memsize -- status )
344	failed off
345
346	over mem-data-test ?fail ( membase memsize )
347	2dup mem-addr-test ?fail ( membase memsize )
348	over mem-size-test ?fail ( membase memsize )
349	diagnostic-mode? if
350	2dup mem-bits-test ?fail ( membase memsize )
351	2dup address=data-test ?fail ( membase memsize )
352	\ Don't do the mats test, because I'm not convinced that it is useful
353	\ 2dup h# a5a5a5a5 mats-test ?fail ( membase memsize )
354	then
355	2drop
356
357	failed @
358	;