swapforth

1
\ To test the ANS Forth Double-Number word set and double number extensions
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
\ Version 0.11  7 April 2015 2VALUE tested
14
\         0.6   1 April 2012 Tests placed in the public domain.
15
\               Immediate 2CONSTANTs and 2VARIABLEs tested
16
\         0.5   20 November 2009 Various constants renamed to avoid
17
\               redefinition warnings. <true> and <false> replaced
18
\               with TRUE and FALSE
19
\         0.4   6 March 2009 { and } replaced with T{ and }T
20
\               Tests rewritten to be independent of word size and
21
\               tests re-ordered
22
\         0.3   20 April 2007 ANS Forth words changed to upper case
23
\         0.2   30 Oct 2006 Updated following GForth test to include
24
\               various constants from core.fr
25
\         0.1   Oct 2006 First version released
26
\ ------------------------------------------------------------------------------
27
\ The tests are based on John Hayes test program for the core word set
28

29
\ Words tested in this file are:
30
\     2CONSTANT 2LITERAL 2VARIABLE D+ D- D. D.R D0< D0= D2* D2/
31
\     D< D= D>S DABS DMAX DMIN DNEGATE M*/ M+ 2ROT DU<
32
\ Also tests the interpreter and compiler reading a double number
33
\ ------------------------------------------------------------------------------
34
\ Assumptions and dependencies:
35
\     - tester.fr or ttester.fs has been included prior to this file
36
\     - core words and core extension words have been tested
37
\ ------------------------------------------------------------------------------
38
\ Constant definitions
39

40
DECIMAL
41
0 INVERT        CONSTANT 1SD
42
1SD 1 RSHIFT    CONSTANT MAX-INTD   \ 01...1
43
MAX-INTD INVERT CONSTANT MIN-INTD   \ 10...0
44
MAX-INTD 2/     CONSTANT HI-INT     \ 001...1
45
MIN-INTD 2/     CONSTANT LO-INT     \ 110...1
46

47
\ ------------------------------------------------------------------------------
48
TESTING interpreter and compiler reading a double number
49

50
T{ 1. -> 1 0 }T
51
T{ -2. -> -2 -1 }T
52
T{ : RDL1 3. ; RDL1 -> 3 0 }T
53
T{ : RDL2 -4. ; RDL2 -> -4 -1 }T
54

55
\ ------------------------------------------------------------------------------
56
TESTING 2CONSTANT
57

58
T{ 1 2 2CONSTANT 2C1 -> }T
59
T{ 2C1 -> 1 2 }T
60
T{ : CD1 2C1 ; -> }T
61
T{ CD1 -> 1 2 }T
62
T{ : CD2 2CONSTANT ; -> }T
63
T{ -1 -2 CD2 2C2 -> }T
64
T{ 2C2 -> -1 -2 }T
65
T{ 4 5 2CONSTANT 2C3 IMMEDIATE 2C3 -> 4 5 }T
66
T{ : CD6 2C3 2LITERAL ; CD6 -> 4 5 }T
67

68
\ ------------------------------------------------------------------------------
69
\ Some 2CONSTANTs for the following tests
70

71
1SD MAX-INTD 2CONSTANT MAX-2INT  \ 01...1
72
0   MIN-INTD 2CONSTANT MIN-2INT  \ 10...0
73
MAX-2INT 2/  2CONSTANT HI-2INT   \ 001...1
74
MIN-2INT 2/  2CONSTANT LO-2INT   \ 110...0
75

76
\ ------------------------------------------------------------------------------
77
TESTING DNEGATE
78

79
T{ 0. DNEGATE -> 0. }T
80
T{ 1. DNEGATE -> -1. }T
81
T{ -1. DNEGATE -> 1. }T
82
T{ MAX-2INT DNEGATE -> MIN-2INT SWAP 1+ SWAP }T
83
T{ MIN-2INT SWAP 1+ SWAP DNEGATE -> MAX-2INT }T
84

85
\ ------------------------------------------------------------------------------
86
TESTING D+ with small integers
87

88
T{  0.  5. D+ ->  5. }T
89
T{ -5.  0. D+ -> -5. }T
90
T{  1.  2. D+ ->  3. }T
91
T{  1. -2. D+ -> -1. }T
92
T{ -1.  2. D+ ->  1. }T
93
T{ -1. -2. D+ -> -3. }T
94
T{ -1.  1. D+ ->  0. }T
95

