commit 268ccd0519c986db7bda19e7b2ceb8169525071c
parent fa2d290351c48268d4a178e40643c15215e63973
Author: Andrew Alderwick <andrew@alderwick.co.uk>
Date: Sat, 24 Apr 2021 09:30:36 +0100
Moved printing routines from tests/opcodes to console example
Diffstat:
2 files changed, 50 insertions(+), 165 deletions(-)
diff --git a/attic/tests/opcodes.usm b/attic/tests/opcodes.usm
@@ -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 ]
-
diff --git a/projects/examples/devices/console.usm b/projects/examples/devices/console.usm
@@ -6,11 +6,20 @@
|10 @Console [ &pad $8 &char $1 ]
+( variables )
+
+|0000
+
+@number [ &started $1 ]
+
( init )
|0100 ( -> )
;hello-word ;print JSR2
+ #ffff ;print-hexadecimal JSR2
+ ;is-word ;print JSR2
+ #ffff ;print-decimal JSR2
BRK
@@ -19,9 +28,48 @@ BRK
&loop
( send ) DUP2 GET .Console/char DEO
( incr ) #0001 ADD2
- ( loop ) DUP2 GET #00 NEQ ,&loop JNZ
+ ( loop ) DUP2 GET ,&loop JNZ
POP2
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
+
