comparisons etc

This commit is contained in:
~d6 2021-12-26 21:01:22 -05:00
parent ae4b4cbcdf
commit a4dd45185d
2 changed files with 214 additions and 166 deletions

View File

@ -13,131 +13,19 @@
%TOR { ROT ROT } ( a b c -> c a b ) %TOR { ROT ROT } ( a b c -> c a b )
%TOR2 { ROT2 ROT2 } %TOR2 { ROT2 ROT2 }
%POP4 { POP2 POP2 } %POP4 { POP2 POP2 }
%COMPLEMENT32 { SWP2 #ffff EOR2 SWP2 #ffff EOR2 }
%X { #0000 #0001 } %RESET-POS { #0000 ;pos STA2 #00 ;buf STA }
%Y { #1234 #ffff } %EMIT-BYTE { DUP #04 SFT DIGIT #0f AND DIGIT }
%Z { #fedc #ba98 }
( devices ) ( devices )
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 ] |10 @Console [ &vector $2 &read $1 &pad $5 &write $1 ]
( program ) ( program )
|0100 |0100
;interact .Console/vector DEO2 ;test-interact .Console/vector DEO2 BRK
BRK
( e.g. #31 #33 -> #13 ) ( bitcount: number of bits needed to represent number )
@parse-byte ( c0 c1 -> x^ ) ( equivalent to floor[log2[x]] + 1 )
( 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
RTN
@buf $24
@pos $2
@read-byte ( addr* -> x^ )
LDA2 ;parse-byte JSR2
RTN
@read-long ( addr* -> x** )
DUP2 ,&loc STR2 LDA2 ;parse-byte JSR2
,&loc LDR2 #0002 ADD2 LDA2 ;parse-byte JSR2
,&loc LDR2 #0004 ADD2 LDA2 ;parse-byte JSR2
,&loc LDR2 #0006 ADD2 LDA2 ;parse-byte JSR2
RTN
[ &loc $2 ]
%POS++ { ;pos LDA2k INC2 SWP2 STA2 }
%RESET-POS { #0000 ;pos STA2 #00 ;buf STA }
@interact
.Console/read DEI ( char^ )
DUP #0a EQU ( char^ char=\n? )
,&exec JCN ( char^ )
;pos LDA2 ;buf ADD2 STA POS++ BRK
&exec
POP ( )
;buf LDA LIT '+ EQU ;test-add32 JCN2
;buf LDA LIT '* EQU ;test-mul32 JCN2
;buf LDA LIT '- EQU ;test-sub32 JCN2
;buf LDA LIT 'L EQU ;test-left-shift JCN2
;buf LDA LIT 'R EQU ;test-right-shift 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
LIT '? EMIT NEWLINE RESET-POS BRK
( format: ". xxxxxxxx" )
%UNARY-32-TEST {
;buf #0002 ADD2 ;read-long JSR2
ROT2 JSR2 ;emit-long JSR2
NEWLINE RESET-POS BRK
}
( format: ". xxxxxxxx yyyyyyyy" )
%BINARY-32-TEST {
;buf #0002 ADD2 ;read-long JSR2
ROT2
;buf #000b ADD2 ;read-long JSR2
ROT2 JSR2 ;emit-long JSR2
NEWLINE RESET-POS BRK
}
@test-add32 ;add32 BINARY-32-TEST
@test-mul32 ;mul32 BINARY-32-TEST
@test-sub32 ;sub32 BINARY-32-TEST
@test-left-shift
( format: "+ xxxxxxxx yy" )
;buf #0002 ADD2 ;read-long JSR2
;buf #000b ADD2 ;read-byte JSR2
;left-shift JSR2 ;emit-long JSR2
NEWLINE RESET-POS BRK
@test-right-shift
( format: "+ xxxxxxxx yy" )
;buf #0002 ADD2 ;read-long JSR2
;buf #000b ADD2 ;read-byte JSR2
;right-shift JSR2 ;emit-long JSR2
NEWLINE RESET-POS BRK
@test-bitcount32
( format: "B xxxxxxxx" )
;buf #0002 ADD2 ;read-long JSR2
;bitcount32 JSR2 ;emit-byte JSR2
NEWLINE RESET-POS BRK
@test-and32 ;and32 BINARY-32-TEST
@test-or32 ;or32 BINARY-32-TEST
@test-xor32 ;xor32 BINARY-32-TEST
@test-complement32 ;complement32 UNARY-32-TEST
@test-negate32 ;negate32 UNARY-32-TEST
@test-eq32
( format: "= xxxxxxxx yyyyyyyy" )
;buf #0002 ADD2 ;read-long JSR2
;buf #000b ADD2 ;read-long JSR2
;eq32 JSR2 ;emit-byte JSR2
NEWLINE RESET-POS BRK
@test-ne32
( format: "= xxxxxxxx yyyyyyyy" )
;buf #0002 ADD2 ;read-long JSR2
;buf #000b ADD2 ;read-long JSR2
;ne32 JSR2 ;emit-byte JSR2
NEWLINE RESET-POS BRK
@bitcount8 ( x^ -> n^ ) @bitcount8 ( x^ -> n^ )
#00 SWP ( n x ) #00 SWP ( n x )
@ -172,6 +60,8 @@ RTN
TOR POP2 #10 ADD ( nhi+16 ) TOR POP2 #10 ADD ( nhi+16 )
RTN RTN
( equality )
@eq32 ( xhi* xlo* yhi* ylo* -> bool^ ) @eq32 ( xhi* xlo* yhi* ylo* -> bool^ )
ROT2 EQU2 #00 TOR2 ROT2 EQU2 #00 TOR2
EQU2 SWP POP AND EQU2 SWP POP AND
@ -190,6 +80,42 @@ RTN
ORA2 #0000 NEQ2 ORA2 #0000 NEQ2
RTN RTN
( comparisons )
( x < y )
@lt32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
LTH2 ,&lt-lo JCN ( xhi yhi )
LTH2 RTN
&lt-lo
GTH2 #00 EQU RTN
( x <= y )
@lteq32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
GTH2 ,&gt-lo JCN ( xhi yhi )
GTH2 #00 EQU RTN
&gt-lo
LTH2 RTN
( x > y )
@gt32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
GTH2 ,&gt-lo JCN ( xhi yhi )
GTH2 RTN
&gt-lo
LTH2 #00 EQU RTN
( x > y )
@gteq32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
LTH2 ,&lt-lo JCN ( xhi yhi )
LTH2 #00 EQU RTN
&lt-lo
GTH2 RTN
( bitwise operations )
@and32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* ) @and32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
ROT2 AND2 TOR2 AND2 SWP2 ROT2 AND2 TOR2 AND2 SWP2
RTN RTN
@ -202,20 +128,11 @@ RTN
ROT2 EOR2 TOR2 EOR2 SWP2 ROT2 EOR2 TOR2 EOR2 SWP2
RTN RTN
%COMPLEMENT32 { SWP2 #ffff EOR2 SWP2 #ffff EOR2 }
@complement32 ( x** -> ~x** ) @complement32 ( x** -> ~x** )
COMPLEMENT32 COMPLEMENT32
RTN RTN
@negate32 ( x** -> -x** ) ( bit shifting )
COMPLEMENT32
INC2 ( ~xhi -xlo )
DUP2 #0000 NEQ2 ( ~xhi -xlo non-zero? )
,&done JCN ( xlo non-zero => don't inc hi )
SWP2 INC2 SWP2 ( -xhi -xlo )
&done
RTN
@right-shift ( x** n^ -> x<<n ) @right-shift ( x** n^ -> x<<n )
DUP #08 LTH ;right-shift0 JCN2 ( x n ) DUP #08 LTH ;right-shift0 JCN2 ( x n )
@ -335,6 +252,8 @@ RTN
SWP2 POP2 SWP POP #0000 #00 SWP2 POP2 SWP POP #0000 #00
RTN RTN
( arithmetic )
@add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* ) @add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* )
,&y2 STR2 ,&y0 STR2 ( save ylo, yhi ) ,&y2 STR2 ,&y0 STR2 ( save ylo, yhi )
,&x2 STR2 ,&x0 STR2 ( save xlo, xhi ) ,&x2 STR2 ,&x0 STR2 ( save xlo, xhi )
@ -363,6 +282,15 @@ RTN
[ &y0 $1 &y1 $1 &y2 $1 &y3 $1 ] [ &y0 $1 &y1 $1 &y2 $1 &y3 $1 ]
[ &z0 $1 &z1 $1 &z2 $2 ] [ &z0 $1 &z1 $1 &z2 $2 ]
@negate32 ( x** -> -x** )
COMPLEMENT32
INC2 ( ~xhi -xlo )
DUP2 #0000 NEQ2 ( ~xhi -xlo non-zero? )
,&done JCN ( xlo non-zero => don't inc hi )
SWP2 INC2 SWP2 ( -xhi -xlo )
&done
RTN
@sub32 ( x** y** -> z** ) @sub32 ( x** y** -> z** )
;negate32 JSR2 ;add32 JSR2 ;negate32 JSR2 ;add32 JSR2
RTN RTN
@ -411,16 +339,16 @@ RTN
[ &y0 $2 &y1 $2 ] [ &y0 $2 &y1 $2 ]
[ &z0 $2 &z1 $2 ] [ &z0 $2 &z1 $2 ]
@divmod32-by-32 ( x** y** -> q** r** ) @divmod32-by-32 ( x** y** -> q** r** )
,&div1 STR2 ,&div0 STR2 ( y -> div ) ,&div1 STR2 ,&div0 STR2 ( y -> div )
,&rem1 STR2 ,&rem0 STR2 ( x -> rem ) ,&rem1 STR2 ,&rem0 STR2 ( x -> rem )
#0000 #0000 ,&quo1 STR2 ,&quo0 ( 0 -> quo ) #0000 ,&quo1 STR2 #0000 ,&quo0 STR2 ( 0 -> quo )
,&rem0 LDR2 ,&rem1 LDR2 ;bitcount32 JSR2 ( rembits^ ) ,&rem0 LDR2 ,&rem1 LDR2 ;bitcount32 JSR2 ( rbits^ )
,&div1 LDR2 ,&div0 LDR2 ;bitcount32 JSR2 ( rembits^ divbits^ ) ,&div0 LDR2 ,&div1 LDR2 ;bitcount32 JSR2 ( rbits^ dbits^ )
SUBk ,&shift STR ( rembits divbits ) SUBk ,&shift STR ( rbits-dbits -> shift )
,&div0 LDR2 ,&div1 LDR2 ,&div0 LDR2 ,&div1 LDR2 ,&shift LDR ;left-shift JSR2 ( div<<shift )
,&div1 STR2 ,&div0 STR2
RTN RTN
[ &div0 $2 &div1 $2 [ &div0 $2 &div1 $2
&rem0 $2 &rem1 $2 &rem0 $2 &rem1 $2
@ -443,23 +371,140 @@ RTN
RTN RTN
[ &y $1 &q0 $1 ] [ &y $1 &q0 $1 ]
@emit-long ( hi* lo* -> ) ( testing )
SWP2 ( lo* hi* )
;emit-short JSR2 ( parses hex representation e.g. #31 #33 -> #13 )
;emit-short JSR2 @parse-byte ( c0 c1 -> x^ )
( 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
RTN RTN
%EMIT-BYTE { DUP #04 SFT DIGIT #0f AND DIGIT } @buf $24 ( buffer used by test-interact )
@pos $2 ( position in buffer used by test-interact )
( save character input and execute tests on \n )
( tests always start with a single character and a space )
( then additional arguments are passed. )
@test-interact
.Console/read DEI ( char^ )
DUP #0a EQU ( char^ char=\n? )
,&exec JCN ( char^ )
;pos LDA2 ;buf ADD2 STA
;pos LDA2k INC2 SWP2 STA2 BRK
&exec
POP ( )
;buf LDA LIT '+ EQU ;test-add32 JCN2
;buf LDA LIT '* EQU ;test-mul32 JCN2
;buf LDA LIT '- EQU ;test-sub32 JCN2
;buf LDA LIT 'L EQU ;test-left-shift JCN2
;buf LDA LIT 'R EQU ;test-right-shift 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 '? EMIT NEWLINE RESET-POS BRK
@read-byte ( addr* -> x^ )
LDA2 ;parse-byte JSR2
RTN
@read-long ( addr* -> x** )
DUP2 ,&loc STR2 LDA2 ;parse-byte JSR2
,&loc LDR2 #0002 ADD2 LDA2 ;parse-byte JSR2
,&loc LDR2 #0004 ADD2 LDA2 ;parse-byte JSR2
,&loc LDR2 #0006 ADD2 LDA2 ;parse-byte JSR2
RTN
[ &loc $2 ]
( format: ". xxxxxxxx" -> "zzzzzzzz" )
@unary-32-test
;buf #0002 ADD2 ;read-long JSR2
ROT2 JSR2 ;emit-long JSR2
NEWLINE RESET-POS BRK
( format: ". xxxxxxxx" -> "zz" )
@unary-32-8-test
;buf #0002 ADD2 ;read-long JSR2
ROT2 JSR2 ;emit-byte JSR2
NEWLINE RESET-POS BRK
( format: ". xxxxxxxx yyyyyyyy" -> "zzzzzzzz" )
@binary-32-test
;buf #0002 ADD2 ;read-long JSR2
ROT2
;buf #000b ADD2 ;read-long JSR2
ROT2 JSR2 ;emit-long JSR2
NEWLINE RESET-POS BRK
( format: ". xxxxxxxx yy" -> "zzzzzzzz" )
@binary-32-8-32-test
;buf #0002 ADD2 ;read-long JSR2
ROT2
;buf #000b ADD2 ;read-byte JSR2
TOR JSR2 ;emit-long JSR2
NEWLINE RESET-POS BRK
( format: ". xxxxxxxx yyyyyyyy" -> "zz" )
@binary-32-32-8-test
;buf #0002 ADD2 ;read-long JSR2
ROT2
;buf #000b ADD2 ;read-long JSR2
ROT2 JSR2 ;emit-byte JSR2
NEWLINE RESET-POS BRK
( different test executors )
@test-add32 ;add32 ;binary-32-test JMP2
@test-mul32 ;mul32 ;binary-32-test JMP2
@test-sub32 ;sub32 ;binary-32-test JMP2
@test-left-shift ;left-shift ;binary-32-8-32-test JMP2
@test-right-shift ;right-shift ;binary-32-8-32-test JMP2
@test-bitcount32 ;bitcount32 ;unary-32-8-test JMP2
@test-and32 ;and32 ;binary-32-test JMP2
@test-or32 ;or32 ;binary-32-test JMP2
@test-xor32 ;xor32 ;binary-32-test JMP2
@test-complement32 ;complement32 ;unary-32-test JMP2
@test-negate32 ;negate32 ;unary-32-test JMP2
@test-eq32 ;eq32 ;binary-32-32-8-test JMP2
@test-ne32 ;ne32 ;binary-32-32-8-test JMP2
@test-is-zero32 ;is-zero32 ;unary-32-8-test JMP2
@test-non-zero32 ;non-zero32 ;unary-32-8-test JMP2
@test-lt32 ;lt32 ;binary-32-32-8-test JMP2
@test-lteq32 ;lteq32 ;binary-32-32-8-test JMP2
@test-gt32 ;gt32 ;binary-32-32-8-test JMP2
@test-gteq32 ;gteq32 ;binary-32-32-8-test JMP2
@emit-long ( hi* lo* -> )
SWP2
SWP EMIT-BYTE EMIT-BYTE
SWP EMIT-BYTE EMIT-BYTE
RTN
@emit-short ( x* -> ) @emit-short ( x* -> )
SWP ( lo^ hi^ ) SWP EMIT-BYTE EMIT-BYTE
EMIT-BYTE EMIT-BYTE
RTN RTN
@emit-byte ( x^ -> ) @emit-byte ( x^ -> )
EMIT-BYTE EMIT-BYTE
RTN RTN
( convenience for less branching when printing hex )
@digits @digits
30 31 32 33 34 35 36 37 30 31 32 33 34 35 36 37
38 39 61 62 63 64 65 66 38 39 61 62 63 64 65 66

View File

@ -1,8 +1,9 @@
#!/usr/bin/python #!/usr/bin/python
from math import floor, log
from os import environ from os import environ
from subprocess import Popen, PIPE
from random import randint from random import randint
from subprocess import Popen, PIPE
u3 = {'sz': 1 << 3, 'fmt': b'%02x'} u3 = {'sz': 1 << 3, 'fmt': b'%02x'}
u5 = {'sz': 1 << 5, 'fmt': b'%02x'} u5 = {'sz': 1 << 5, 'fmt': b'%02x'}
@ -33,48 +34,50 @@ def testcase(p, sym, args, out, f):
res[name] = x res[name] = x
return res return res
def test(p, runs, sym, args, out, f): def test(p, trials, sym, args, out, f):
fails = 0 fails = 0
cases = [] cases = []
maximum = (1 << 32) - 1 maximum = (1 << 32) - 1
for i in range(0, runs): for i in range(0, trials):
case = testcase(p, sym, args, out, f) case = testcase(p, sym, args, out, f)
if case is not None: if case is not None:
fails += 1 fails += 1
cases.append(case) cases.append(case)
name = sym.decode('utf-8') name = sym.decode('utf-8')
if fails == 0: if fails == 0:
print('%s passed %d runs' % (name, runs)) print('%s passed %d trials' % (name, trials))
else: else:
print('%s failed %d/%d runs (%r)' % (name, fails, runs, cases)) print('%s failed %d/%d trials (%r)' % (name, fails, trials, cases))
def pipe(): def pipe():
cli = environ['HOME'] + '/w/uxn/bin/uxncli' cli = environ['HOME'] + '/w/uxn/bin/uxncli'
return Popen([cli, 'run.rom'], stdin=PIPE, stdout=PIPE) return Popen([cli, 'run.rom'], stdin=PIPE, stdout=PIPE)
def bitcount(x): def bitcount(x):
n = 0 return floor(log(x, 2)) + 1
while x > 0:
n += 1
x = x >> 1
return n
def main(): def main():
runs = 1000 trials = 1000
p = pipe() p = pipe()
test(p, runs, b'+', [('x', u32), ('y', u32)], u32, lambda x, y: x + y) test(p, trials, b'+', [('x', u32), ('y', u32)], u32, lambda x, y: x + y)
test(p, runs, b'-', [('x', u32), ('y', u32)], u32, lambda x, y: x - y) test(p, trials, b'-', [('x', u32), ('y', u32)], u32, lambda x, y: x - y)
test(p, runs, b'*', [('x', u32), ('y', u32)], u32, lambda x, y: x * y) test(p, trials, b'*', [('x', u32), ('y', u32)], u32, lambda x, y: x * y)
test(p, runs, b'L', [('x', u32), ('y', u5)], u32, lambda x, y: x << y) test(p, trials, b'L', [('x', u32), ('y', u5)], u32, lambda x, y: x << y)
test(p, runs, b'R', [('x', u32), ('y', u5)], u32, lambda x, y: x >> y) test(p, trials, b'R', [('x', u32), ('y', u5)], u32, lambda x, y: x >> y)
test(p, runs, b'B', [('x', u32)], u8, bitcount) test(p, trials, b'B', [('x', u32)], u8, bitcount)
test(p, runs, b'&', [('x', u32), ('y', u32)], u32, lambda x, y: x & y) test(p, trials, b'&', [('x', u32), ('y', u32)], u32, lambda x, y: x & y)
test(p, runs, b'|', [('x', u32), ('y', u32)], u32, lambda x, y: x | y) test(p, trials, b'|', [('x', u32), ('y', u32)], u32, lambda x, y: x | y)
test(p, runs, b'^', [('x', u32), ('y', u32)], u32, lambda x, y: x ^ y) test(p, trials, b'^', [('x', u32), ('y', u32)], u32, lambda x, y: x ^ y)
test(p, runs, b'~', [('x', u32)], u32, lambda x: ~x) test(p, trials, b'~', [('x', u32)], u32, lambda x: ~x)
test(p, runs, b'N', [('x', u32)], u32, lambda x: -x) test(p, trials, b'N', [('x', u32)], u32, lambda x: -x)
test(p, runs, b'=', [('x', u32), ('y', u32)], u8, lambda x, y: int(x == y)) test(p, trials, b'=', [('x', u32), ('y', u32)], u8, lambda x, y: int(x == y))
test(p, runs, b'!', [('x', u32), ('y', u32)], u8, lambda x, y: int(x != y)) test(p, trials, b'!', [('x', u32), ('y', u32)], u8, lambda x, y: int(x != y))
test(p, trials, b'0', [('x', u32)], u8, lambda x: int(x == 0))
test(p, trials, b'Z', [('x', u32)], u8, lambda x: int(x != 0))
test(p, trials, b'<', [('x', u32), ('y', u32)], u8, lambda x, y: int(x < y))
test(p, trials, b'>', [('x', u32), ('y', u32)], u8, lambda x, y: int(x > y))
test(p, trials, b'{', [('x', u32), ('y', u32)], u8, lambda x, y: int(x <= y))
test(p, trials, b'}', [('x', u32), ('y', u32)], u8, lambda x, y: int(x >= y))
p.stdin.close() p.stdin.close()
p.stdout.close() p.stdout.close()