177 lines
6.9 KiB
Tal
177 lines
6.9 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 "r EQU ;test-x16-sqrt 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
|
|
;buf LDA LIT "F EQU ;test-x16-floor JCN2
|
|
;buf LDA LIT "C EQU ;test-x16-ceil JCN2
|
|
;buf LDA LIT "R EQU ;test-x16-round JCN2
|
|
;buf LDA LIT "T EQU ;test-x16-to-s16 JCN2
|
|
;buf LDA LIT "8 EQU ;test-x16-to-s8 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-sqrt #02 #02 ;x16-sqrt ;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
|
|
@test-x16-floor #02 #02 ;x16-floor ;test JMP2
|
|
@test-x16-ceil #02 #02 ;x16-ceil ;test JMP2
|
|
@test-x16-round #02 #02 ;x16-round ;test JMP2
|
|
@test-x16-to-s16 #02 #02 ;x16-to-s16 ;test JMP2
|
|
@test-x16-to-s8 #02 #01 ;x16-to-s8 ;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
|