~euhmeuh/ferale

303b4e3ceb53ee3c89365c753c099b1b72e675e9 — Zoé Martin 3 months ago 60f8c72 master
implémente SHF, ROT et SWP (nouvelle specification)
1 files changed, 33 insertions(+), 23 deletions(-)

M emu/louve.fs
M emu/louve.fs => emu/louve.fs +33 -23
@@ 16,6 16,8 @@
\ ================================================

: 3dup  ( a b c -- a b c a b c )  2 pick 2 pick 2 pick ;
: wror ( val n -- val )  0 ?do dup $0001 and 15 lshift swap 1 rshift or loop $FFFF and ;
: wrol ( val n -- val )  0 ?do dup $8000 and 15 rshift swap 1 lshift or loop $FFFF and ;

false value DEBUG
true value STOPPED


@@ 34,8 36,8 @@ CREATE PRIVREGS   4 cells allot
: ISR  PRIVREGS 2 cells + ;
: IPC  PRIVREGS 3 cells + ;

0 VALUE INTLINE
0 VALUE NMILINE
0 VALUE INTLINE \ interrupt line
0 VALUE IGRLINE \ interrupt grant line

: reset-regmem   ( -- )  REGMEM 2048 cells erase ;
: reset-regs     ( -- )  REGS      8 cells erase ;


@@ 53,11 55,6 @@ CREATE PRIVREGS   4 cells allot
: w-      ( a b -- dif )  16neg w+ ;
: w+!     ( a addr -- )   tuck @ w+ swap ! ;

: swap-bytes  ( $AABB -- $BBAA )
  dup $FF00 and 8 rshift swap
      $00FF and 8 lshift or
;

: mask  ( val mask rshift -- result )  -rot and swap rshift ;

: process ( -- proc )    SR @ $F000 12 mask ;


@@ 71,7 68,6 @@ CREATE PRIVREGS   4 cells allot
: sr-neg    4 ;
: sr-ovf    5 ;
: sr-int    6 ;
: sr-nmi    7 ;
: sr?      ( bit -- b )  dup 1 swap lshift SR @ -rot swap mask ;
: sr!      ( b bit -- )  1 swap lshift swap  ( mask b )
                         if             SR @ or  SR !


@@ 184,7 180,9 @@ defer mem!  ( val vaddr -- )

: A   ( -- val )  SRC SMODE read ;
: B   ( -- val )  DST DMODE read ;
: A#  ( -- val )  SRC SMODE read# ; \ read SRC without persisting
: B#  ( -- val )  DST DMODE read# ; \ read DST without persisting
: A!  ( -- val )  SRC SMODE save! ;
: B!  ( -- val )  DST DMODE save! ;
: C   ( -- carry ) sr-carry sr? ;
: M   ( -- max )   sr-max sr? ;


@@ 202,9 200,12 @@ defer mem!  ( val vaddr -- )
: (ADC)  ( -- )  C B# A add stat! B! ;
: (SUB)  ( -- )  0 B# A sub stat! B! ;
: (SBC)  ( -- )  C B# A sub stat! B! ;
: (SHL)  ( -- )  B#  A $F and 0 do 1 lshift catchC applyM loop neg! zero! B! ;
: (SHR)  ( -- )  B#  A $F and 0 do catchM 1 rshift applyC loop neg! zero! B! ;
: (SWP)  ( -- )  A swap-bytes  stat! B! ;
: (SHF)  ( -- )  B#
                 SMODE if   SRC 0 ?do 1 lshift catchC applyM loop
                       else SRC 0 ?do catchM 1 rshift applyC loop
                 then neg! zero! B! ;
: (ROT)  ( -- )  B# SRC SMODE if wrol else wror then stat! B! ;
: (SWP)  ( -- )  B# A# stat! B! A! ; \ only dest triggers stat changes
: (NOT)  ( -- )  A inv         stat! B! ;
: (AND)  ( -- )  A B# and      stat! B! ;
: (IOR)  ( -- )  A B#  or      stat! B! ;


