Merge branch 'master' of git.sr.ht:~rabbits/uxn
This commit is contained in:
commit
a646d34cf4
|
@ -1,60 +1,106 @@
|
||||||
|
(
|
||||||
|
tests/opcodes : automated testing of opcodes
|
||||||
|
|
||||||
|
This file generates a lot of stack underflows on purpose:
|
||||||
|
it's handy to supress all the warning by piping through grep
|
||||||
|
|
||||||
|
| grep -vF 'Halted: Working-stack underflow'
|
||||||
|
)
|
||||||
|
|
||||||
|
;test { code 2 label 2 status 1 }
|
||||||
|
;counts { failed 2 passed 2 unknown 2 }
|
||||||
|
;number { started 1 }
|
||||||
|
|
||||||
|0100 ;Console { pad 8 char 1 byte 1 short 2 }
|
|0100 ;Console { pad 8 char 1 byte 1 short 2 }
|
||||||
|0110 ;Screen { width 2 height 2 pad 4 x 2 y 2 color 1 }
|
|
||||||
|0120 ;Sprite { pad 8 x 2 y 2 addr 2 color 1 }
|
|
||||||
|0130 ;Controller { buttons 1 }
|
|
||||||
|0140 ;Keys { key 1 }
|
|
||||||
|0150 ;Mouse { x 2 y 2 state 1 chord 1 }
|
|
||||||
|0160 ;File { pad 8 name 2 length 2 load 2 save 2 }
|
|
||||||
|01E0 ;Debug { pad 8 stack 1 snapshot 1 exit 1 pad 4 test_mode 1 }
|
|
||||||
|01F0 .RESET .FRAME .ERROR ( vectors )
|
|01F0 .RESET .FRAME .ERROR ( vectors )
|
||||||
|01F8 [ f07c f0e2 f0c2 ] ( palette )
|
|
||||||
|
|
||||||
%TEST { BRK2?r LITr EOR2? DUP? }
|
%PASS? { ,result JMP2 BRK2?r LITr EOR2? DUP? }
|
||||||
|
%PASS { #01 PASS? }
|
||||||
%PASS { #01 ,result JSR2 }
|
%FAIL { #00 PASS? }
|
||||||
%FAIL { #00 ,result JSR2 }
|
|
||||||
%PASS? { ,result JSR2 }
|
|
||||||
|
|
||||||
|0200
|
|0200
|
||||||
|
|
||||||
@tests
|
@tests
|
||||||
TEST ADD FAIL [ add-needs-two ]
|
ADD FAIL [ add-needs-two 00 ]
|
||||||
TEST #01 ADD FAIL [ add-needs-two ]
|
#01 ADD FAIL [ add-needs-two 00 ]
|
||||||
TEST #01 #02 ADD #03 EQU PASS? [ add-result ]
|
#01 #02 ADD #03 EQU PASS? [ add-result 00 ]
|
||||||
TEST #01 #02 ADD #ff EQU PASS? [ this-test-fails ]
|
#01 #02 ADD #ff EQU PASS? [ this-test-fails 00 ]
|
||||||
|
|
||||||
TEST #00 =Debug.exit
|
,finish JMP2
|
||||||
|
|
||||||
@RESET
|
@RESET
|
||||||
#01 =Debug.test_mode
|
,tests =test.code
|
||||||
,tests #0001 SUB2 =current-test
|
,strings-start ,print-string JSR2
|
||||||
BRK
|
BRK
|
||||||
|
|
||||||
@ERROR BRK
|
@ERROR BRK
|
||||||
|
|
||||||
@FRAME
|
@FRAME
|
||||||
~current-test
|
,recover ~test.status JMP2?
|
||||||
|
#01 =test.status
|
||||||
$search
|
~test.code
|
||||||
#0001 ADD2
|
DUP2 ,find-label JSR2
|
||||||
DUP2 LDR LIT BRK2?r NEQ ,$search ROT JMP2?
|
DUP2 =test.label
|
||||||
DUP2 #0001 ADD2 LDR LIT LITr NEQ ,$search ROT JMP2?
|
,find-code JSR2 =test.code
|
||||||
DUP2 #0002 ADD2 LDR LIT EOR2? NEQ ,$search ROT JMP2?
|
|
||||||
DUP2 #0003 ADD2 LDR LIT DUP? NEQ ,$search ROT JMP2?
|
|
||||||
#0004 ADD2 DUP2 =current-test
|
|
||||||
JMP2
|
JMP2
|
||||||
|
|
||||||
|
@find-label ( ptr₂ -- following-label-ptr₂ )
|
||||||
|
DUP2 PEK2 LIT BRK2?r NEQ ^$next-minus-1 SWP JMP?
|
||||||
|
DUP2 #0001 ADD2 PEK2 LIT LITr NEQ ^$next-minus-1 SWP JMP?
|
||||||
|
DUP2 #0002 ADD2 PEK2 LIT EOR2? NEQ ^$next-minus-1 SWP JMP?
|
||||||
|
DUP2 #0003 ADD2 PEK2 LIT DUP? NEQ ^$next-minus-1 SWP JMP?
|
||||||
|
#0004 ADD2 $next-minus-1 JMP2r
|
||||||
|
|
||||||
|
( next )
|
||||||
|
#0001 ADD2 ^find-label JMP
|
||||||
|
|
||||||
|
@find-code ( label-ptr₂ -- following-code-ptr₂ )
|
||||||
|
DUP2 PEK2
|
||||||
|
,$not-end ROT JMP2?
|
||||||
|
|
||||||
|
$end
|
||||||
|
#0001 ADD2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
$not-end
|
||||||
|
#0001 ADD2 ^find-code JMP
|
||||||
|
|
||||||
|
@recover
|
||||||
|
( would it have been a PASS or FAIL? )
|
||||||
|
,$clear ~test.label #000a SUB2 PEK2 LIT LIT EQU JMP2?
|
||||||
|
#02 ^result JMP
|
||||||
|
|
||||||
|
$clear
|
||||||
|
( I would have executed a PASS or FAIL, so invert the result )
|
||||||
|
~test.label #0009 SUB2 PEK2 #00 EQU ^result JMP
|
||||||
|
|
||||||
@result
|
@result
|
||||||
|
DUP #02 MUL #00 SWP ,counts ADD2
|
||||||
|
DUP2 LDR2 #0001 ADD2 SWP2 STR2
|
||||||
|
#00 =test.status
|
||||||
,strings-test ^print-string JSR
|
,strings-test ^print-string JSR
|
||||||
#00 SWP ,strings-pass ,strings-fail SUB2 MUL2 ,strings-fail ADD2 ^print-string JSR
|
#00 SWP ,strings-pass ,strings-fail SUB2 MUL2 ,strings-fail ADD2 ^print-string JSR
|
||||||
STH2r DUP2 ^print-short JSR
|
|
||||||
,strings-colon ^print-string JSR
|
,strings-colon ^print-string JSR
|
||||||
^print-string JSR
|
~test.label ^print-string JSR
|
||||||
#0a =Console.char
|
#0a =Console.char
|
||||||
|
POP #fc JMP
|
||||||
|
BRK
|
||||||
|
|
||||||
|
@finish
|
||||||
|
,strings-finish ^print-string JSR
|
||||||
|
~counts.passed ^print-decimal JSR
|
||||||
|
,strings-passed ^print-string JSR
|
||||||
|
~counts.failed ^print-decimal JSR
|
||||||
|
,strings-failed ^print-string JSR
|
||||||
|
~counts.unknown ^print-decimal JSR
|
||||||
|
,strings-unknown ^print-string JSR
|
||||||
|
|
||||||
|
( stop executing tests )
|
||||||
|
LIT BRK ,FRAME POK2
|
||||||
BRK
|
BRK
|
||||||
|
|
||||||
@print-string ( string₂ -- )
|
@print-string ( string₂ -- )
|
||||||
DUP2 LDR DUP
|
DUP2 PEK2 DUP
|
||||||
,$not-end ROT JMP2?
|
,$not-end ROT JMP2?
|
||||||
|
|
||||||
$end
|
$end
|
||||||
|
@ -65,6 +111,25 @@
|
||||||
=Console.char
|
=Console.char
|
||||||
#0001 ADD2 ^print-string JMP
|
#0001 ADD2 ^print-string JMP
|
||||||
|
|
||||||
|
@print-decimal ( short₂ -- )
|
||||||
|
#00 =number.started
|
||||||
|
DUP2 #2710 DIV2 DUP2 ^$digit JSR #2710 MUL2 SUB2
|
||||||
|
DUP2 #03e8 DIV2 DUP2 ^$digit JSR #03e8 MUL2 SUB2
|
||||||
|
DUP2 #0064 DIV2 DUP2 ^$digit JSR #0064 MUL2 SUB2
|
||||||
|
DUP2 #000a DIV2 DUP2 ^$digit JSR #000a MUL2 SUB2
|
||||||
|
^$digit JSR
|
||||||
|
~number.started JMP2r?
|
||||||
|
#30 =Console.char
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
$digit
|
||||||
|
SWP POP
|
||||||
|
#02 OVR ~number.started ORA JMP?
|
||||||
|
POP JMP2r
|
||||||
|
#30 ADD =Console.char
|
||||||
|
#01 =number.started
|
||||||
|
JMP2r
|
||||||
|
|
||||||
@print-short ( short₂ -- )
|
@print-short ( short₂ -- )
|
||||||
#30 =Console.char
|
#30 =Console.char
|
||||||
#78 =Console.char
|
#78 =Console.char
|
||||||
|
@ -82,10 +147,15 @@
|
||||||
JMP2r
|
JMP2r
|
||||||
|
|
||||||
@strings
|
@strings
|
||||||
|
$start [ 0a Testing 20 started. 0a 0a 00 ]
|
||||||
$test [ Test 20 00 ]
|
$test [ Test 20 00 ]
|
||||||
$fail [ FAIL 20 at 20 00 ]
|
$fail [ FAIL 00 ]
|
||||||
$pass [ pass 20 at 20 00 ]
|
$pass [ pass 00 ]
|
||||||
|
[ UNKNOWN 00 ]
|
||||||
|
$at [ at 20 00 ]
|
||||||
$colon [ : 20 00 ]
|
$colon [ : 20 00 ]
|
||||||
|
$finish [ 0a Testing 20 complete. 0a 00 ]
|
||||||
;current-test { short 2 }
|
$passed [ 20 passed, 20 00 ]
|
||||||
|
$failed [ 20 failed, 20 00 ]
|
||||||
|
$unknown [ 20 were 20 unknown. 0a 00 ]
|
||||||
|
|
||||||
|
|
|
@ -48,8 +48,8 @@ void op_lts(Uxn *u) { Uint8 a = pop8(u->src), b = pop8(u->src); push8(u->src, (S
|
||||||
void op_jmp(Uxn *u) { Uint8 a = pop8(u->src); u->ram.ptr += (Sint8)a; }
|
void op_jmp(Uxn *u) { Uint8 a = pop8(u->src); u->ram.ptr += (Sint8)a; }
|
||||||
void op_jsr(Uxn *u) { Uint8 a = pop8(u->src); push16(u->dst, u->ram.ptr); u->ram.ptr += (Sint8)a; }
|
void op_jsr(Uxn *u) { Uint8 a = pop8(u->src); push16(u->dst, u->ram.ptr); u->ram.ptr += (Sint8)a; }
|
||||||
/* Memory */
|
/* Memory */
|
||||||
void op_pek(Uxn *u) { Uint16 a = pop8(u->src); push8(u->src, mempeek8(u, a)); }
|
void op_pek(Uxn *u) { Uint8 a = pop8(u->src); push8(u->src, mempeek8(u, a)); }
|
||||||
void op_pok(Uxn *u) { Uint16 a = pop8(u->src); Uint8 b = pop8(u->src); mempoke8(u, a, b); }
|
void op_pok(Uxn *u) { Uint8 a = pop8(u->src); Uint8 b = pop8(u->src); mempoke8(u, a, b); }
|
||||||
void op_ldr(Uxn *u) { Uint8 a = pop8(u->src); push16(u->src, mempeek16(u, a)); }
|
void op_ldr(Uxn *u) { Uint8 a = pop8(u->src); push16(u->src, mempeek16(u, a)); }
|
||||||
void op_str(Uxn *u) { Uint8 a = pop8(u->src); Uint16 b = pop16(u->src); mempoke16(u, a, b); }
|
void op_str(Uxn *u) { Uint8 a = pop8(u->src); Uint16 b = pop16(u->src); mempoke16(u, a, b); }
|
||||||
void op_cln(Uxn *u) { push8(u->src, peek8(u->dst, 0)); }
|
void op_cln(Uxn *u) { push8(u->src, peek8(u->dst, 0)); }
|
||||||
|
|
Loading…
Reference in New Issue