deleted file mode 100644

@@ -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 ]

+( 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 ,&not-alpha JNZ

+		#27 ADD

+	&not-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

+