( 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 ;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 ( {k word} ) ROTr ROTr STH2r ( word {k} ) JSR2 STHr ( 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 @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^ -> ) 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 -> ) DUP &loop ( n k {} ) DUP #00 EQU ,&next JCN ROT STH #01 SUB ( n k-1 ) ,&loop JMP &next ( n 0 {} ) POP &while ( n-i {} ) 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