swapforth

1
\ To test the ANS Forth Memory-Allocation word set
2

3
\ This program was written by Gerry Jackson in 2006, with contributions from
4
\ others where indicated, and is in the public domain - it can be distributed
5
\ and/or modified in any way but please retain this notice.
6

7
\ This program is distributed in the hope that it will be useful,
8
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
9
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
10

11
\ The tests are not claimed to be comprehensive or correct 
12

13
\ ------------------------------------------------------------------------------
14
\ Version 0.11 25 April 2015 Now checks memory region is unchanged following a
15
\              RESIZE. @ and ! in allocated memory.
16
\         0.8 10 January 2013, Added CHARS and CHAR+ where necessary to correct
17
\             the assumption that 1 CHARS = 1
18
\         0.7 1 April 2012  Tests placed in the public domain.
19
\         0.6 30 January 2011 CHECKMEM modified to work with ttester.fs
20
\         0.5 30 November 2009 <false> replaced with FALSE
21
\         0.4 9 March 2009 Aligned test improved and data space pointer tested
22
\         0.3 6 March 2009 { and } replaced with T{ and }T
23
\         0.2 20 April 2007  ANS Forth words changed to upper case
24
\         0.1 October 2006 First version released
25

26
\ ------------------------------------------------------------------------------
27
\ The tests are based on John Hayes test program for the core word set
28
\ and requires those files to have been loaded
29

30
\ Words tested in this file are:
31
\     ALLOCATE FREE RESIZE
32
\     
33
\ ------------------------------------------------------------------------------
34
\ Assumptions and dependencies:
35
\     - that 'addr -1 ALLOCATE' and 'addr -1 RESIZE' will return an error
36
\     - tester.fr or ttester.fs has been loaded prior to this file
37
\     - testing FREE failing is not done as it is likely to crash the
38
\       system
39
\ ------------------------------------------------------------------------------
40

41
TESTING Memory-Allocation word set
42

43
DECIMAL
44

45
\ ------------------------------------------------------------------------------
46
TESTING ALLOCATE FREE RESIZE
47

48
VARIABLE ADDR1
49
VARIABLE DATSP
50

51
HERE DATSP !
52
T{ 100 ALLOCATE SWAP ADDR1 ! -> 0 }T
53
T{ ADDR1 @ ALIGNED -> ADDR1 @ }T   \ Test address is aligned
54
T{ HERE -> DATSP @ }T            \ Check data space pointer is unchanged
55
T{ ADDR1 @ FREE -> 0 }T
56

57
T{ 99 ALLOCATE SWAP ADDR1 ! -> 0 }T
58
T{ ADDR1 @ ALIGNED -> ADDR1 @ }T
59
T{ ADDR1 @ FREE -> 0 }T
60

61
T{ 50 CHARS ALLOCATE SWAP ADDR1 ! -> 0 }T
62

63
: WRITEMEM 0 DO I 1+ OVER C! CHAR+ LOOP DROP ;	( ad n -- )
64

65
\ CHECKMEM is defined this way to maintain compatibility with both
66
\ tester.fr and ttester.fs which differ in their definitions of T{
67

68
: CHECKMEM  ( ad n --- )
69
   0
70
   DO
71
      >R
72
      T{ R@ C@ -> R> I 1+ SWAP >R }T
73
      R> CHAR+
74
   LOOP
75
   DROP
76
;
77

78
ADDR1 @ 50 WRITEMEM ADDR1 @ 50 CHECKMEM
79

80
T{ ADDR1 @ 28 CHARS RESIZE SWAP ADDR1 ! -> 0 }T
81
ADDR1 @ 28 CHECKMEM
82

83
T{ ADDR1 @ 200 CHARS RESIZE SWAP ADDR1 ! -> 0 }T
84
ADDR1 @ 28 CHECKMEM
85

86
\ ------------------------------------------------------------------------------
87
TESTING failure of RESIZE and ALLOCATE (unlikely to be enough memory)
88

89
\ This test relies on the previous test having passed
90

91
VARIABLE RESIZE-OK
92
T{ ADDR1 @ -1 CHARS RESIZE 0= DUP RESIZE-OK ! -> ADDR1 @ FALSE }T
93

94
\ Check unRESIZEd allocation is unchanged following RESIZE failure 
95
: MEM?  RESIZE-OK @ 0= IF ADDR1 @ 28 CHECKMEM THEN ;   \ Avoid using [IF]
96
MEM?
97

98
T{ ADDR1 @ FREE -> 0 }T   \ Tidy up
99

100
T{ -1 ALLOCATE SWAP DROP 0= -> FALSE }T      \ Memory allocate failed
101

102
\ ------------------------------------------------------------------------------
103
TESTING @  and ! work in ALLOCATEd memory (provided by Peter Knaggs)
104

105
: WRITE-CELL-MEM ( ADDR N -- )
106
  1+ 1 DO I OVER ! CELL+ LOOP DROP
107
;
108

109
: CHECK-CELL-MEM ( ADDR N -- )
110
  1+ 1 DO
111
    I SWAP >R >R
112
    T{ R> ( I ) -> R@ ( ADDR ) @ }T
113
    R> CELL+
114
  LOOP DROP
115
;
116

117
\ Cell based access to the heap
118

119
T{ 50 CELLS ALLOCATE SWAP ADDR1 ! -> 0 }T
120
ADDR1 @ 50 WRITE-CELL-MEM
121
ADDR1 @ 50 CHECK-CELL-MEM
122

123
\ ------------------------------------------------------------------------------
124

125
MEMORY-ERRORS SET-ERROR-COUNT
126

127
CR .( End of Memory-Allocation word tests) CR
128