96
TESTING D+ with mid range integers
97

98
T{  0  0  0  5 D+ ->  0  5 }T
99
T{ -1  5  0  0 D+ -> -1  5 }T
100
T{  0  0  0 -5 D+ ->  0 -5 }T
101
T{  0 -5 -1  0 D+ -> -1 -5 }T
102
T{  0  1  0  2 D+ ->  0  3 }T
103
T{ -1  1  0 -2 D+ -> -1 -1 }T
104
T{  0 -1  0  2 D+ ->  0  1 }T
105
T{  0 -1 -1 -2 D+ -> -1 -3 }T
106
T{ -1 -1  0  1 D+ -> -1  0 }T
107
T{ MIN-INTD 0 2DUP D+ -> 0 1 }T
108
T{ MIN-INTD S>D MIN-INTD 0 D+ -> 0 0 }T
109

110
TESTING D+ with large double integers
111

112
T{ HI-2INT 1. D+ -> 0 HI-INT 1+ }T
113
T{ HI-2INT 2DUP D+ -> 1SD 1- MAX-INTD }T
114
T{ MAX-2INT MIN-2INT D+ -> -1. }T
115
T{ MAX-2INT LO-2INT D+ -> HI-2INT }T
116
T{ HI-2INT MIN-2INT D+ 1. D+ -> LO-2INT }T
117
T{ LO-2INT 2DUP D+ -> MIN-2INT }T
118

119
\ ------------------------------------------------------------------------------
120
TESTING D- with small integers
121

122
T{  0.  5. D- -> -5. }T
123
T{  5.  0. D- ->  5. }T
124
T{  0. -5. D- ->  5. }T
125
T{  1.  2. D- -> -1. }T
126
T{  1. -2. D- ->  3. }T
127
T{ -1.  2. D- -> -3. }T
128
T{ -1. -2. D- ->  1. }T
129
T{ -1. -1. D- ->  0. }T
130

131
TESTING D- with mid-range integers
132

133
T{  0  0  0  5 D- ->  0 -5 }T
134
T{ -1  5  0  0 D- -> -1  5 }T
135
T{  0  0 -1 -5 D- ->  1  4 }T
136
T{  0 -5  0  0 D- ->  0 -5 }T
137
T{ -1  1  0  2 D- -> -1 -1 }T
138
T{  0  1 -1 -2 D- ->  1  2 }T
139
T{  0 -1  0  2 D- ->  0 -3 }T
140
T{  0 -1  0 -2 D- ->  0  1 }T
141
T{  0  0  0  1 D- ->  0 -1 }T
142
T{ MIN-INTD 0 2DUP D- -> 0. }T
143
T{ MIN-INTD S>D MAX-INTD 0 D- -> 1 1SD }T
144

145
TESTING D- with large integers
146

147
T{ MAX-2INT MAX-2INT D- -> 0. }T
148
T{ MIN-2INT MIN-2INT D- -> 0. }T
149
T{ MAX-2INT HI-2INT  D- -> LO-2INT DNEGATE }T
150
T{ HI-2INT  LO-2INT  D- -> MAX-2INT }T
151
T{ LO-2INT  HI-2INT  D- -> MIN-2INT 1. D+ }T
152
T{ MIN-2INT MIN-2INT D- -> 0. }T
153
T{ MIN-2INT LO-2INT  D- -> LO-2INT }T
154

155
\ ------------------------------------------------------------------------------
156
TESTING D0< D0=
157

158
T{ 0. D0< -> FALSE }T
159
T{ 1. D0< -> FALSE }T
160
T{ MIN-INTD 0 D0< -> FALSE }T
161
T{ 0 MAX-INTD D0< -> FALSE }T
162
T{ MAX-2INT  D0< -> FALSE }T
163
T{ -1. D0< -> TRUE }T
164
T{ MIN-2INT D0< -> TRUE }T
165

166
T{ 1. D0= -> FALSE }T
167
T{ MIN-INTD 0 D0= -> FALSE }T
168
T{ MAX-2INT  D0= -> FALSE }T
169
T{ -1 MAX-INTD D0= -> FALSE }T
170
T{ 0. D0= -> TRUE }T
171
T{ -1. D0= -> FALSE }T
172
T{ 0 MIN-INTD D0= -> FALSE }T
173

