\ 28jul20 - may2021
\ risc-v assembler voor noForth r(cv)
\ an - 09apr20, 16apr20, 19mei20, 15jun20
\ 01jan2021 - Verbeterde (kortere) code voor de mov-macro's (an)
\             XX YY en ZZ toegevoegd
\             XOR, OR, AND, achter backslashes
\ Fout in SB~ hersteld
(*
    Condensed (16bit) instructies beginnen met een punt.
    De instructie staat achter de operanden.
    Volgorde van de operanden is: doel - bron,
    Uitzondering: de store-instructies .SW SH en SB vereisen
        de omgekeerde volgorde, bron - doel. (*)
    Store instructies met de MOV macro's
        verwachten de 'normale' volgorde: doel - bron.

    Condensed (16bit) instructions start with a dot.
    The instruction comes after the operands.
    Operand order is: destination - source,
    Exception: The store instructions .SW SH and SB require
        the reversed order, source - destination. (*)
    Store instructions with the MOV macros
        do expect the 'normal' order: destination - source.

        4 sp x)  tos .mov   =   tos  4 sp x) .sw (*)    \ tos = source
        tos  4 sp x) .mov   =   tos  4 sp x) .lw        \ tos = destination
        tos  sp ) .mov      =   tos  0 sp x) .lw

    reg )   is short for   0 reg x)

    A simpler notation is possible:
        sp 4  tos .mov      =   tos  sp 4 .sw (*)       \ tos = source
        tos  sp 4 .mov      =   tos  sp 4 .lw           \ tos = destination
        tos  sp 0 .mov      =   tos  sp 0 .lw

    reg )+   Postincrement, source only.
    reg -)   Predecrement, destination only.

        rp -) tos .mov      \ Push Return stack    (*)
        tos rp )+ .mov      \ Pull
        sp -) tos .mov      \ Push Data stack Push (*)
        tos sp )+ .mov      \ Pull
        tos sun )+ bmov     \ Load bytewise
    etc.
*)

