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

  .ifdef mipscore

# -----------------------------------------------------------------------------
  Definition Flag_visible, "mips"
# -----------------------------------------------------------------------------
  push x1
  welcome " for MIPS by Matthias Koch"
  pop x1
  ret

  .else

# -----------------------------------------------------------------------------
  Definition Flag_visible, "risc-v"
# -----------------------------------------------------------------------------
  push x1
  welcome " for RISC-V by Matthias Koch"
  pop x1
  ret

  .endif

# -----------------------------------------------------------------------------
  Definition Flag_visible, "dump"
dump: # ( addr len -- )
# -----------------------------------------------------------------------------
  push_x1_x10
  writeln ""

  popda x10        # Length
  add x10, x10, x3 # Stop address
 
1:dup
  call hexdot
  write ": "

  pushdatos
  lw x3, 0(x3)
  call hexdot
  writeln ""
  
  addi x3, x3, 4
  bgeu x10, x3, 1b

  drop
  pop_x1_x10
  ret
  
# -----------------------------------------------------------------------------
  Definition Flag_visible, "dump'" # ( -- )
# -----------------------------------------------------------------------------
  push x1
  call token
  call find_not_found
  drop

  writeln ""

1:dup
  call hexdot
  write ": "

  pushdatos
  lw x3, 0(x3)
  call hexdot
  writeln ""

  .ifdef mipscore
  lw x5, -4(x3) # Branch delay slot shall be dumped, too !
  li x6, 0x03e00008 # Ret-Opcode
  .else
  lw x5, 0(x3)
  li x6, 0x00008067 # Ret-Opcode
  .endif
  addi x3, x3, 4
  bne x5, x6, 1b

  drop
  pop x1
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "hex."
hexdot: # ( u -- ) Print an unsigned number in Base 16, independent of number subsystem.
# -----------------------------------------------------------------------------

  push_x1_x10_x12

  popda x10   # Value to print
  li x11, 32  # Number of bits left

1:pushdatos
  srli x3, x10, 28
  andi x3, x3, 0xF
  li x12, 10

  bltu x3, x12, 2f
    addi x3, x3, 55-48
2:addi x3, x3, 48
  call emit

  slli x10, x10, 4
  addi x11, x11, -4
  bne x11, zero, 1b

  pushdaconst 32
  call emit

  pop_x1_x10_x12
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "h.s"  # Print out data stack
dots:
# -----------------------------------------------------------------------------

  push_x1_x10_x12

  # Berechne den Stackfüllstand  Calculate number of elements on datastack
  laf x11, datenstackanfang # Anfang laden

  # bltu x11, x4, 2f # Stack underflow ? Do not print a zillion of locations.

  sub x11, x11, x4 # und aktuellen Stackpointer abziehen
  srli x11, x11, 2 # Durch 4 teilen  Divide by 4 Bytes/Element

  write "Stack: [ "
  pushda x11
  call hexdot
  write "] "

  blt x11, zero, 2f # Stack underflow ? Do not print a zillion of locations.

  beq x11, zero, 2f # Bei einem leeren Stack ist nichts auszugeben.  Don't print elements for an empty stack

  laf x12, datenstackanfang - 4 # Anfang laden, wo ich beginne:  Start here !

1: # Hole das Stackelement !  Fetch stack element directly
   lw x10, 0(x12)
   pushda x10
   call hexdot

   addi x12, x12, -4
   addi x11, x11, -1
   bne x11, zero, 1b

2: # TOS zeigen  Print TOS
   write " TOS: "
   pushda x3
   call hexdot
   writeln " *>"

   pop_x1_x10_x12
   ret


# -----------------------------------------------------------------------------
  Definition Flag_visible, ".rs"  # Print out return stack
dotrs:
# -----------------------------------------------------------------------------

  # Berechne den Stackfüllstand  Calculate number of elements on datastack
  laf x5, returnstackanfang # Anfang laden
  sub x5, x5, sp # und aktuellen Stackpointer abziehen

  push_x1_x10_x12

  srli x11, x5, 2 # Durch 4 teilen  Divide by 4 Bytes/Element

  write "Returnstack: [ "
  pushda x11
  call hexdot
  write "] "

  blt x11, zero, 2f # Stack underflow ? Do not print a zillion of locations.
  beq x11, zero, 2f # Bei einem leeren Stack ist nichts auszugeben.  Don't print elements for an empty stack

  laf x12, returnstackanfang # Anfang laden, wo ich beginne:  Start here !