174
\ ------------------------------------------------------------------------------
175
TESTING D2* D2/
176

177
T{ 0. D2* -> 0. D2* }T
178
T{ MIN-INTD 0 D2* -> 0 1 }T
179
T{ HI-2INT D2* -> MAX-2INT 1. D- }T
180
T{ LO-2INT D2* -> MIN-2INT }T
181

182
T{ 0. D2/ -> 0. }T
183
T{ 1. D2/ -> 0. }T
184
T{ 0 1 D2/ -> MIN-INTD 0 }T
185
T{ MAX-2INT D2/ -> HI-2INT }T
186
T{ -1. D2/ -> -1. }T
187
T{ MIN-2INT D2/ -> LO-2INT }T
188

189
\ ------------------------------------------------------------------------------
190
TESTING D< D=
191

192
T{  0.  1. D< -> TRUE  }T
193
T{  0.  0. D< -> FALSE }T
194
T{  1.  0. D< -> FALSE }T
195
T{ -1.  1. D< -> TRUE  }T
196
T{ -1.  0. D< -> TRUE  }T
197
T{ -2. -1. D< -> TRUE  }T
198
T{ -1. -2. D< -> FALSE }T
199
T{ -1. MAX-2INT D< -> TRUE }T
200
T{ MIN-2INT MAX-2INT D< -> TRUE }T
201
T{ MAX-2INT -1. D< -> FALSE }T
202
T{ MAX-2INT MIN-2INT D< -> FALSE }T
203
T{ MAX-2INT 2DUP -1. D+ D< -> FALSE }T
204
T{ MIN-2INT 2DUP  1. D+ D< -> TRUE  }T
205
T{ MAX-INTD S>D 2DUP 1. D+ D< -> TRUE }T
206

207
T{ -1. -1. D= -> TRUE  }T
208
T{ -1.  0. D= -> FALSE }T
209
T{ -1.  1. D= -> FALSE }T
210
T{  0. -1. D= -> FALSE }T
211
T{  0.  0. D= -> TRUE  }T
212
T{  0.  1. D= -> FALSE }T
213
T{  1. -1. D= -> FALSE }T
214
T{  1.  0. D= -> FALSE }T
215
T{  1.  1. D= -> TRUE  }T
216

217
T{ 0 -1 0 -1 D= -> TRUE  }T
218
T{ 0 -1 0  0 D= -> FALSE }T
219
T{ 0 -1 0  1 D= -> FALSE }T
220
T{ 0  0 0 -1 D= -> FALSE }T
221
T{ 0  0 0  0 D= -> TRUE  }T
222
T{ 0  0 0  1 D= -> FALSE }T
223
T{ 0  1 0 -1 D= -> FALSE }T
224
T{ 0  1 0  0 D= -> FALSE }T
225
T{ 0  1 0  1 D= -> TRUE  }T
226

227
T{ MAX-2INT MIN-2INT D= -> FALSE }T
228
T{ MAX-2INT 0. D= -> FALSE }T
229
T{ MAX-2INT MAX-2INT D= -> TRUE }T
230
T{ MAX-2INT HI-2INT  D= -> FALSE }T
231
T{ MAX-2INT MIN-2INT D= -> FALSE }T
232
T{ MIN-2INT MIN-2INT D= -> TRUE }T
233
T{ MIN-2INT LO-2INT  D=  -> FALSE }T
234
T{ MIN-2INT MAX-2INT D= -> FALSE }T
235

236
\ ------------------------------------------------------------------------------
237
TESTING 2LITERAL 2VARIABLE
238

239
T{ : CD3 [ MAX-2INT ] 2LITERAL ; -> }T
240
T{ CD3 -> MAX-2INT }T
241
T{ 2VARIABLE 2V1 -> }T
242
T{ 0. 2V1 2! -> }T
243
T{ 2V1 2@ -> 0. }T
244
T{ -1 -2 2V1 2! -> }T
245
T{ 2V1 2@ -> -1 -2 }T
246
T{ : CD4 2VARIABLE ; -> }T
247
T{ CD4 2V2 -> }T
248
T{ : CD5 2V2 2! ; -> }T
249
T{ -2 -1 CD5 -> }T
250
T{ 2V2 2@ -> -2 -1 }T
251
T{ 2VARIABLE 2V3 IMMEDIATE 5 6 2V3 2! -> }T
252
T{ 2V3 2@ -> 5 6 }T
253
T{ : CD7 2V3 [ 2@ ] 2LITERAL ; CD7 -> 5 6 }T
254
T{ : CD8 [ 6 7 ] 2V3 [ 2! ] ; 2V3 2@ -> 6 7 }T
255