@@ 277,8 278,8 @@ defer mem!  ( val vaddr -- )
    $2 of (ADC) endof
    $3 of (SUB) endof
    $4 of (SBC) endof
    $5 of (SHL) endof
    $6 of (SHR) endof
    $5 of (SHF) endof
    $6 of (ROT) endof
    $7 of (SWP) endof
    $8 of (NOT) endof
    $9 of (AND) endof


@@ 440,9 441,9 @@ sr-carry     0 ASSERT-STATUS
\ SBC


TEST: ( SHL )
TEST: ( Shift left )
$0F08 ,, $0001 ,,  \ MOV 1,R0
$5F08 ,, $0004 ,,  \ SHL 4,R0
$5404 ,,           \ SHF -4,R0
$E000 ,,           \ HALT
RUN
sr-carry  0 ASSERT-STATUS


@@ 450,7 451,7 @@ sr-max    0 ASSERT-STATUS
0        16 ASSERT-REG

$0F08 ,, $FFFF ,,  \ MOV $FFFF,R0
$5F08 ,, $0004 ,,  \ SHL 4,R0
$5404 ,,           \ SHF -4,R0
$E000 ,,           \ HALT
RUN
sr-carry     1 ASSERT-STATUS


@@ 459,7 460,7 @@ sr-max       1 ASSERT-STATUS

$0F18 ,, $2000 ,,  \ MOV $2000,R1
$0F08 ,, $FFFF ,,  \ MOV $FFFF,R0
$5F18 ,, $0003 ,,  \ SHL 3,R1
$5314 ,,           \ SHF -3,R1
$E000 ,,           \ HALT
RUN
sr-carry 1 ASSERT-STATUS


@@ 467,9 468,9 @@ sr-max   1 ASSERT-STATUS
1        7 ASSERT-REG


TEST: ( SHR )
TEST: ( Shift right )
$0F08 ,, $0001 ,,  \ MOV 1,R0
$6F08 ,, $0001 ,,  \ SHR 1,R0
$5100 ,,           \ SHF 1,R0
$E000 ,,           \ HALT
RUN
sr-carry  0 ASSERT-STATUS


@@ 477,7 478,7 @@ sr-max    1 ASSERT-STATUS
0         0 ASSERT-REG

$0F08 ,, $FFFF ,,  \ MOV $FFFF,R0
$6F08 ,, $0004 ,,  \ SHR 4,R0
$5400 ,,           \ SHF 4,R0
$E000 ,,           \ HALT
RUN
sr-carry     0 ASSERT-STATUS


@@ 486,7 487,7 @@ sr-max       1 ASSERT-STATUS

$0F18 ,, $0008 ,,  \ MOV $0008,R1
$0FE8 ,, $0004 ,,  \ set C
$6F18 ,, $0004 ,,  \ SHR 4,R1
$5410 ,,           \ SHF 4,R1
$E000 ,,           \ HALT
RUN
sr-carry     1 ASSERT-STATUS


@@ 494,13 495,22 @@ sr-max       1 ASSERT-STATUS
1        $F000 ASSERT-REG


TEST: ( ROT )
$0F08 ,, $DEAD ,,  \ MOV $DEAD,R0
$6800 ,,           \ ROT 8,R0
$E000 ,,           \ HALT
RUN
0 $ADDE ASSERT-REG


TEST: ( SWP )
$0F08 ,, $DEAD ,,  \ MOV $DEAD,R0
$0F18 ,, $C001 ,,  \ MOV $C001,R1
$7010 ,,           \ SWP R0,R1
$E000 ,,           \ HALT
RUN
0 $DEAD ASSERT-REG
1 $ADDE ASSERT-REG
0 $C001 ASSERT-REG
1 $DEAD ASSERT-REG


TEST: ( NOT )