hal.fs (5915B) - raw
1 ?f<< /tests/harness.fs 2 : spit ( a u -- ) swap >r for 3 i 40 mod not if nl> then 4 8b to@+ V1 .x1 next rdrop ; 5 testbegin 6 code test1 ( a b -- a-b ) 7 PSP) @!, 8 PSP) -, 9 nip, exit, 10 54 12 test1 42 #eq 11 12 \ use RSP as local variables 13 code test2 ( -- n ) 14 dup, -8 rs+, 15 42 i) @, RSP) !, 16 5 i) @, RSP) 4 +) !, 17 RSP) @, 18 RSP) 4 +) +, 19 8 rs+, exit, 20 test2 47 #eq 21 22 \ simple expression 23 code test3 ( -- n ) 24 dup, -4 rs+, 25 2 i) @, RSP) !, 26 3 i) @, RSP) *, 27 1 i) +, 28 4 rs+, exit, 29 test3 7 #eq 30 31 \ expression involving push/popping intermediate results 32 code test4 ( -- n ) \ 2 * 3 + 2 33 dup, 34 3 i) @, 35 -1 i) +, 36 dup, 37 2 i) @, 38 dup, 39 3 i) @, 40 PSP) *, nip, 41 PSP) +, nip, 42 exit, 43 test4 8 #eq 44 45 \ variable reference and dereference 46 code test5 ( -- n ) 47 dup, -8 rs+, 48 42 i) @, RSP) !, 49 RSP) &) @, 50 RSP) 4 +) !, \ reference to RS+0 in RS+4 51 \ Now, let's dereference 52 RSP) 4 +) @, W) @, 53 8 rs+, exit, 54 test5 42 #eq 55 56 \ assign and dereference 57 code test6 58 dup, -8 rs+, 59 RSP) &) @, 60 RSP) 4 +) !, \ reference to RS+0 in RS+4 61 \ Now, let's assign-dereference 62 54 i) @, 63 RSP) 4 +) A>) @, A) !, 64 RSP) @, 65 8 rs+, exit, 66 test6 54 #eq 67 68 \ absolute memory location 69 here 1234 , ( a ) 70 code test7 ( -- n ) 71 dup, m) @, exit, 72 test7 1234 #eq 73 74 \ Increase/decrease directly in memory 75 code test8 ( -- n ) 76 dup, -4 rs+, 77 42 i) @, RSP) !, 78 1 RSP) +n, 79 RSP) @, 80 4 rs+, exit, 81 test8 43 #eq 82 83 \ Jumps 84 code test9 ( n -- n ) \ returns 42 if arg >= 10, 54 otherwise 85 10 i) compare, 86 0 <) branchC, 87 42 i) @, exit, 88 then 89 54 i) @, exit, 90 5 test9 54 #eq 91 15 test9 42 #eq 92 93 \ function calls 94 code test10 ( n -- n-42 ) 95 dup, 96 42 i) @, 97 pushret, ' test1 branchR, popret, 98 exit, 99 54 test10 12 #eq 100 101 \ variable op width 102 here ," hello" ( a ) 103 code test11 ( n -- c ) 104 dup, 105 ( a ) i) @, 106 PSP) +, nip, 107 W) 8b) @, 108 exit, 109 0 test11 'h' #eq 110 1 test11 'e' #eq 111 112 \ Testing that +, doesn't affect target memory location 113 here 42 , here swap , ( pc of *int ) 114 code test12 ( -- n ) 115 dup, 116 ( pc ) i) @, 117 W) A>) @, 118 A) @, 119 1 i) +, \ result in W, not in memory location 120 A) +, \ 42+43, not 43+43 121 exit, 122 test12 85 #eq 123 124 \ a rewrite of ptrset() from test.c for more precise testing 125 code test13 ( -- n ) 126 dup, -8 rs+, 127 42 i) @, RSP) !, 128 RSP) &) @, RSP) 4 +) !, 129 54 i) @, 130 RSP) 4 +) A>) @, A) !, 131 RSP) @, 132 8 rs+, exit, 133 test13 54 #eq 134 135 \ Branching with intermediate results. Check for PS leaks. 136 create myarray 1 , 2 , 3 , 0 , 137 \ Equivalent: int i = 0; int *b = myarray; do ++i; while (*(b++)); return i; 138 code test14 ( -- n ) 139 dup, -4 rs+, 140 0 i) @, RSP) !, \ i=0 141 myarray i) A>) @, 142 begin 143 1 RSP) +n, 144 A) @, 145 4 A) &) +n, 146 0 i) compare, NZ) branchC, drop 147 RSP) @, 4 rs+, exit, 148 test14 4 #eq 149 scnt 0 #eq 150 151 \ i386 didn't allow << and >> with non-const right operand 152 code test15 ( n n -- n ) 153 PSP) @!, 154 PSP) <<, 155 nip, exit, 156 $42 4 test15 $420 #eq 157 158 \ test W&), A&) and A>) 159 code test16 ( a b -- n ) \ a + b*b 160 PSP) A>) @, nip, 161 W) &) *, 162 A) &) +, 163 exit, 164 165 4 5 test16 29 #eq 166 167 \ test <>) 168 create foo $1234 , 169 code test17 ( n -- ) 170 foo m) <>) +, drop, 171 exit, 172 173 42 test17 foo @ $1234 42 + #eq 174 175 \ test &). this returns item "idx" from PSP 176 code test18 ( ... idx -- n ) 177 2 i) <<, PSP) &) +, W) @, 178 exit, 179 180 42 12 123 0 test18 123 #eq 181 1 test18 12 #eq 182 2 test18 42 #eq 183 2drop drop 184 185 \ 16-bit and 8-bit arithmetics are properly upscaled to 32-bit in W/A registers 186 code test19 ( a b -- n ) 187 PSP) 16b) +, nip, exit, 188 189 1 $1ffff test19 $20000 #eq 190 191 \ test <>) with *, which was problematic on i386 192 code test20 ( a b -- n ) 193 PSP) <>) *, drop, exit, 194 195 4 5 test20 20 #eq 196 197 \ *, with A>) 198 code test21 ( a b -- n ) 199 W) &) A>) @, 200 0 i) @, 201 PSP) A>) *, 202 A) &) @, 203 nip, exit, 204 205 4 5 test21 20 #eq 206 207 \ 8b) with A>) 208 code test22 ( n a -- n ) 209 PSP) A>) @, 210 nip, 211 W) 8b) A>) !, 212 drop, 213 exit, 214 215 create foo $12345678 , 216 $23456789 foo test22 217 foo @ $12345689 #eq 218 219 \ /mod with i) 220 code test23 ( n -- r q ) 221 3 i) /mod, 222 dup, 223 PSP) A>) !, 224 exit, 225 226 10 test23 3 #eq 1 #eq 227 228 \ &) with offset 229 code test24 ( -- a ) 230 dup, PSP) 4 +) &) @, 231 exit, 232 233 3 2 1 test24 @ 2 #eq 2drop drop 234 235 \ &) and m) 236 code test25 ( -- 42 ) 237 dup, 42 m) &) @, 238 exit, 239 240 test25 42 #eq 241 242 \ Test that number bank system works 243 code test26 ( -- 42 ) 244 dup, 20 i) 22 i) @, +, 245 exit, 246 247 test26 42 #eq 248 249 \ Test that +) can compound 250 code test27 ( a b c d -- a+d ) 251 PSP) 5 +) 3 +) +, nip, nip, nip, exit, 252 253 20 54 12 22 test27 42 #eq 254 255 \ @+, with A>) 256 create foo 42 , 54 , 257 code test28 ( -- n2 n1 ) 258 dup, foo i) @, 259 W) A>) @+, 260 A) &) @!, 261 dup, A) @, 262 exit, 263 264 test28 54 #eq 42 #eq 265 266 \ +n, with 16b) and 8b) 267 code test29 ( -- 42 $30213 ) 268 dup, 0 i) @, dup, \ PSP+0=0 269 42 i) @, \ W is not supposed to be affected 270 $30000 PSP) +n, 271 1 PSP) +n, 272 $200 PSP) 16b) +n, 273 1 PSP) 16b) +n, 274 $10 PSP) 8b) +n, 275 1 PSP) 8b) +n, 276 exit, 277 278 test29 42 #eq $30213 #eq 279 280 \ test operand orders on -, with <>) 281 code test30 ( a b -- a-b ) 282 PSP) <>) -, drop, exit, 283 284 5 3 test30 2 #eq 285 286 \ test operand orders on /mod, with <>) 287 code test31 ( a b -- r q ) \ a / b 288 PSP) <>) /mod, PSP) A>) !, exit, 289 290 5 2 test31 2 #eq 1 #eq 291 292 \ <<, <>) and +) 293 code test32 ( a b -- a<<b ) 294 dup, PSP) 4 +) <>) <<, 2drop, exit, 295 296 $2a 4 test32 $2a0 #eq 297 298 \ Test that +) can be more than a byte 299 create foo $100 allot0 42 , 300 code test33 ( a -- [a+$100] ) 301 W) $100 +) 8b) @, exit, 302 303 foo test33 42 #eq 304 305 \ <<, <>) and 16b) 306 create foo 42 16b , 54 16b , 307 code test34 ( n -- ) 308 foo m) <>) 16b) <<, drop, exit, 309 310 4 test34 foo 16b @ $2a0 #eq foo 2 + 16b @ 54 #eq 311 312 \ test *, and 16b) 313 code test35 ( a b -- a*b ) \ we ignore b31:16 in a 314 PSP) 16b) *, nip, exit, 315 316 $12340002 21 test35 42 #eq 317 318 \ +) can receive negative offset 319 code test36 ( a -- [a-4] ) 320 W) -4 +) @, exit, 321 322 create foo 12 , 42 , 54 , 323 foo 8 + test36 42 #eq 324 325 \ |, and 8b) which caused problems on arm 326 code test37 ( a b -- b|8b-a ) 327 PSP) 8b) |, nip, exit, 328 329 $1234 $80 test37 $b4 #eq 330 331 \ Arithmetic words set flags 332 code test38 ( a b -- Z-for-a&b ) 333 PSP) &, NZ) C>W, nip, exit, 334 335 2 1 test38 0 #eq 336 2 3 test38 1 #eq 337 testend