256
\ ------------------------------------------------------------------------------
257
TESTING DMAX DMIN
258

259
T{  1.  2. DMAX -> 2. }T
260
T{  1.  0. DMAX -> 1. }T
261
T{  1. -1. DMAX -> 1. }T
262
T{  1.  1. DMAX -> 1. }T
263
T{  0.  1. DMAX -> 1. }T
264
T{  0. -1. DMAX -> 0. }T
265
T{ -1.  1. DMAX -> 1. }T
266
T{ -1. -2. DMAX -> -1. }T
267

268
T{ MAX-2INT HI-2INT  DMAX -> MAX-2INT }T
269
T{ MAX-2INT MIN-2INT DMAX -> MAX-2INT }T
270
T{ MIN-2INT MAX-2INT DMAX -> MAX-2INT }T
271
T{ MIN-2INT LO-2INT  DMAX -> LO-2INT  }T
272

273
T{ MAX-2INT  1. DMAX -> MAX-2INT }T
274
T{ MAX-2INT -1. DMAX -> MAX-2INT }T
275
T{ MIN-2INT  1. DMAX ->  1. }T
276
T{ MIN-2INT -1. DMAX -> -1. }T
277

278

279
T{  1.  2. DMIN ->  1. }T
280
T{  1.  0. DMIN ->  0. }T
281
T{  1. -1. DMIN -> -1. }T
282
T{  1.  1. DMIN ->  1. }T
283
T{  0.  1. DMIN ->  0. }T
284
T{  0. -1. DMIN -> -1. }T
285
T{ -1.  1. DMIN -> -1. }T
286
T{ -1. -2. DMIN -> -2. }T
287

288
T{ MAX-2INT HI-2INT  DMIN -> HI-2INT  }T
289
T{ MAX-2INT MIN-2INT DMIN -> MIN-2INT }T
290
T{ MIN-2INT MAX-2INT DMIN -> MIN-2INT }T
291
T{ MIN-2INT LO-2INT  DMIN -> MIN-2INT }T
292

293
T{ MAX-2INT  1. DMIN ->  1. }T
294
T{ MAX-2INT -1. DMIN -> -1. }T
295
T{ MIN-2INT  1. DMIN -> MIN-2INT }T
296
T{ MIN-2INT -1. DMIN -> MIN-2INT }T
297

298
\ ------------------------------------------------------------------------------
299
TESTING D>S DABS
300

301
T{  1234  0 D>S ->  1234 }T
302
T{ -1234 -1 D>S -> -1234 }T
303
T{ MAX-INTD  0 D>S -> MAX-INTD }T
304
T{ MIN-INTD -1 D>S -> MIN-INTD }T
305

306
T{  1. DABS -> 1. }T
307
T{ -1. DABS -> 1. }T
308
T{ MAX-2INT DABS -> MAX-2INT }T
309
T{ MIN-2INT 1. D+ DABS -> MAX-2INT }T
310

311
\ ------------------------------------------------------------------------------
312
TESTING M+ M*/
313

314
T{ HI-2INT   1 M+ -> HI-2INT   1. D+ }T
315
T{ MAX-2INT -1 M+ -> MAX-2INT -1. D+ }T
316
T{ MIN-2INT  1 M+ -> MIN-2INT  1. D+ }T
317
T{ LO-2INT  -1 M+ -> LO-2INT  -1. D+ }T
318

319
\ To correct the result if the division is floored, only used when
320
\ necessary i.e. negative quotient and remainder <> 0
321

322
: ?FLOORED [ -3 2 / -2 = ] LITERAL IF 1. D- THEN ;
323

