#
#    Mecrisp-Quintus - A native code Forth implementation for RISC-V
#    Copyright (C) 2018  Matthias Koch
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

# Sprünge, Helferlein und Kontrollstrukturen
# Jumps, Utilities and Control Structures

  .ifdef mipscore

#------------------------------------------------------------------------------
generate_16bit_jump_encoding:
#------------------------------------------------------------------------------  
  addi x3, x3, -4
  srai x3, x3, 2

  li x5, 0xFFFF8000 # Possible range
  and x6, x3, x5
  beq x6, x5, 1f
  bne x6, zero, jump_too_far

1:# Constant fits in available bits !
  andi x3, x3, 0x0000FFFF
  ret

jump_too_far:
  writeln "Jump too far"
  j quit

  .else # Tools for RISC-V

#------------------------------------------------------------------------------
generate_uj_encoding:
#------------------------------------------------------------------------------
  push x1
  call uj_encoding_q
  popda x5
  beq x5, zero, jump_too_far
  pop x1
  ret

jump_too_far:
  writeln "Jump too far"
  j quit

#------------------------------------------------------------------------------
  Definition Flag_foldable_1, "uj-encoding?" # ( x -- x false | bitmask true )
uj_encoding_q:
#------------------------------------------------------------------------------

  li x5, 0xFFF80000 # Range BIT19 to BIT1, but lowest bit is ignored.
  and x6, x3, x5
  beq x6, x5, 1f
  bne x6, zero, 2f

1:# Constant fits in available bits !
  push x1
  call uj_encoding
  pushdaconst -1
  pop x1
  ret

2:pushdaconst 0
  ret

#------------------------------------------------------------------------------
uj_encoding: # ( addr -- x ) For unconditional jumps
#------------------------------------------------------------------------------

  # push x1
  # dup
  # write "UJ-Enc: "
  # call hexdot
  # writeln ""
  # pop x1

  push x10

    li x5, BIT19|BIT18|BIT17|BIT16|BIT15|BIT14|BIT13|BIT12
    and x10, x3, x5

    li x5, BIT11
    and x6, x3, x5
    srli x6, x6, 11
    slli x6, x6, 20
    or x10, x10, x6

    li x5, BIT10|BIT9|BIT8|BIT7|BIT6|BIT5|BIT4|BIT3|BIT2|BIT1
    and x6, x3, x5
    srli x6, x6, 1
    slli x6, x6, 21
    or x10, x10, x6

    li x5, BIT20
    and x6, x3, x5
    srli x6, x6, 20
    slli x6, x6, 31
    or x3, x10, x6
    
  pop x10
  ret

#------------------------------------------------------------------------------
generate_sb_encoding:
#------------------------------------------------------------------------------
  push x1
  call sb_encoding_q
  popda x5
  beq x5, zero, jump_too_far
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_foldable_1, "sb-encoding?" # ( x -- x false | bitmask true )
sb_encoding_q:
#------------------------------------------------------------------------------

  li x5, 0xFFFFF000 # Range BIT12 to BIT1, but lowest bit is ignored.
  and x6, x3, x5
  beq x6, x5, 1f
  bne x6, zero, 2f

1:# Constant fits in available bits !
  push x1
  call sb_encoding
  pushdaconst -1
  pop x1
  ret

2:pushdaconst 0
  ret

#------------------------------------------------------------------------------
sb_encoding: # ( addr -- x ) For conditional jump
#------------------------------------------------------------------------------

  # push x1
  # dup
  # write "SB-Enc: "
  # call hexdot
  # writeln ""
  # pop x1

  push x10

    li x5, BIT11
    and x6, x3, x5
    srli x6, x6, 11
    slli x10, x6, 7

    li x5, BIT4|BIT3|BIT2|BIT1
    and x6, x3, x5
    srli x6, x6, 1
    slli x6, x6, 8
    or x10, x10, x6

    li x5, BIT10|BIT9|BIT8|BIT7|BIT6|BIT5
    and x6, x3, x5
    srli x6, x6, 5
    slli x6, x6, 25
    or x10, x10, x6

    li x5, BIT12
    and x6, x3, x5
    srli x6, x6, 12
    slli x6, x6, 31
    or x3, x10, x6
    
  pop x10
  ret

  .endif # Tools for RISC-V

#------------------------------------------------------------------------------
nullprobekomma: # ( -- ) Get TOS into x5 for a following conditional jump.
#------------------------------------------------------------------------------
  push x1

  # Opcodes for "popda x5"

  .ifdef mipscore
  pushdaconst 0x00602825
  call komma
  .else
  pushdaconst 0x00018293
  call komma
  .endif

  call dropkomma

  pop x1
  ret

