nxu/test-fix16.tal

165 lines
6.2 KiB
Tal

( test-fix16.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 )
~fix16.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-x16-add JCN2
;buf LDA LIT "* EQU ;test-x16-mul JCN2
;buf LDA LIT "- EQU ;test-x16-sub JCN2
;buf LDA LIT "/ EQU ;test-x16-div JCN2
;buf LDA LIT "\ EQU ;test-x16-quotient JCN2
;buf LDA LIT "% EQU ;test-x16-remainder JCN2
;buf LDA LIT "w EQU ;test-x16-is-whole JCN2
;buf LDA LIT "N EQU ;test-x16-negate JCN2
;buf LDA LIT "= EQU ;test-x16-eq JCN2
;buf LDA LIT "! EQU ;test-x16-ne JCN2
;buf LDA LIT "< EQU ;test-x16-lt JCN2
;buf LDA LIT "> EQU ;test-x16-gt JCN2
;buf LDA LIT "{ EQU ;test-x16-lteq JCN2
;buf LDA LIT "} EQU ;test-x16-gteq JCN2
;buf LDA LIT "s EQU ;test-x16-sin JCN2
;buf LDA LIT "c EQU ;test-x16-cos JCN2
;buf LDA LIT "t EQU ;test-x16-tan JCN2
;buf LDA LIT "l EQU ;test-x16-log 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-x16-add #04 #02 ;x16-add ;test JMP2
@test-x16-mul #04 #02 ;x16-mul ;test JMP2
@test-x16-sub #04 #02 ;x16-sub ;test JMP2
@test-x16-div #04 #02 ;x16-div ;test JMP2
@test-x16-quotient #04 #02 ;x16-quotient ;test JMP2
@test-x16-remainder #04 #02 ;x16-remainder ;test JMP2
@test-x16-is-whole #02 #01 ;x16-is-whole ;test JMP2
@test-x16-negate #02 #02 ;x16-negate ;test JMP2
@test-x16-eq #04 #01 ;x16-eq ;test JMP2
@test-x16-ne #04 #01 ;x16-ne ;test JMP2
@test-x16-lt #04 #01 ;x16-lt ;test JMP2
@test-x16-lteq #04 #01 ;x16-lteq ;test JMP2
@test-x16-gt #04 #01 ;x16-gt ;test JMP2
@test-x16-gteq #04 #01 ;x16-gteq ;test JMP2
@test-x16-sin #02 #02 ;x16-sin ;test JMP2
@test-x16-cos #02 #02 ;x16-cos ;test JMP2
@test-x16-tan #02 #02 ;x16-tan ;test JMP2
@test-x16-log #02 #02 ;x16-log ;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