324
T{  5.  7 11 M*/ ->  3. }T
325
T{  5. -7 11 M*/ -> -3. ?FLOORED }T    \ FLOORED -4.
326
T{ -5.  7 11 M*/ -> -3. ?FLOORED }T    \ FLOORED -4.
327
T{ -5. -7 11 M*/ ->  3. }T
328
T{ MAX-2INT  8 16 M*/ -> HI-2INT }T
329
T{ MAX-2INT -8 16 M*/ -> HI-2INT DNEGATE ?FLOORED }T  \ FLOORED SUBTRACT 1
330
T{ MIN-2INT  8 16 M*/ -> LO-2INT }T
331
T{ MIN-2INT -8 16 M*/ -> LO-2INT DNEGATE }T
332
T{ MAX-2INT MAX-INTD MAX-INTD M*/ -> MAX-2INT }T
333
T{ MAX-2INT MAX-INTD 2/ MAX-INTD M*/ -> MAX-INTD 1- HI-2INT NIP }T
334
T{ MIN-2INT LO-2INT NIP DUP NEGATE M*/ -> MIN-2INT }T
335
T{ MIN-2INT LO-2INT NIP 1- MAX-INTD M*/ -> MIN-INTD 3 + HI-2INT NIP 2 + }T
336
T{ MAX-2INT LO-2INT NIP DUP NEGATE M*/ -> MAX-2INT DNEGATE }T
337
T{ MIN-2INT MAX-INTD DUP M*/ -> MIN-2INT }T
338

339
\ ------------------------------------------------------------------------------
340
TESTING D. D.R
341

342
\ Create some large double numbers
343
MAX-2INT 71 73 M*/ 2CONSTANT DBL1
344
MIN-2INT 73 79 M*/ 2CONSTANT DBL2
345

346
: D>ASCII  ( D -- CADDR U )
347
   DUP >R <# DABS #S R> SIGN #>    ( -- CADDR1 U )
348
   HERE SWAP 2DUP 2>R CHARS DUP ALLOT MOVE 2R>
349
;
350

351
DBL1 D>ASCII 2CONSTANT "DBL1"
352
DBL2 D>ASCII 2CONSTANT "DBL2"
353

354
: DOUBLEOUTPUT
355
   CR ." You should see lines duplicated:" CR
356
   5 SPACES "DBL1" TYPE CR
357
   5 SPACES DBL1 D. CR
358
   8 SPACES "DBL1" DUP >R TYPE CR
359
   5 SPACES DBL1 R> 3 + D.R CR
360
   5 SPACES "DBL2" TYPE CR
361
   5 SPACES DBL2 D. CR
362
   10 SPACES "DBL2" DUP >R TYPE CR
363
   5 SPACES DBL2 R> 5 + D.R CR
364
;
365

366
T{ DOUBLEOUTPUT -> }T
367

368
\ ------------------------------------------------------------------------------
369
TESTING 2ROT DU< (Double Number extension words)
370

371
T{ 1. 2. 3. 2ROT -> 2. 3. 1. }T
372
T{ MAX-2INT MIN-2INT 1. 2ROT -> MIN-2INT 1. MAX-2INT }T
373

374
T{  1.  1. DU< -> FALSE }T
375
T{  1. -1. DU< -> TRUE  }T
376
T{ -1.  1. DU< -> FALSE }T
377
T{ -1. -2. DU< -> FALSE }T
378

379
T{ MAX-2INT HI-2INT  DU< -> FALSE }T
380
T{ HI-2INT  MAX-2INT DU< -> TRUE  }T
381
T{ MAX-2INT MIN-2INT DU< -> TRUE }T
382
T{ MIN-2INT MAX-2INT DU< -> FALSE }T
383
T{ MIN-2INT LO-2INT  DU< -> TRUE }T
384

385
\ ------------------------------------------------------------------------------
386
TESTING 2VALUE
387

388
T{ 1111 2222 2VALUE 2VAL -> }T
389
T{ 2VAL -> 1111 2222 }T
390
T{ 3333 4444 TO 2VAL -> }T
391
T{ 2VAL -> 3333 4444 }T
392
T{ : TO-2VAL TO 2VAL ; 5555 6666 TO-2VAL -> }T
393
T{ 2VAL -> 5555 6666 }T
394

395
\ ------------------------------------------------------------------------------
396

397
DOUBLE-ERRORS SET-ERROR-COUNT
398

399
CR .( End of Double-Number word tests) CR
400

401