HEX    \ until the end
v: fresh assembler definitions also
v: vocabulary ASM
v: asm also definitions
: >REG ( x -- r# )      8000 xor ;
: REG~ ( n naam -- )    >reg constant ;
v: assembler definitions
\ --- register names
 0 REG~ ZERO
 1 REG~ LINK
 2 REG~ RP      \ return stack pointer      RP !

\ Free, not used by noForth
 3 REG~ XX
 4 REG~ YY
 5 REG~ ZZ

\ Essential noForth registers
 6 REG~ RAM     \ start of RAM
 7 REG~ NXT     \ address of NEXT routine
 8 REG~ TOS     \ top of stack
 9 REG~ SP      \ data stach pointer        SP !
0A REG~ IP      \ instruction pointer

\ Scratch registers used by inner interpreter NEXT
0B REG~ W
0C REG~ HOP
\ Scratch registers used within code words
0D REG~ DAY
0E REG~ SUN
0F REG~ MOON

\ ---
20 REG~ -)      \ predecrement destination
21 REG~ )+      \ postincrement source
\ --- controles
v: asm definitions
: `-)` ( x -- ) -) = ?abort ;
: `)+` ( x -- ) )+ = ?abort ;
: REG? ( reg -- j/n )   >reg 20 u< ;
: ?.REG ( reg -- r# )   >reg 8 - 7 over u< ?abort ; \ 8..0F
: ?REG  ( reg -- r# )   >reg 1F over u< ?abort ;    \ 0..1F
: ?RANGE.U ( x r -- )   1+ u< 0= ?abort ;   \ range control, unsigned
: ?RANGE.S ( x r -- )   1+ tuck 2/ + swap u< 0= ?abort ;    \ signed
: BP ( offset bits -- bitpatroon )      \ bitpatroon voor offset en imm
    >r     \ imm#
    0
    begin 2* over r> 1+ dup >r
        c@ dup 20 <
    while rshift 1 and or
    repeat 2drop 1 rshift               \ imm# imm# ch  r: adr
    rdrop nip ;
: BITS( ( offset inls -- bp )   r> dup count + aligned >r bp ;
\ KJIHGFEDCBA9876543210
\ 09876543210
\ na BITS moet precies 1 spatie komen
: BITS ( ccc -- )           \ maak inline bitlijst, only compiling
    state @ 0= ?abort
    postpone bits(   bl parse
    dup 1+ c,   0
    do count   40 over < 7 and -   10 -
        1F and c, loop drop
    -1 c, align ; immediate
: PUT ( opc1 bitpatr #lshifts -- opc2 ) lshift or ;
\ --- veel voorkomende coderingen
: REG/2     swap ?REG  2 put ;
: REG/7     swap ?reg  7 put ;
: REG/14    swap ?REG 14 put ;
: REG/0F    swap ?reg 0F put ;
: .REG/2    swap ?.reg 2 put ;
: .REG/7    swap ?.reg 7 put ;
\ ------------------------------------------------- csrr
: CSRR~   create h,   does> h@
    swap over 4000 and
    if 1F and else ?reg then 0F put
    swap 14 lshift or
    reg/7 , ;
v: assembler definitions
1073 csrr~ CSRRW
2073 csrr~ CSRRS
3073 csrr~ CSRRC
5073 csrr~ CSRRWI
6073 csrr~ CSRRSI
7073 csrr~ CSRRCI
\ ------------------------------------------------- .sub
v: asm definitions
: .SUB~   create h,   does> h@
    .reg/2 .reg/7 h, ;
v: assembler definitions
8C01 .SUB~ .SUB
8C21 .SUB~ .XOR
8C41 .SUB~ .OR
8C61 .SUB~ .AND
\ ------------------------------------------------- .mw .add
v: asm definitions
: ?R0 0= ?abort ;
: .MW~   create h,   does> h@
    reg/2   over ?r0   reg/7  h, ;
v: assembler definitions
8002 .MW~ .MW
9002 .MW~ .ADD
\ ------------------------------------------------- .addi
: .ADDI ( n reg -- )
    0001
    over 3F  ?range.s       \ 6bits-s
    over bits 43210  2 put
    swap bits 5     0C put
    reg/7  h, ;
: .NOP 1 h, ;  \ Really: zero 0 .addi
\ ------------------------------------------------- .andi
: .ANDI
    8801
    over 3F  ?range.s       \ 6bits-s
    over bits 43210  2 put
    swap bits 5     0C put
    .reg/7 h, ;
\ ------------------------------------------------- shifts
v: asm definitions
: .SRLI~   create h,   does> h@
    over 1F  ?range.u       \ [1.1F]? 5bits-u
    swap bits 43210 2 put
    .reg/7 h, ;
v: assembler definitions
8001 .SRLI~ .SRLI
8401 .SRLI~ .SRAI
: .SLLI 0002
    over 1F  ?range.u       \ [1.1F]? 5bits-u
    swap bits 43210 2 put
    reg/7 h, ;
\ ------------------------------------------------- moving 32bits
: .SW                       \ rrx rr-)
    dup `)+`
    2dup 2>r
    dup -) = if over -4 .addi drop 0 then
    C000
ahead  [ 2swap ] ;
: .LW                       \ rrx rr)+
    dup `-)`
    2dup 2>r                \ misschien  r )+
    )+ over <> and          \ )+ -> 0
    4000
[ 2swap ] then
    over 7F   ?range.u      \ 7bits-u
    over bits 543 0A put
    swap bits 26   5 put    \ tos sun opc
    .reg/7 .reg/2 h,        \ r: sun? modus
    2r> )+ = if dup 4 .addi then drop ;
\ ----- rp moves
: .SWSP                   \ r rp x   r rp -)
    dup `)+`
    over rp <> ?abort nip
    dup -) = if rp -4 .addi drop 0 then    \ r x
    C002
    over FF ?range.u       \ 8bits-u
    swap bits 543276 7 put
    reg/2 h, ;
: .LWSP                   \ r rp x  | r rp )+
    dup `-)`
    over rp <> ?abort nip  dup >r
    dup )+ <> and                   \ )+ -> 0
    4002
    over FF   ?range.u              \ 8bits-u
    over bits 5    0C put
    swap bits 43276 2 put
    reg/7  h,
    r> )+ = if rp 4 .addi then ;