#------------------------------------------------------------------------------
dropkomma: # ( -- )
#------------------------------------------------------------------------------
  push x1

  .ifdef mipscore
  pushdaconst 0x8C830000
  call komma
  pushdaconst 0x24840004
  call komma
  .else
  pushdaconst 0x00022183
  call komma
  pushdaconst 0x00420213
  call komma
  .endif

  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "then"
  # ( Adresse-für-Sprung 2 | Adresse-für-Sprung 5 -- )
  # ( Address-for-Jump 2   | Address-for-Jump 5 --)
struktur_then:
#------------------------------------------------------------------------------
  push x1

  popda x5
  li x6, 5 # Unbedingten Vorwärtssprung einfügen
  bne x5, x6, 1f
    
    # Abschluss unbedingter Vorwärtssprung  Fill in unconditional forward jummp
    # ( Sprunglücke )
    dup
    call here
    # ( Sprunglücke Sprunglücke Sprungziel )
    swap
    call minus

    .ifdef mipscore
    call generate_16bit_jump_encoding
    li x5, 0x10000000
    or x3, x3, x5
    .else
    call generate_uj_encoding
    ori x3, x3, 0x0000006f # jal zero, 0
    .endif
    
    # ( Sprunglücke Opcode )
    swap
    call kommairgendwo
    pop x1
    ret


1:li x6, 2 # Bedingten Vorwärtssprung einfügen
  bne x5, x6, strukturen_passen_nicht

    # Abschluss bedingter Vorwärtssprung Fill in conditional forward jump
    # ( Sprunglücke )
    dup
    call here
    # ( Sprunglücke Sprunglücke Sprungziel )
    swap
    call minus

    .ifdef mipscore
    call generate_16bit_jump_encoding
    li x5, 0x10A00000
    or x3, x3, x5
    .else
    call generate_sb_encoding
    li x5, 0x00028063 # beq x5, zero, 0
    or x3, x3, x5
    .endif
    
    # ( Sprunglücke Opcode )
    swap
    call kommairgendwo
    pop x1
    ret

strukturen_passen_nicht:
  writeln "Structures don't match"
  j quit

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "else"
struktur_else:
#------------------------------------------------------------------------------
  push x1
  call struktur_ahead
  call dswap
  call struktur_then
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "if"
struktur_if: # ( -- Adresse-für-Sprung 2 )   ( -- Address-for-Jump 2 )
#------------------------------------------------------------------------------
  push x1

    call nullprobekomma

    call here
    pushdaconst 4
    call allot

    .ifdef mipscore # NOP for branch delay slot
    pushdaconst 0
    call komma
   .endif

  pushdaconst 2           # Strukturerkennung  Structure matching
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "ahead"
struktur_ahead: # ( -- Adresse-für-Sprung 5 )   ( -- Address-for-Jump 5 )
#------------------------------------------------------------------------------
  push x1

    call here
    pushdaconst 4
    call allot

    .ifdef mipscore # NOP for branch delay slot
    pushdaconst 0
    call komma
   .endif

  pushdaconst 5           # Strukturerkennung  Structure matching
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "repeat"
#------------------------------------------------------------------------------
  push x1
  call struktur_again
  call struktur_then
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "while"
#------------------------------------------------------------------------------
  push x1
  call struktur_if
  call dswap
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "until"  # Bedingte Schleife
  # ( Sprungziel 1 -- )                          # Conditional loop
#------------------------------------------------------------------------------
struktur_until:
  push x1
  popda x5
  li x6, 1
  bne x5, x6, strukturen_passen_nicht

    # Write conditional backward jump
    
    call nullprobekomma

    call here
    call minus

    .ifdef mipscore
    call generate_16bit_jump_encoding
    li x5, 0x10A00000
    or x3, x3, x5
    .else
    call generate_sb_encoding
    li x5, 0x00028063 # beq x5, zero, 0
    or x3, x3, x5
    .endif

    call komma

    .ifdef mipscore # NOP for branch delay slot
    pushdaconst 0
    call komma
   .endif

  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "again"  # Endlosschleife
struktur_again:  # ( Sprungziel 1 -- )           # Unconditional loop
#------------------------------------------------------------------------------
  push x1
  popda x5
  li x6, 1
  bne x5, x6, strukturen_passen_nicht

    # Write unconditional backward jump

    call here
    call minus

    .ifdef mipscore
    call generate_16bit_jump_encoding
    li x5, 0x10000000
    or x3, x3, x5
    .else
    call generate_uj_encoding
    ori x3, x3, 0x0000006f # jal zero, 0
    .endif

    call komma

    .ifdef mipscore # NOP for branch delay slot
    pushdaconst 0
    call komma
   .endif
    
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "begin"
  # ( -- Sprungziel 1 )  ( -- Jump-destination 1 )
#------------------------------------------------------------------------------
struktur_begin:
  push x1
  call here
  pushdaconst 1  # Strukturerkennung  Structure matching
  pop x1
  ret
