\ Do not use this file except in compliance with the License. You may \ obtain a copy of the License at http://www.microcore.org/License/ \ Software distributed under the License is distributed on an "AS IS" basis, \ WITHOUT WARRANTY OF ANY KIND, either express or implied. \ See the License for the specific language governing rights and limitations \ under the License. \ \ The Original Code is: CORETEST.FS \ \ Last change: KS 31.10.2015 20:12:05 \ \ The Initial Developer of the Original Code is Klaus.Schleisiek AT microcore.org. \ \ MicroCore core test for VHDL-Version 1.33 \ have VHDL-file [IF] \ simulating : finis ( errorcode -- ) BEGIN REPEAT ; [ELSE] \ debugging : finis ( errorcode -- ) DEBUG_REG ! ['] monitor nop BRANCH ; [THEN] Variable Location 1 allot : zeroEXIT ( n1 -- n2 ) dup ?EXIT 0= ; : zero-EXIT ( n1 -- n2 ) dup 0= ?EXIT 0= ; : test_branches ( -- ) 0 dup 0< IF invert THEN IF $1 finis THEN -1 dup 0< IF invert THEN IF $2 finis THEN 0 u2/ carry? IF invert THEN IF $3 finis THEN 1 u2/ carry? IF invert THEN 0= IF $4 finis THEN -1 zeroEXIT invert IF $5 finis THEN 0 zeroEXIT invert IF $6 finis THEN -1 zero-EXIT IF $7 finis THEN 0 zero-EXIT IF $8 finis THEN 0 3 FOR 1+ NEXT 4 - IF $9 finis THEN 0 $25 $20 DO I + LOOP $AA - IF $A finis THEN 0 ?dup IF $B finis THEN 1 ?dup IF 0= ELSE true THEN IF $C finis THEN ; : cc ( -- ) status@ #c xor status! ; : test_unary ( -- ) -1 0< 0= IF $10 finis THEN 0 0< IF $11 finis THEN -1 2* cc carry? IF $12 finis THEN cc ( -- -2 ) invert 1 = 0= IF $13 finis THEN ( -- ) -1 u2/ cc carry? IF $14 finis THEN cc ( $7FF ) invert 2* cc carry? IF $15 finis THEN cc ( 0 ) 0= invert IF $16 finis THEN ( 0 ) $100 1 ashift -2 shift $80 over - IF $17 finis THEN ( -- $80 ) -7 ashift 1 - IF $18 finis THEN ( -- ) 1 data_width 1 - shift dup #signbit - IF $19 finis THEN ( -- #signbit ) -3 ashift [ data_width 4 - negate ] Literal shift $F - dup IF $1A finis THEN ( -- ) 0= invert 1 0= or IF $1C finis THEN ( -- ) #signbit 2/ #signbit dup u2/ or - IF $1D finis THEN ( -- ) 1 2/ cc carry? IF $1E finis THEN cc ( -- 0 ) 0= invert IF $1F finis THEN ( -- ) ; #signbit 1 + Constant #8001 #signbit Constant #8000 #signbit 1 - #signbit invert and Constant #7FFF #signbit 2 - #signbit invert and Constant #7FFE .( use separate TEST_MULDIV.FS testbench for random multiply / divide tests ) cr : test_arith ( -- ) 3 4 + ( 7 ) 4 - ( 3 ) 4 2dup + ( 3 4 7 ) over swap - ( 3 4 -3 ) dup 0< and ( 3 4 -3 ) negate ( 3 4 3 ) or ( 3 7 ) xor ( 4 ) 4 and ( 4 ) 0 -1 0 d+ ( 3 1 ) 1- swap 3 - or IF $20 finis THEN 8 2 pack $208 - IF $21 finis THEN $208 unpack + &10 - IF $22 finis THEN -1 1 um* >r -1 - r> or IF $23 finis THEN -- 0000 FFFF 1 -1 um* >r -1 - r> or IF $24 finis THEN -- 0000 FFFF -1 -1 um* -2 - >r 1 - r> or IF $25 finis THEN -- FFFE 0001 -2 -1 um* -3 - >r 2 - r> or IF $26 finis THEN -- FFFD 0002 -1 -2 um* -3 - >r 2 - r> or IF $27 finis THEN -- FFFD 0002 -1 #7FFF um* #7FFE - >r #8001 - r> or IF $28 finis THEN -- 7FFE 8001 #7FFF -1 um* #7FFE - >r #8001 - r> or IF $29 finis THEN -- 7FFE 8001 4 5 um* + &20 - IF $2A finis THEN &21 0 5 um/mod 4 - >r 1 - r> or IF $2B finis THEN -3 1 -1 um/mod 1 - >r -2 - r> or IF $2C finis THEN -2 1 -1 um/mod 2 - >r 0 - r> or IF $2D finis THEN -3 1 -2 um/mod 2 - >r 1 - r> or IF $2E finis THEN -1 0 #8000 um/mod 1 - >r #7FFF - r> or IF $2F finis THEN 0 1 1 um/mod or status@ #ovfl and #ovfl xor or IF $200 finis THEN #8000 1 < 0= IF $201 finis THEN 1 #8000 < IF $202 finis THEN 1 2 < 0= IF $203 finis THEN 2 1 < IF $204 finis THEN [ data_width &32 = ] [IF] with_mult [IF] -1 log2 $FFFFFFFE - IF $205 finis THEN $80000000 log2 IF $206 finis THEN $88888888 log2 $17D60493 - IF $207 finis THEN $C0000000 log2 $95C01A39 - IF $208 finis THEN $E0000000 log2 $CEAECFEA - IF $209 finis THEN [THEN] $80000000 sqrt + $20CF4 - IF $20A finis THEN -1 sqrt + $2FFFD - IF $20B finis THEN $40000000 sqrt + $8000 - IF $20C finis THEN $3FFFFFFF sqrt + $17FFD - IF $20D finis THEN [THEN] ; $55AA Constant ovfl_pattern : test_overflow ( -- ) #signbit dup + ?ovfl ovfl_pattern - IF $C0 finis THEN 0 0 + ?ovfl ovfl_pattern = IF $C1 finis THEN 0 0 + ovfl? IF drop ovfl_pattern THEN IF $C2 finis THEN #7FFF #7FFF - ovfl? IF drop ovfl_pattern THEN IF $C3 finis THEN #8000 #8000 - ovfl? IF drop ovfl_pattern THEN IF $C4 finis THEN #8000 1 + ovfl? IF drop ovfl_pattern THEN #8001 - IF $C5 finis THEN 1 #8000 + ovfl? IF drop ovfl_pattern THEN #8001 - IF $C6 finis THEN #8000 1 - ovfl? IF drop ovfl_pattern THEN ovfl_pattern - IF $C7 finis THEN 1 #8000 - ovfl? IF drop ovfl_pattern THEN ovfl_pattern - IF $C8 finis THEN #8000 #7FFF + ovfl? IF drop ovfl_pattern THEN 1+ IF $C9 finis THEN #7FFF #8000 + ovfl? IF drop ovfl_pattern THEN 1+ IF $CA finis THEN #8000 -1 + ovfl? IF drop ovfl_pattern THEN ovfl_pattern - IF $CB finis THEN -1 #8000 + ovfl? IF drop ovfl_pattern THEN ovfl_pattern - IF $CC finis THEN #8000 #8000 + ovfl? IF drop ovfl_pattern THEN ovfl_pattern - IF $CD finis THEN ; : test_memory ( -- ) 1 2 Location st 1 + st -1 + ld 1 + ld drop 2* - IF $30 finis THEN $10 Location +st @ $12 - IF $31 finis THEN 0 Location ! 1 Location +! Location @ 1- IF $32 finis THEN -1 Location +! Location @ IF $33 finis THEN ; : modify ( n -- /n ) 0= ; : absbranch ( n -- ) ; : test_call ( -- ) status@ #ovfl or status! ovfl? 0= IF $40 finis THEN status@ #ovfl xor status! ovfl? IF $41 finis THEN status@ #c or status! carry? 0= IF $42 finis THEN status@ #c xor status! carry? IF $43 finis THEN -1 ['] modify nop JSR IF $44 finis THEN ['] absbranch nop BRANCH $45 finis ; : test_stack ( -- ) $55 dup + $55 2* - IF $50 finis THEN 1 2 swap 1 - >r 2 - r> or IF $51 finis THEN 1 2 over 1 - >r 2 - >r 1 - r> or r> or IF $52 finis THEN 1 2 3 drop 2 - swap 1 - or IF $53 finis THEN 1 2 5 nip + 6 - IF $54 finis THEN &55 0 nop ?dup + &55 - &55 0 ?dup + &55 - or IF $55 finis THEN &55 1 ?dup + + &57 - &55 1 nop ?dup + + &57 - or IF $56 finis THEN 0 >r r@ r> + IF $57 finis THEN 1 2 3 rot - - IF $58 finis THEN 3 2 1 -rot - - IF $59 finis THEN 1 2 tuck + + 5 - IF $5A finis THEN 1 2 under + + 4 - IF $5B finis THEN \ test_stack_depths - not implemented ; : test_register ( -- ) 1 >r r@ r@ + 2 - IF $60 finis THEN $55 r> + $56 - r@ 1 = or IF $61 finis THEN status@ 0 status! status@ $3F and IF $62 finis THEN dup status! status@ - #zero - IF $63 finis THEN di status@ #ie and IF $64 finis THEN ei status@ #ie and 0= IF $65 finis THEN carry-reset status@ #c and IF $66 finis THEN carry-set status@ #c and 0= IF $67 finis THEN 1 2 3 4 dsp@ 1- dsp! drop + 3 - IF $68 finis THEN 1 >r 2 >r 3 >r rsp@ 1+ rsp! rdrop r> 1- IF $69 finis THEN ; : test_local ( -- ) [ H have op_WLOCAL T ] [IF] r@ dup >r 1 l@ - IF $80 finis THEN r@ -1 1 l! r> r@ swap >r over 1 l! 1 l@ swap 1+ - - rdrop IF $81 finis THEN 5 -$80 lst @ 5 - IF $82 finis THEN [THEN] ; : rsp_task ( -- u ) rsp@ [ rs_addr_width negate ] Literal shift [ #tasks 1- ] Literal and ; : dsp_task ( -- u ) dsp@ [ ds_addr_width negate ] Literal shift [ #tasks 1- ] Literal and ; : rsp_reg ( -- u ) rsp@ 1+ [ #rstack 1- ] Literal and ; : dsp_reg ( -- u ) dsp@ [ #dstack 1- ] Literal and ; : rsp_task! ( u -- ) r@ swap rs_addr_width shift rsp_reg or rsp! rdrop >r ; : dsp_task! ( u -- ) ds_addr_width shift dsp_reg or dup dsp! drop ; : test_tasks ( -- ) WITH_TASKS [IF] $10 task! task@ $100 task! task@ $100 - swap task! IF $90 finis THEN 6 4 tst @ 6 - IF $91 finis THEN -6 4 t! 4 t@ -6 - IF $92 finis THEN rsp_task 3 - IF $93 finis THEN dsp_task 2 - IF $94 finis THEN 0 >r 2 rsp_task! rdrop 1 >r 3 rsp_task! r> IF $95 finis THEN [THEN] ; : test_van_neumann ( -- ) [ prog_ram_width ] [IF] $10 #signbit or ld over >r \ internal blockRAM $11 swap st ld rot swap st @ r> - IF $A0 finis THEN $11 - IF $A1 finis THEN $110 #signbit or ld over >r \ external memory $11 swap st ld rot swap st @ r> - IF $A2 finis THEN $11 - IF $A3 finis THEN [THEN] ; 7 TRAP: push_$10 ( -- n ) $10 ; 8 TRAP: 4* ( n1 -- n2 ) 2* 2* ; : test_user ( -- ) push_$10 $10 - IF $B0 finis THEN $10 push_$10 - IF $B1 finis THEN 1 4* 4 - IF $B2 finis THEN 2 4* 8 - IF $B3 finis THEN ; : test_timer ( -- ) timer @ 1- time? 0= IF $B4 finis THEN timer @ time? 0= IF $B5 finis THEN timer @ 2 + time? IF $B6 finis THEN #c_sema ctrl! ctrl@ #c_sema xor IF $B7 finis THEN \ #c_sema ctrl! #f_sema pass \ will hang indefiniteyl, showing exception action #c_sema invert ctrl! #f_sema pass ; Variable Foo : addrtrap ( paddr -- ) 1 Foo +! BRANCH ; : test_byteaddr ( -- ) [ WITH_BYTES ] [IF] 0 Foo ! Location >byte >r $11 r@ c! $22 r@ 1+ c! $33 r@ 2 + c! $44 r@ 3 + c! Location @ $44332211 - IF $D0 finis THEN r@ i@ $44332211 - IF $D1 finis THEN r@ 1+ i@ $44332211 - IF $D2 finis THEN -- addrtrap r@ w@ $2211 - IF $D3 finis THEN r@ 2 + w@ $4433 - IF $D4 finis THEN r@ 1+ w@ $2211 - IF $D5 finis THEN -- addrtrap $11223388 r@ 1+ i! -- addrtrap r@ c@ signed $FFFFFF88 - IF $D6 finis THEN r@ 1+ c@ $33 - IF $D7 finis THEN r@ 2 + c@ signed $22 - IF $D8 finis THEN r@ 3 + c@ $11 - IF $D9 finis THEN r@ w@ $3388 - IF $DA finis THEN r@ 2 + w@ $1122 - IF $DB finis THEN $8888 r@ 1+ w! -- addrtrap $4444 r@ 2 + w! r@ w@ signed $FFFF8888 - IF $DC finis THEN r@ 2 + w@ signed $4444 - IF $DD finis THEN r> byte> Location - IF $DE finis THEN [THEN] ; : test_rot32 ( -- ) [ WITH_BYTES ] [IF] \ $C0000000 1 rot32 $80000001 - IF $E0 finis THEN \ $0000C000 $11 rot32 $80000001 - IF $E1 finis THEN [THEN] ; Variable Intvar : test_interrupt ( -- ) 1 Intvar ! ei #i_ext ie! ; : intserver ( -- ) ints@ #i_ext and IF Intvar @ 1- Intvar ! EXIT THEN $55 Intvar ! \ invalid interrupt source ; : coretest ( -- ) 1 2 3 0 test_interrupt 3 rsp_task! 2 dsp_task! 0 test_register test_stack test_call test_branches test_unary test_arith test_overflow test_memory test_local test_tasks test_user dsp_task! test_timer test_van_neumann test_byteaddr test_rot32 + - + IF $F0 finis THEN [ WITH_BYTES ] [IF] Foo @ 4 - IF $F1 finis THEN [THEN] have VHDL-file [IF] Intvar @ IF $F2 finis THEN 0 finis [ELSE] $100 finis [THEN] ;