\ ------------------------------------------------- moving 8 & 16 bits
v: asm definitions
: LB~ create h, does> h@    \ r r offset opc  | r r )+ opc
    over `-)`
    0 2over 2>r drop        \ r r offset opc  r: r )+?
    over )+ = if nip 0 swap then          \ r r 0 opc
    over FFF ?range.s       \ 12bits-s
    swap  14 put
    reg/0F reg/7 dup ,      \ opc
    2r> )+ =                \ opc r )+?
    if  swap 0C rshift 3 and 2* 1 max .addi      \ aantal increment bytes
    else 2drop
    then ;
v: assembler definitions
0003 LB~ LB     \ 1 byte
1003 LB~ LH     \ 2
2003 LB~ LW     \ 4
4003 LB~ LBU    \ 1
5003 LB~ LHU    \ 2
v: asm definitions
: SB~ create h,   does> h@  \ s d offset opc  | s d -) opc
    over `)+`
    over -) =
    if  nip 2dup                \ r r opc  r opc
        0C rshift 2* 1 max      \ aantal decrement bytes
        negate .addi 0 swap
    then                        \ r r offset opc
    over FFF ?range.s           \ 12bits-s
    over bits BA98765 19 put    \ r1 r2 offset opc
    swap bits 43210    7 put    \ r1 r2 opc
    reg/0F reg/14 , ;
v: assembler definitions
0023 SB~ SB
1023 SB~ SH
2023 SB~ SW
\ ------------------------------------------------- mov macro's
: .MOV  \ rr=.mw   rrx=.lw  rr)+=.lw+  rxr=.sw  r-)r=.sw  macro
    over reg?
    if   dup reg? if .MW exit then
         over rp =    if .LWSP exit then .LW exit
    then rot rot
         over rp =    if .SWSP exit then .SW ;
: BMOV      over reg? if LBU   exit then rot rot SB ;
: HMOV      over reg? if LHU   exit then rot rot SH ;
: WMOV      over reg? if LW    exit then rot rot SW ;
\ ------------------------------------------------- slt
v: asm definitions
: SLT~   create ,   does> @
    reg/14 reg/0F reg/7 , ;    \ s2=d s1 d
v: assembler definitions
    0033 SLT~ ADD  \             000.Z.0011.0011
    1033 SLT~ SLL  \             001.Z.0011.0011
    2033 SLT~ SLT  \             010.Z.0011.0011
    3033 SLT~ SLTU \             011.Z.0011.0011
\    4033 SLT~ XOR,  \             100.Z.0011.0011
    5033 SLT~ SRL  \             101.Z.0011.0011
\    6033 SLT~ OR,   \             110.Z.0011.0011
\    7033 SLT~ AND,  \             111.Z.0011.0011
40000033 SLT~ SUB  \ 0100.Z.Z.Z.0000.Z.0011.0011
40005033 SLT~ SRA  \ 0100.Z.Z.Z.0101.Z.0011.0011
\ ------------------------------------------------- .li
: .LI   4001
    over 3F  ?range.s       \ 6bits-s
    over bits 5    0C put
    swap bits 43210 2 put
    over ?r0   reg/7 h, ;
\ ------------------------------------------------- mul div
v: asm definitions
: MULDIV~   create ,   does> @
    reg/14 reg/0F reg/7 , ;
v: assembler definitions
2000033 muldiv~ MUL
2001033 muldiv~ MULH
2002033 muldiv~ MULHSU
2003033 muldiv~ MULHU
2004033 muldiv~ DIV
2005033 muldiv~ DIVU
2006033 muldiv~ REM
2007033 muldiv~ REMU
\ ------------------------------------------------- addi slti
v: asm definitions
: ADDI~   create h,   does> h@
    over FFF ?range.s       \ 12bits-s
    swap FFF and    14 put
    reg/0F reg/7 , ;
v: assembler definitions
0013 ADDI~ ADDI
2013 ADDI~ SLTI
3013 ADDI~ SLTIU
4013 ADDI~ XORI
6013 ADDI~ ORI
7013 ADDI~ ANDI
\ ------------------------------------------------- lui
v: asm definitions
: LUI~   create h,   does> h@
    swap 0C rshift 0C put
    reg/7 , ;
v: assembler definitions
0037 LUI~ LUI
0017 LUI~ AUIPC
: LI ( reg imm -- ) >r
            r@ abs 20 u<
    if r> .li exit
    then    r@ abs 801 u<
    if zero r> addi exit
    then    r@ 800 and
    if  dup r@ 1000 + lui dup
            r> FFF and 1000 - addi exit
    then dup r@ lui dup
            r> FFF and dup      \ reg reg imm imm
    if addi else 2drop drop then ;
