nxu/test-fix16.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