Moved printing routines from tests/opcodes to console example
This commit is contained in:
Andrew Alderwick
parent
fa2d290351
commit
268ccd0519
|
|
@ -1,163 +0,0 @@
|
||||||
(
|
|
||||||
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 }
|
|
||||||
|
|
||||||
|0110 ;Console { vector 2 pad 6 char 1 byte 1 short 2 string 2 }
|
|
||||||
|01F0 .RESET .FRAME .ERROR ( vectors )
|
|
||||||
|
|
||||||
%PASS? { ,result JMP2 BRK2r LITr EOR2 DUP }
|
|
||||||
%PASS { #01 PASS? }
|
|
||||||
%FAIL { #00 PASS? }
|
|
||||||
|
|
||||||
|0200
|
|
||||||
|
|
||||||
@tests
|
|
||||||
ADD FAIL [ add-needs-two 00 ]
|
|
||||||
#01 ADD FAIL [ add-needs-two 00 ]
|
|
||||||
#01 #02 ADD #03 EQU PASS? [ add-result 00 ]
|
|
||||||
LITr [ fe ] STHr #fe EQU PASS? [ litr 00 ]
|
|
||||||
LIT2r [ fe dc ] STH2r #fedc EQU2 PASS? [ lit2r 00 ]
|
|
||||||
#01 #02 ADD #ff EQU PASS? [ this-test-fails 00 ]
|
|
||||||
|
|
||||||
,finish JMP2
|
|
||||||
|
|
||||||
@RESET
|
|
||||||
,tests =test.code
|
|
||||||
,strings-start ,print-string JSR2
|
|
||||||
BRK
|
|
||||||
|
|
||||||
@ERROR BRK
|
|
||||||
|
|
||||||
@FRAME
|
|
||||||
~test.status ,recover JNZ2
|
|
||||||
#01 =test.status
|
|
||||||
~test.code
|
|
||||||
DUP2 ,find-label JSR2
|
|
||||||
DUP2 =test.label
|
|
||||||
,find-code JSR2 =test.code
|
|
||||||
JMP2
|
|
||||||
|
|
||||||
@find-label ( ptr₂ -- following-label-ptr₂ )
|
|
||||||
DUP2 PEK2 LIT BRK2r NEQ ^$next JNZ
|
|
||||||
DUP2 #0001 ADD2 PEK2 LIT LITr NEQ ^$next JNZ
|
|
||||||
DUP2 #0002 ADD2 PEK2 LIT EOR2 NEQ ^$next JNZ
|
|
||||||
DUP2 #0003 ADD2 PEK2 LIT DUP NEQ ^$next JNZ
|
|
||||||
#0004 ADD2 JMP2r
|
|
||||||
|
|
||||||
$next
|
|
||||||
#0001 ADD2 ^find-label JMP
|
|
||||||
|
|
||||||
@find-code ( label-ptr₂ -- following-code-ptr₂ )
|
|
||||||
DUP2 PEK2
|
|
||||||
,$not-end JNZ2
|
|
||||||
|
|
||||||
$end
|
|
||||||
#0001 ADD2
|
|
||||||
JMP2r
|
|
||||||
|
|
||||||
$not-end
|
|
||||||
#0001 ADD2 ^find-code JMP
|
|
||||||
|
|
||||||
@recover
|
|
||||||
( would it have been a PASS or FAIL? )
|
|
||||||
~test.label #000a SUB2 PEK2 LIT LIT EQU ,$clear JNZ2
|
|
||||||
#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
|
|
||||||
DUP #02 MUL #00 SWP ,counts ADD2
|
|
||||||
DUP2 LDR2 #0001 ADD2 SWP2 STR2
|
|
||||||
#00 =test.status
|
|
||||||
,strings-test ^print-string JSR
|
|
||||||
#00 SWP ,strings-pass ,strings-fail SUB2 MUL2 ,strings-fail ADD2 ^print-string JSR
|
|
||||||
,strings-colon ^print-string JSR
|
|
||||||
~test.label ^print-string JSR
|
|
||||||
#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
|
|
||||||
|
|
||||||
@print-string ( string₂ -- )
|
|
||||||
DUP2 PEK2 DUP
|
|
||||||
,$not-end JNZ2
|
|
||||||
|
|
||||||
$end
|
|
||||||
POP POP2 JMP2r
|
|
||||||
|
|
||||||
$not-end
|
|
||||||
DUP LIT BRK2r EQU ,$end JNZ2
|
|
||||||
=Console.char
|
|
||||||
#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 #00 EQU JMP JMP2r
|
|
||||||
#30 =Console.char
|
|
||||||
JMP2r
|
|
||||||
|
|
||||||
$digit
|
|
||||||
SWP POP
|
|
||||||
DUP ~number.started ORA #02 JNZ
|
|
||||||
POP JMP2r
|
|
||||||
#30 ADD =Console.char
|
|
||||||
#01 =number.started
|
|
||||||
JMP2r
|
|
||||||
|
|
||||||
@print-short ( short₂ -- )
|
|
||||||
#30 =Console.char
|
|
||||||
#78 =Console.char
|
|
||||||
DUP2 #000c SFT2 ^$digit JSR
|
|
||||||
DUP2 #0008 SFT2 ^$digit JSR
|
|
||||||
DUP2 #0004 SFT2 ^$digit JSR
|
|
||||||
^$digit JSR
|
|
||||||
JMP2r
|
|
||||||
|
|
||||||
$digit
|
|
||||||
#0f AND DUP #0a LTH #03 JNZ
|
|
||||||
#27 ADD
|
|
||||||
#30 ADD =Console.char
|
|
||||||
POP
|
|
||||||
JMP2r
|
|
||||||
|
|
||||||
@strings
|
|
||||||
$start [ 0a Testing 20 started. 0a 0a 00 ]
|
|
||||||
$test [ Test 20 00 ]
|
|
||||||
$fail [ FAIL 00 ]
|
|
||||||
$pass [ pass 00 ]
|
|
||||||
[ UNKNOWN 00 ]
|
|
||||||
$at [ at 20 00 ]
|
|
||||||
$colon [ : 20 00 ]
|
|
||||||
$finish [ 0a Testing 20 complete. 0a 00 ]
|
|
||||||
$passed [ 20 passed, 20 00 ]
|
|
||||||
$failed [ 20 failed, 20 00 ]
|
|
||||||
$unknown [ 20 were 20 unknown. 0a 00 ]
|
|
||||||
|
|
||||||
|
|
@ -6,11 +6,20 @@
|
||||||
|
|
||||||
|10 @Console [ &pad $8 &char $1 ]
|
|10 @Console [ &pad $8 &char $1 ]
|
||||||
|
|
||||||
|
( variables )
|
||||||
|
|
||||||
|
|0000
|
||||||
|
|
||||||
|
@number [ &started $1 ]
|
||||||
|
|
||||||
( init )
|
( init )
|
||||||
|
|
||||||
|0100 ( -> )
|
|0100 ( -> )
|
||||||
|
|
||||||
;hello-word ;print JSR2
|
;hello-word ;print JSR2
|
||||||
|
#ffff ;print-hexadecimal JSR2
|
||||||
|
;is-word ;print JSR2
|
||||||
|
#ffff ;print-decimal JSR2
|
||||||
|
|
||||||
BRK
|
BRK
|
||||||
|
|
||||||
|
|
@ -19,9 +28,48 @@ BRK
|
||||||
&loop
|
&loop
|
||||||
( send ) DUP2 GET .Console/char DEO
|
( send ) DUP2 GET .Console/char DEO
|
||||||
( incr ) #0001 ADD2
|
( incr ) #0001 ADD2
|
||||||
( loop ) DUP2 GET #00 NEQ ,&loop JNZ
|
( loop ) DUP2 GET ,&loop JNZ
|
||||||
POP2
|
POP2
|
||||||
|
|
||||||
RTN
|
RTN
|
||||||
|
|
||||||
@hello-word "hello 20 "World!
|
@print-hexadecimal ( short -- )
|
||||||
|
LIT '0 .Console/char DEO
|
||||||
|
LIT 'x .Console/char DEO
|
||||||
|
DUP2 #000c SFT2 ,&digit JSR
|
||||||
|
DUP2 #0008 SFT2 ,&digit JSR
|
||||||
|
DUP2 #0004 SFT2 ,&digit JSR
|
||||||
|
,&digit JSR
|
||||||
|
RTN
|
||||||
|
|
||||||
|
&digit
|
||||||
|
#0f AND DUP #0a LTH ,¬-alpha JNZ
|
||||||
|
#27 ADD
|
||||||
|
¬-alpha
|
||||||
|
LIT '0 ADD .Console/char DEO
|
||||||
|
POP
|
||||||
|
RTN
|
||||||
|
|
||||||
|
@print-decimal ( short -- )
|
||||||
|
#00 .number/started POK
|
||||||
|
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 PEK ,&end JNZ
|
||||||
|
LIT '0 .Console/char DEO
|
||||||
|
&end
|
||||||
|
RTN
|
||||||
|
|
||||||
|
&digit
|
||||||
|
SWP POP
|
||||||
|
DUP .number/started PEK ORA #02 JNZ
|
||||||
|
POP JMP2r
|
||||||
|
LIT '0 ADD .Console/char DEO
|
||||||
|
#01 .number/started POK
|
||||||
|
RTN
|
||||||
|
|
||||||
|
@hello-word "hello 20 "World! 0a 00
|
||||||
|
@is-word 20 "is 20 00
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue