diff --git a/attic/tests/opcodes.usm b/attic/tests/opcodes.usm deleted file mode 100644 index 59beb96..0000000 --- a/attic/tests/opcodes.usm +++ /dev/null @@ -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 index e809cab..0f8bf0e 100644 --- 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 +