( 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 ( {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-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^ -> ) 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