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

# Die zählenden Schleifen
# Counting loops
 
# Loop index: x8
# Loop limit: x9

#------------------------------------------------------------------------------
  Definition Flag_inline, "k" # Kopiert den drittobersten Schleifenindex  Third loop index
#------------------------------------------------------------------------------
  # Returnstack ( Limit Index Limit Index )
  pushdatos
  lw x3, 8(sp)
  ret

#------------------------------------------------------------------------------
  Definition Flag_inline, "j" # Kopiert den zweitobersten Schleifenindex  Second loop index
#------------------------------------------------------------------------------
  # Returnstack ( Limit Index )
  pushdatos
  lw x3, 0(sp)
  ret

#------------------------------------------------------------------------------
  Definition Flag_inline, "i" # Kopiert den obersten Schleifenindex       Innermost loop index
#------------------------------------------------------------------------------
  # Returnstack ( )
  pushda x8
  ret


/* Ein paar Testfälle  Some tests

: table   cr 11 1 do
                    i 8 = if leave then
                    11 1 do
                           i j * . space
                           j 5 = if leave then
                           j 2 = if leave then
                         loop
                    cr
                  loop ;

: stars 0 ?do [char] * emit loop ;
: stars5 0 ?do [char] * emit   i 5 = if leave then loop ;

: table   cr 11 1 do 11 1 do i j * . space loop cr loop ;
: table   cr 11 1 do [ .s ] 11 1 do [ .s ] i j * . space loop [ .s ] cr loop [ .s ] ;
: table  cr 11 1 do i 8 = if leave then 11 1 do  i j * . space j 5 = if leave then  j 2 = if leave then loop cr loop ;

*/

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "leave" # Beendet die Schleife sofort.  Terminates loop immediately.
  # ( ... AlterLeavePointer 0 Sprungziel 3 ... )
  # --
  # ( ... AlterLeavePointer Vorwärtssprungziel{or-1-JZ} Sprungziel 3 ... )

  # ( ... OldLeavePointer 0 Target 3 ... )
  # --
  # ( ... OldLeavePointer Forward-Jump-Target{or-1-JZ} NumberofJumps Target 3 ... )
#------------------------------------------------------------------------------
  # Der LeavePointer zeigt an die Stelle, wo steht, wie viele Spezialsprünge noch abzuarbeiten sind.
  # Alle Stackelemente weiterschieben, Sprungadresse einfügen, Zähler erhöhen, Lücke anlegen.

  # LeavePointer points to the location which counts the number of jumps that have to be inserted later.
  # Leave moves all elements of stack further, inserts address for jump opcode, increments counter and allots space.

  push x1
  
  # Agenda:
  # An dieser Stelle eine Vorwärtssprunglücke präparieren:
  # TOS bleibt TOS
  # Muss eine Lücke im Stack schaffen, alles NACH der Position des leavepointers muss weiterrücken.

  # Make a hole in datastack at the lcoation the leavepointer points to for inserting the new location a jump opcode has to be patched in later
  # by moving all other elements further one place in datastack.

  laf x10, leavepointer
  lw x11, 0(x10) # Die Stelle, wohin er zeigt = Inhalt der Variable Leavepointer

  mv x13, x4 # Alter Stackpointer  Old stackpointer
  addi x4, x4, -4 # Ein Element mehr auf dem Stack  One more element on stack after this

1:# Lückenschiebeschleife
  lw x12, 0(x13)
  sw x12, -4(x13)
  addi x13, x13, 4
  bne x13, x11, 1b # x11 enthält die Stelle am Ende

# Zweimal schieben, weil für struktur-then zwei Elemente eingefügt werden sollen.

  mv x13, x4 # Alter Stackpointer  Old stackpointer
  addi x4, x4, -4 # Ein Element mehr auf dem Stack  One more element on stack after this

1:# Lückenschiebeschleife
  lw x12, 0(x13)
  sw x12, -4(x13)
  addi x13, x13, 4
  bne x13, x11, 1b # x11 enthält die Stelle am Ende


  # Muss jetzt die Stelle auf dem Stack, wo die Sprünge gezählt werden um Eins erhöhen
  # und an der freigewordenen Stelle die Lückenadresse einfügen.
  # Increment the number of jumps to be filled in later

  call here
  pushdaconst 4
  call allot

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

  popda x13 # Die Lückenadresse

  # Insert the address of location for jump opcode in datastack
  addi x11, x11, -4  # Weiter in Richtung Spitze des Stacks wandern
  sw x13, 0(x11) # Lückenadresse einfügen

  addi x11, x11, -4  # Weiter in Richtung Spitze des Stacks wandern
  li x5, 5 # Strukturerkennung für unbedingten Sprung
  sw x5, 0(x11) # Lückenadresse einfügen

  # Den neuen Leavepointer vermerken  Update leavepointer
  sw x11, 0(x10)

  # Increment counter for number of jumps to be generated later

  lw x12, -4(x11)  # Sprungzähler aus dem Stack kopieren
  addi x12, x12, 1  # Den Sprungzähler um eins erhöhen
  sw x12, -4(x11)  # und zurückschreiben.

  pop x1
  ret


#------------------------------------------------------------------------------
  Definition Flag_inline, "unloop" # Wirft die Schleifenstruktur vom Returnstack
unloop:                           # Remove loop structure from returnstack
#------------------------------------------------------------------------------
  pop x8 # Hole die alten Schleifenwerte zurück  Fetch back old loop values
  pop x9
  ret

