rewrite swinemeeper autoreveal in assembly

This commit is contained in:
Jeremy Penner 2023-10-07 22:49:38 -04:00
parent f45d523bdd
commit 8afdda713d
6 changed files with 90 additions and 14 deletions

View file

@ -178,7 +178,7 @@ var ignoreimm
: >grp3* ( reg -- ) : >grp3* ( reg -- )
dup 0xf6 ' >extbreg|mem* *? if drop 2ret then dup 0xf6 ' >extbreg|mem* *? if drop 2ret then
0xf7 ' >extwreg|mem* *? if 2ret then ; 0xf7 ' >extwreg|mem* *? if 2ret then ;
1 :op RET- oparg-imm? if 0xc2 >t oparg-val @ w>t then ; 1 :op RET- oparg-imm? if 0xc2 >t oparg-val @ w>t then ;
1 :op RETF- oparg-imm? if 0xca >t oparg-val @ w>t then ; 1 :op RETF- oparg-imm? if 0xca >t oparg-val @ w>t then ;
1 :op PUSH 1 :op PUSH
@ -301,6 +301,7 @@ var ignoreimm
arg2 oparg-reg? oparg-val @ 0x00 = and arg1 oparg-wreg? and arg2 oparg-reg? oparg-val @ 0x00 = and arg1 oparg-wreg? and
if 0x90 >wreg+op* then if 0x90 >wreg+op* then
0x86 >bar-war* ; 0x86 >bar-war* ;
2 :op MOV 2 :op MOV
0x88 >bmr-wmr-brm-wrm* 0x88 >bmr-wmr-brm-wrm*
arg2 oparg-imm? arg1 if arg2 oparg-imm? arg1 if
@ -325,6 +326,8 @@ var ignoreimm
2 :op RCR 3 >grp2* ; 2 :op SHL 4 >grp2* ; 2 :op SHR 5 >grp2* ; 2 :op RCR 3 >grp2* ; 2 :op SHL 4 >grp2* ; 2 :op SHR 5 >grp2* ;
2 :op SAR 7 >grp2* ; 2 :op SAR 7 >grp2* ;
2 :op TEST 0x84 >bar-war* 0 >grp3* ;
1 :op NOT 2 >grp3* ; 1 :op NEG 3 >grp3* ; 1 :op MUL 4 >grp3* ; 1 :op NOT 2 >grp3* ; 1 :op NEG 3 >grp3* ; 1 :op MUL 4 >grp3* ;
1 :op IMUL 5 >grp3* ; 1 :op DIV 6 >grp3* ; 1 :op IDIV 7 >grp3* ; 1 :op IMUL 5 >grp3* ; 1 :op DIV 6 >grp3* ; 1 :op IDIV 7 >grp3* ;

Binary file not shown.

BIN
swine.com

Binary file not shown.

View file

@ -92,18 +92,91 @@ array board maxw maxh * allot
dup mine? if lose then FREVEALED swap b!| dup mine? if lose then FREVEALED swap b!|
else drop then ; else drop then ;
: visibly-empty? dup revealed? swap squarecount not and ; var autoreveal-count
: backtrack-square ( p -- p ) boardw @ - 1- dup board < if drop board then ; ( autoreveal: Happens row-at-a-time in optimized machine code.
: backtrack? ( p -- f ) ar-check-dir: a strip of squares is checked for visibly empty neighbours
dup revealed? over 1+ revealed? and swap 2 + revealed? and not ; against its corresponding square in a given direction, specified with BX.
: autoreveal-backtrack ( -- ) autoreveal-count is incremented whenever a new square is revealed.
i visibly-empty? i backtrack-square backtrack? and The strips are carefully constructed so as to not step over the edge of
if i backtrack-square 1- idrop >i then ; the board.
: autoreveal ( -- ) This is _not_ a Forth word, it's called with CALL by the words below.
iterboard each i revealed? not if autoreveal-row-above: check the nw, n, and ne squares with ar-check-dir.
i ' visibly-empty? count-neighbours autoreveal-row-horiz: check the w and e squares with ar-check-dir.
if i reveal autoreveal-backtrack then autoreveal-row-below: check the sw, s, and se squares with ar-check-dir.
then next ; autoreveal-fast: iterates over the rows of the board and checks each row
against itself and the strips above and below. If anything new is
autorevealed in the current row, we check the previous row again. )
L: ar-check-dir
( in: DI - row to reveal
BX - offset of row to check
CH - 0, CL - count of squares to check
out: DI, BX, CX - preserved
trampled: AX, DX )
MOV AX DS
MOV ES AX
MOV AL FREVEALED # ( AL - byte value of visibly empty square )
( DI is now row to check, BX+DI is row to reveal )
MOV DH CL
ADD DI BX
NEG BX
DEC BX ( DI will be one past the square that was checked when SCASB returns )
0 :>
JCXZ 2 @> ( end of row, exit )
REPNZ SCASB ( search for visibly empty square )
JNZ 1 @> ( none found, exit )
MOV DL @[ BX+DI]
TEST DL AL
JNZ 0 <@ ( already revealed, keep searching )
OR DL AL
AND DL FFLAG ~ #
MOV @[ BX+DI] DL
INC @[ autoreveal-count @]
JMP 0 <@
1 <: 2 <:
( revert DI, BX and CX to previous value )
MOV CL DH
SUB DI CX
INC BX
ADD DI BX
NEG BX
RET
:asm autoreveal-row-above ( p -- )
POP DI
MOV CX @[ boardw @]
MOV BX CX NEG BX ( directly above )
CALL ar-check-dir
L: autoreveal-left-right
DEC CX INC BX ( to the right )
CALL ar-check-dir
DEC BX DEC BX INC DI ( to the left )
CALL ar-check-dir
NEXT
:asm autoreveal-row-horiz ( p -- )
POP DI
MOV CX @[ boardw @]
XOR BX BX ( on the current square )
JMP autoreveal-left-right
:asm autoreveal-row-below ( p -- )
POP DI
MOV CX @[ boardw @]
MOV BX CX ( directly below )
CALL ar-check-dir
JMP autoreveal-left-right
: autoreveal-fast
iterrows each
0 autoreveal-count !
i autoreveal-row-horiz
i board > if i autoreveal-row-above then
i lastrow? not if i autoreveal-row-below then
i board > autoreveal-count @ and if
( backtrack ) <i boardw @ 2* - >i
then
next ;
: won? ( -- f ) : won? ( -- f )
1 iterboard each i b@ FMINE FREVEALED | & not if not break then next ; 1 iterboard each i b@ FMINE FREVEALED | & not if not break then next ;
@ -114,7 +187,7 @@ array board maxw maxh * allot
if click neighbours each i reveal next else drop then ; if click neighbours each i reveal next else drop then ;
: reveal-at square-at dup revealed? : reveal-at square-at dup revealed?
if reveal-unflagged-neighbours? else reveal click then if reveal-unflagged-neighbours? else reveal click then
autoreveal check-win ; autoreveal-fast check-win ;
: flag-noise ( p -- ) b@ FFLAG & if moop else meep then ; : flag-noise ( p -- ) b@ FFLAG & if moop else meep then ;
: flag-at square-at dup revealed? not : flag-at square-at dup revealed? not
if FFLAG swap dup flag-noise b!^ else drop then ; if FFLAG swap dup flag-noise b!^ else drop then ;

Binary file not shown.

Binary file not shown.