#
#    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/>.
#

# -----------------------------------------------------------------------------
insert_jalrx3: # ( Ziel Opcodelücke -- )
# -----------------------------------------------------------------------------
  push_x1_x10

  popda x10 # Opcodelücke

  # Korrektur fürs negative Vorzeichen
  li x5, 0x800
  and x5, x5, x3
  beq x5, zero, 1f
    li x5, 0x00001000
    add x3, x3, x5
1:
    
  dup
  li x5, 0xFFFFF000
  and x3, x3, x5
  ori  x3, x3, 0x000002b7 # lui x5, ...

  pushda x10
  call kommairgendwo
  
  sll x3, x3, 20
  li x5, 0x000281e7  # jalr x3, x5, 0
  or x3, x3, x5
  
  pushda x10
  addi x3, x3, 4
  call kommairgendwo

  pop_x1_x10
  ret

# -----------------------------------------------------------------------------
  Definition Flag_inline, "does>"
does: # Gives freshly defined word a special action.
      # Has to be used together with <builds !
# -----------------------------------------------------------------------------
    # At the place where does> is used, a jump to dodoes is inserted and
    # after that a R> to put the address of the definition entering the does>-part
    # on datastack. This is a very special implementation !

  pushdatos
  # Den Aufruf mit absoluter Adresse einkompilieren. Perform this call with absolute addressing.
  lui x5, %hi(dodoes)
  jalr x3, x5, %lo(dodoes)    
    
  ret # Very important as delimiter as does> itself is inline.

dodoes:
  # On the stack: ( Address-to-call R: Return-of-dodoes-itself )  
  # Now insert a call into the latest definition which was hopefully prepared by <builds
  
  # Save and change dictionary pointer to insert a call sequence:
  
  push x1

  pushdaaddrf Einsprungpunkt
  lw x3, 0(x3)
  addi x3, x3, 16 # Skip pop x1 and pushdatos opcodes

  # ( Ziel Opcodelücke )
  call insert_jalrx3
  
  call smudge
  
  addi sp, sp, 4 # Skip one return layer
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_visible, "<builds"
builds: # Brother of does> that creates a new definition and leaves space to insert a call instruction later.
#------------------------------------------------------------------------------  
  push x1
  call create # Create new empty definition
  
  pushdaconst 0xffc10113 # addi	sp,sp,-4  # Write opcodes for "push x1"
  call komma
  pushdaconst 0x00112023 # sw	ra,0(sp)
  call komma

  pushdaconst 0xffc20213 # Write opcodes for "pushdatos"
  call komma
  pushdaconst 0x00322023
  call komma
  
  pushdaconst 8 # A call instruction will go here - but I don't know its target address for now.
  call allot # Make a hole to insert the destination later.
  
  pop x1
  ret

#------------------------------------------------------------------------------
  Definition Flag_visible, "create" # ANS-Create with default action.
#------------------------------------------------------------------------------
  push x1
  call builds
  # Copy of the inline-code of does>  
  pushdatos
  lui x5, %hi(dodoes)
  jalr x3, x5, %lo(dodoes)    
  pop x1
  ret
  
