173 lines
6.5 KiB
Tal
173 lines
6.5 KiB
Tal
|
( testing.tal )
|
||
|
|
( )
|
||
|
|
( testing uxntal words based on input/output bytes. )
|
||
|
|
( )
|
||
|
|
( this harness works best testing words that are "pure" )
|
||
|
|
( in the sense that they read from the data stack and )
|
||
|
|
( write results back onto the data stack. words which )
|
||
|
|
( manipulate the return stack or read/write from devices )
|
||
|
|
( may require something else. )
|
||
|
|
( )
|
||
|
|
( the model is as follows: )
|
||
|
|
( )
|
||
|
|
( - each test case is a line of text ending in a newline )
|
||
|
|
( - lines starts with a character that selects a test )
|
||
|
|
( - after that, 0 or more hexadecimal bytes are provided )
|
||
|
|
( - the test runs )
|
||
|
|
( - result is 0 or more hexadecimal bytes (or an error) )
|
||
|
|
( - an empty line ends the test )
|
||
|
|
( )
|
||
|
|
( for example, the input "+12345678\n" would run a test )
|
||
|
|
( selected by "+" with 4 input bytes on the stack: )
|
||
|
|
( )
|
||
|
|
( wst: 12 34 56 78 )
|
||
|
|
( )
|
||
|
|
( each case should be added to @interact, along with the )
|
||
|
|
( number of bytes it expects to read and write. )
|
||
|
|
|
||
|
|
( program )
|
||
|
|
|0100 ;interact #10 DEO2 BRK
|
||
|
|
|
||
|
|
( include the code being tested )
|
||
|
|
~math32.tal
|
||
|
|
|
||
|
|
( testing )
|
||
|
|
@buf $33 ( line buffer, not including trailing newline )
|
||
|
|
@pos $2 ( next position in buffer to write to )
|
||
|
|
|
||
|
|
( save character input and execute tests )
|
||
|
|
( )
|
||
|
|
( tests always start with a single character then )
|
||
|
|
( additional arguments are passed as bytes before )
|
||
|
|
( a terminating newline. )
|
||
|
|
( )
|
||
|
|
( the last byte read will be on the top of the stack )
|
||
|
|
( and the earliest on the bottom. )
|
||
|
|
@interact
|
||
|
|
#12 DEI ( read c )
|
||
|
|
DUP #0a EQU ,&exec JCN ( exec if c is a newline )
|
||
|
|
;pos LDA2 ;buf ADD2 STA ( else write c to buf+pos )
|
||
|
|
;pos LDA2k INC2 SWP2 STA2 BRK ( increment pos )
|
||
|
|
&exec POP ( )
|
||
|
|
;pos LDA2 #0000 EQU2 ;exit JCN2 ( exit on an empty line )
|
||
|
|
;buf LDA LIT "+ EQU ;test-add32 JCN2
|
||
|
|
;buf LDA LIT "* EQU ;test-mul32 JCN2
|
||
|
|
;buf LDA LIT "- EQU ;test-sub32 JCN2
|
||
|
|
;buf LDA LIT "/ EQU ;test-div32 JCN2
|
||
|
|
;buf LDA LIT "% EQU ;test-mod32 JCN2
|
||
|
|
;buf LDA LIT "G EQU ;test-gcd32 JCN2
|
||
|
|
;buf LDA LIT "L EQU ;test-lshift32 JCN2
|
||
|
|
;buf LDA LIT "R EQU ;test-rshift32 JCN2
|
||
|
|
;buf LDA LIT "B EQU ;test-bitcount32 JCN2
|
||
|
|
;buf LDA LIT "& EQU ;test-and32 JCN2
|
||
|
|
;buf LDA LIT "| EQU ;test-or32 JCN2
|
||
|
|
;buf LDA LIT "^ EQU ;test-xor32 JCN2
|
||
|
|
;buf LDA LIT "~ EQU ;test-complement32 JCN2
|
||
|
|
;buf LDA LIT "N EQU ;test-negate32 JCN2
|
||
|
|
;buf LDA LIT "= EQU ;test-eq32 JCN2
|
||
|
|
;buf LDA LIT "! EQU ;test-ne32 JCN2
|
||
|
|
;buf LDA LIT "0 EQU ;test-is-zero32 JCN2
|
||
|
|
;buf LDA LIT "Z EQU ;test-non-zero32 JCN2
|
||
|
|
;buf LDA LIT "< EQU ;test-lt32 JCN2
|
||
|
|
;buf LDA LIT "> EQU ;test-gt32 JCN2
|
||
|
|
;buf LDA LIT "{ EQU ;test-lteq32 JCN2
|
||
|
|
;buf LDA LIT "} EQU ;test-gteq32 JCN2
|
||
|
|
LIT "? #18 DEO #0a #18 DEO ;reset JSR2 BRK
|
||
|
|
|
||
|
|
( set the interpreter to exit now )
|
||
|
|
@exit
|
||
|
|
#01 #0f DEO BRK
|
||
|
|
|
||
|
|
( reads j bytes, emits k bytes )
|
||
|
|
@test ( j^ k^ word* -> )
|
||
|
|
STH2 STH STH ( {j k word} )
|
||
|
|
;buf INC2 STHr ( buf+1 j {k word} )
|
||
|
|
;read-bytes JSR2 ( <j-bytes> {k word} )
|
||
|
|
ROTr ROTr STH2r ( <j-bytes> word {k} )
|
||
|
|
JSR2 STHr ( <k-bytes> k )
|
||
|
|
;emit-bytes JSR2 ( )
|
||
|
|
#0a #18 DEO ( )
|
||
|
|
;reset JSR2 BRK ( )
|
||
|
|
|
||
|
|
( reset the interpreter to read another line )
|
||
|
|
@reset ( -> )
|
||
|
|
#0000 ;pos STA2
|
||
|
|
#00 ;buf STA
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
( different test executors )
|
||
|
|
( )
|
||
|
|
( TEST-NAME #IN #OUT WORD-TO-TEST HARNESS )
|
||
|
|
@test-add32 #08 #04 ;add32 ;test JMP2
|
||
|
|
@test-mul32 #08 #04 ;mul32 ;test JMP2
|
||
|
|
@test-sub32 #08 #04 ;sub32 ;test JMP2
|
||
|
|
@test-div32 #08 #04 ;div32 ;test JMP2
|
||
|
|
@test-mod32 #08 #04 ;mod32 ;test JMP2
|
||
|
|
@test-gcd32 #08 #04 ;gcd32 ;test JMP2
|
||
|
|
@test-lshift32 #05 #04 ;lshift32 ;test JMP2
|
||
|
|
@test-rshift32 #05 #04 ;rshift32 ;test JMP2
|
||
|
|
@test-bitcount32 #04 #01 ;bitcount32 ;test JMP2
|
||
|
|
@test-and32 #08 #04 ;and32 ;test JMP2
|
||
|
|
@test-or32 #08 #04 ;or32 ;test JMP2
|
||
|
|
@test-xor32 #08 #04 ;xor32 ;test JMP2
|
||
|
|
@test-complement32 #04 #04 ;complement32 ;test JMP2
|
||
|
|
@test-negate32 #04 #04 ;negate32 ;test JMP2
|
||
|
|
@test-eq32 #08 #01 ;eq32 ;test JMP2
|
||
|
|
@test-ne32 #08 #01 ;ne32 ;test JMP2
|
||
|
|
@test-is-zero32 #04 #01 ;is-zero32 ;test JMP2
|
||
|
|
@test-non-zero32 #04 #01 ;non-zero32 ;test JMP2
|
||
|
|
@test-lt32 #08 #01 ;lt32 ;test JMP2
|
||
|
|
@test-lteq32 #08 #01 ;lteq32 ;test JMP2
|
||
|
|
@test-gt32 #08 #01 ;gt32 ;test JMP2
|
||
|
|
@test-gteq32 #08 #01 ;gteq32 ;test JMP2
|
||
|
|
|
||
|
|
( reads one byte from ASCII: "13" -> 0x13 )
|
||
|
|
@read-byte ( c0^ c1^ -> n^ )
|
||
|
|
( lower char )
|
||
|
|
DUP #3a LTH ,&lo-digit JCN
|
||
|
|
#57 ,&lo JMP &lo-digit #30
|
||
|
|
&lo SUB SWP
|
||
|
|
( higher char )
|
||
|
|
DUP #3a LTH ,&hi-digit JCN
|
||
|
|
#57 ,&hi JMP &hi-digit #30
|
||
|
|
&hi SUB #40 SFT ORA
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
( read k bytes from the buffer )
|
||
|
|
@read-bytes ( addr* k^ -> <k bytes> )
|
||
|
|
DUP ,&non-zero JCN ( addr k )
|
||
|
|
POP POP2 JMP2r ( )
|
||
|
|
&non-zero
|
||
|
|
STH STH2k ( addr {addr k} )
|
||
|
|
LDA2 ;read-byte JSR2 ( byte {addr k} )
|
||
|
|
STH2r #0002 ADD2 ( byte addr+2 {k} )
|
||
|
|
STHr #01 SUB ( byte addr+2 k-1 )
|
||
|
|
,read-bytes JMP ( byte addr+2 k-1 )
|
||
|
|
|
||
|
|
( emit n bytes from the stack, earliest first )
|
||
|
|
( )
|
||
|
|
( examples: )
|
||
|
|
( - #aa #bb #cc #03 will emit "aabbcc" )
|
||
|
|
( - #aa #bb #01 will emit "bb" leaving aa on wst )
|
||
|
|
( - #00 will emit nothing )
|
||
|
|
@emit-bytes ( <n bytes> n -> )
|
||
|
|
DUP
|
||
|
|
&loop ( <b0..bk> n k {<bk+1..bn>} )
|
||
|
|
DUP #00 EQU ,&next JCN
|
||
|
|
ROT STH #01 SUB ( <b0..bk-1> n k-1 <bk..bn> )
|
||
|
|
,&loop JMP
|
||
|
|
&next ( n 0 {<b0..bn>} )
|
||
|
|
POP
|
||
|
|
&while ( n-i {<bi..bn>} )
|
||
|
|
DUP #00 EQU ,&done JCN
|
||
|
|
STHr ;emit JSR2 #01 SUB
|
||
|
|
,&while JMP
|
||
|
|
&done
|
||
|
|
POP JMP2r
|
||
|
|
|
||
|
|
( emit a single byte in hexadecimal notation )
|
||
|
|
@emit
|
||
|
|
DUP #04 SFT ,&char JSR
|
||
|
|
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
||
|
|
JMP2r
|