1: # Hole das Stackelement !  Fetch stack element directly
   lw x10, 0(x12)
   pushda x10
   call hexdot

   addi x12, x12, -4
   addi x11, x11, -1
   bne x11, zero, 1b

2: writeln " *>"

  pop_x1_x10_x12
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "words" # Print list of words with debug information
words: # Malt den Dictionaryinhalt
# -----------------------------------------------------------------------------
  push_x1_x10

  writeln ""

  call dictionarystart

1:# Adresse:
  write "Address: "
  dup
  call hexdot

  # Link
  write "Link: "
  dup
  lw x3, 0(x3)
  call hexdot

  # Flagfeld
  write "Flags: "
  dup
  lw x3, 4(x3)
  call hexdot

  # Einsprungadresse
  write "Code: "
  dup
  addi x3, x3, 8
  call skipstring
  call hexdot

  write "Name: "
  dup
  addi x3, x3, 8
  call ctype

  writeln ""

  call dictionarynext
  popda x10
  beq x10, x0, 1b

  drop

  pop_x1_x10
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, ".s"  # Print out data stack
# -----------------------------------------------------------------------------

  push_x1_x10_x13

  laf x6, base
  lw x13, 0(x6)
  li x5, 10
  sw x5, 0(x6)

  # Berechne den Stackfüllstand  Calculate number of elements on datastack
  laf x11, datenstackanfang # Anfang laden

  # bltu x11, x4, 2f # Stack underflow ? Do not print a zillion of locations.

  sub x11, x11, x4 # und aktuellen Stackpointer abziehen
  srli x11, x11, 2 # Durch 4 teilen  Divide by 4 Bytes/Element

  write "Stack: [ "
  pushda x11
  call dot
  write "] "

  laf x6, base
  sw x13, 0(x6)

  blt x11, zero, 2f # Stack underflow ? Do not print a zillion of locations.

  beq x11, zero, 2f # Bei einem leeren Stack ist nichts auszugeben.  Don't print elements for an empty stack

  laf x12, datenstackanfang - 4 # Anfang laden, wo ich beginne:  Start here !

1: # Hole das Stackelement !  Fetch stack element directly
   lw x10, 0(x12)
   pushda x10
   call dot

   addi x12, x12, -4
   addi x11, x11, -1
   bne x11, zero, 1b

2: # TOS zeigen  Print TOS
   write " TOS: "
   pushda x3
   call dot
   writeln " *>"

   pop_x1_x10_x13
   ret


# -----------------------------------------------------------------------------
  Definition Flag_visible, "u.s"  # Print out data stack
# -----------------------------------------------------------------------------

  push_x1_x10_x13

  laf x6, base
  lw x13, 0(x6)
  li x5, 10
  sw x5, 0(x6)

  # Berechne den Stackfüllstand  Calculate number of elements on datastack
  laf x11, datenstackanfang # Anfang laden

  # bltu x11, x4, 2f # Stack underflow ? Do not print a zillion of locations.

  sub x11, x11, x4 # und aktuellen Stackpointer abziehen
  srli x11, x11, 2 # Durch 4 teilen  Divide by 4 Bytes/Element

  write "Stack: [ "
  pushda x11
  call dot
  write "] "

  laf x6, base
  sw x13, 0(x6)

  blt x11, zero, 2f # Stack underflow ? Do not print a zillion of locations.

  beq x11, zero, 2f # Bei einem leeren Stack ist nichts auszugeben.  Don't print elements for an empty stack

  laf x12, datenstackanfang - 4 # Anfang laden, wo ich beginne:  Start here !

1: # Hole das Stackelement !  Fetch stack element directly
   lw x10, 0(x12)
   pushda x10
   call udot

   addi x12, x12, -4
   addi x11, x11, -1
   bne x11, zero, 1b

2: # TOS zeigen  Print TOS
   write " TOS: "
   pushda x3
   call udot
   writeln " *>"

   pop_x1_x10_x13
   ret