# Some tests:
# : mealsforwholeday cr 25 6 do i dup roman ." : " mealtime cr 2 +loop cr ;
# : ml+ cr 25 6 do i . space 2 +loop ;

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "+loop" # Es wird benutzt mit ( Increment -- ).
  # ( AlterLeavePointer ... ZahlderAdressen Sprungziel 3 -- )

  # Usage: ( Increment -- ).
  # ( OldLeavePointer ... NumberofJumps Target 3 -- )
#------------------------------------------------------------------------------


  li x5, 3                  # Check for structure pattern: Give error message and quit if wrong.
  bne x3, x5, strukturen_passen_nicht
  drop

  push_x1_x10
  
  pushdaaddr plusloop_opcodes
  call callkomma

    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  

  popda x10
1:beq x10, zero, 2f
  call struktur_then
  addi x10, x10, -1
  j 1b

2:pushdaaddr unloop
  call inlinekomma

  laf x6, leavepointer  # Zurückholen für die nächste Schleifenebene
  sw x3, 0(x6)         # Fetch back old leavepointer for next loop layer.
  drop

  pop_x1_x10
  ret


#------------------------------------------------------------------------------
#  Definition Flag_invisible, "(+loop)"  # Just for disassembler printout.
#------------------------------------------------------------------------------

plusloop_opcodes:

  blt x3, zero, 1f

  # Positive increment:
  sub x6, x8, x9 # Index-Limit

    add x8, x8, x3
    drop

  sub x5, x8, x9 # Index+Inc-Limit


  sltu x5, x5, x6
  addi x5, x5, -1
  inv x5

  ret

1:# Negative increment:
  sub x6, x8, x9 # Index-Limit

    add x8, x8, x3
    drop

  sub x5, x8, x9 # Index+Inc-Limit


  sltu x5, x6, x5
  addi x5, x5, -1
  inv x5

  ret


#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "loop" # Es wird benutzt mit ( -- ).
  # ( AlterLeavePointer ... ZahlderAdressen Sprungziel 3 -- )

  # Usage: ( -- ).
  # ( OldLeavePointer ... NumberofJumps Target 3 -- )
#------------------------------------------------------------------------------
  li x5, 3                  # Check for structure pattern: Give error message and quit if wrong.
  bne x3, x5, strukturen_passen_nicht
  drop

  push_x1_x10
  
  .ifdef mipscore
  pushdaconst 0x25080001
  .else
  pushdaconst 0x00140413 # addi x8, x8, 1 # Increment index.
  .endif
  call komma

    call here
    call minus

    .ifdef mipscore
    call generate_16bit_jump_encoding
    li x5, 0x15090000
    or x3, x3, x5
    .else
    call generate_sb_encoding
    li x5, 0x00941063 # bne x8, x9, 0             
    or x3, x3, x5
    .endif

    call komma  

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

  popda x10
1:beq x10, zero, 2f
  call struktur_then
  addi x10, x10, -1
  j 1b

2:pushdaaddr unloop
  call inlinekomma

  laf x6, leavepointer  # Zurückholen für die nächste Schleifenebene
  sw x3, 0(x6)         # Fetch back old leavepointer for next loop layer.
  drop

  pop_x1_x10
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "do" 
  # Es wird benutzt mit ( Limit Index -- ).
  # ( -- AlterLeavePointer 0 Sprungziel 3 )

  # Usage: ( Limit Index -- ).
  # ( -- OldLeavePointer 0 Target 3 )
#------------------------------------------------------------------------------

  # LeavePointer points to the location which counts the number of jumps that have to be inserted later.
  # Leave moves all elements of stack further, inserts address for jump opcode, increments counter and allots space.

  push x1

  pushdaaddr do_opcodes
  call inlinekomma

  laf x6, leavepointer

  pushdatos
  lw x3, 0(x6) # Alten Leavepointer sichern  Save old leavepointer

  pushdaconst 0
  sw x4, 0(x6) # Aktuelle Position im Stack sichern  Save current position on datastack

  call here               # Schleifen-Rücksprung vorbereiten  Prepare loop jump back to the beginning
  pushdaconst 3           # Strukturerkennung  Structure matching
  pop x1
  ret

do_opcodes:
  pushdouble x9, x8
  #push x9
  #push x8
  popdadouble x8, x9
  #popda x8
  #popda x9
  ret  # Ende für inline,  End for inline,

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "?do" 
  # Es wird benutzt mit ( Limit Index -- ).
  # ( -- AlterLeavePointer Vorsprungadresse 1 Sprungziel 3 )
  # Diese Schleife springt sofort ans Ende, wenn Limit=Index.

  # Usage: ( Limit Index -- ).
  # ( -- OldLeavePointer Forward-Jump-Target 1 Target 3 )
  # This loop terminates immediately if Limit=Index.
#------------------------------------------------------------------------------
  push x1

  pushdaaddr do_opcodes
  call inlinekomma

  .ifdef mipscore
  pushdaconst 0x01092823
  .else
  pushdaconst 0x409402b3 # sub x5, x8, x9
  .endif
  call komma

  laf x6, leavepointer
  pushdatos
  lw x3, 0(x6) # Alten Leavepointer sichern  Save old leavepointer

  # call struktur_if slightly changed for comparison of x8 with x9
    call here
    pushdaconst 4
    call allot

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

    pushdaconst 2           # Strukturerkennung  Structure matching

  pushdaconst 1

  laf x6, leavepointer
  sw x4, 0(x6) # Aktuelle Position im Stack sichern  Save current position on datastack

  call here               # Schleifen-Rücksprung vorbereiten  Prepare loop jump back to the beginning
  pushdaconst 3           # Strukturerkennung  Structure matching
  pop x1
  ret