\ ------------------------------------------------- j
\ KJIHGFEDCBA9876543210
\ 09876543210
: J ( doeladres -- )
    6F over FFFFF ?range.s   \ 20bits-s
    over bits K 1F put
    over bits A987654321 15 put
    over bits B 14 put
    swap bits JIHGFEDC 0C put  , ;
\ ------------------------------------------------- .jr .jalr
v: asm definitions
: .JR~   create h,   does> h@
    over ?r0   reg/7  h, ;
v: assembler definitions
8002 .JR~ .JR           \ sun .JR
9002 .JR~ .JALR
\ ------------------------------------------------- .jal .j
v: asm definitions
: .JAL~   create h,   does> h@
    swap chere -
    dup FFF ?range.s               \ 12bits-s
    bits B498A673215 2 put h, ;
v: assembler definitions
    A001 .JAL~ .J
    2001 .JAL~ .JAL
\ ------------------------------------------------- conditionals
v: asm definitions
: .COND~   create h,   does> h@ ( -- pza )  \ pza = patroon-zonder-afstand
    .reg/7 ;
v: assembler definitions
C001 .COND~ .0<>?
E001 .COND~ .0=?
v: asm definitions
: COND~   create h,   does> h@        ( -- pza )
    reg/0F reg/14 ;  \ s1 s2   !
v: assembler definitions
0063 COND~ <>?     \ beq
1063 COND~ =?      \ bne
4063 COND~ <EQ?    \ blt
5063 COND~ >?      \ bge
6063 COND~ U<EQ?   \ bltu
7063 COND~ U>?     \ bgeu
v: asm definitions
: .PZAJ? ( pza -- vlag )  A001 = ;
: PZA?   ( pza -- vlag )  63 tuck and = ;
: .PZA?  ( pza -- vlag )  C001 tuck and = ;
: .PMA ( afst pza -- pma )      \ patroon-met-afstand-erin )
    over 1FF ?range.s           \ 9bits-s
    over bits 843   0A put
    swap bits 76215  2 put ;
: PMA ( afst pza -- pma )
    over FFF ?range.s           \ 12bits-s
    over bits CA98765 19 put
    swap bits 4321B    7 put ;
: .PMAJ ( afst pza -- pma )     \ for AHEAD AGAIN
    over FFF ?range.s           \ 12bits-s
    swap bits B498A673215 2 put ;
\ ------------------------------------------------- IF,
v: assembler definitions
: AHEAD, ( -- ahead,here PZA )
    chere -1 h, A001 ;         \ see THEN,
: DATA, chere -1 h, 2001 ;
: IF, ( PZA -- if,here PZA )
    chere  swap
    dup PZA?  if -1 , exit then
    dup .PZA? if -1 h, exit then
    ?abort ;
: THEN, ( if,here PZA -- )
    >r chere over - r>                  \ if,here afst pza
    dup .PZAJ? if .PMAJ swap romh! exit then   \ AHEAD
    dup PZA?   if PMA   swap rom!  exit then
    dup .PZA?  if .PMA  swap romh! exit then
    ?abort ;
: ELSE,     AHEAD, 2swap THEN, ;
\ ------------------------------------------------- BEGIN,
: BEGIN, ( -- begin,here 77 )    chere 77 ;
: UNTIL, ( begin,here 77 PZA  -- )
    swap 77 <> ?abort
    >r chere - r>                       \ begin,here afst PZA
    dup PZA?  if  PMA  ,  exit then
    dup .PZA? if  .PMA h, exit then
    ?abort ;
: AGAIN, ( begin,here 77 -- )
    77 <> ?abort .j ;                  \ *WO*
: WHILE,    IF, 2swap ;
: REPEAT,   AGAIN, THEN, ;
\ ------------------------------------------------- RET WFI
: MRET 30200073 , ;
: WFI  10500073 , ;
\ ------------------------------------------------- x) & )
: x) swap ;
: ) 0 ;

v: fresh
shield asm\  freeze     \ This takes some time
 \                                               \
\ \ \ --- einde ---
