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

# Besondere Teile des Compilers, die mit der Dictionarystruktur im Flash zu tun haben.
# Special parts of compiler tightly linked with generating code for Flash memory.


# -----------------------------------------------------------------------------
  Definition Flag_visible, "smudge" # ( -- )
smudge:
# -----------------------------------------------------------------------------
  push x1

  call here
  call addrinflash
  popda x5
  beq x5, zero, smudge_ram

  # -----------------------------------------------------------------------------
  # Smudge for Flash

    # Prüfe, ob am Ende des Wortes ein $FFFF steht. Das darf nicht sein !
    # Es würde als freie Stelle erkannt und später überschrieben werden.
    # Deshalb wird in diesem Fall hier am Ende eine 0 ans Dictionary angehängt.

    # Check if there is $FFFF at the end of the definition.
    # That must not be ! It would be detected as free space on next Reset and simply overwritten.
    # To prevent it a zero is applied at the end in this case.

    call here
    lw x5, -4(x3)
    li x6, erasedword
    drop
    bne x5, x6, 1f

      # writeln "Füge in Smudge eine Enderkennungs-Null ein."
      pushdaconst writtenword
      call komma
1:  # Okay, Ende gut, alles gut. Fine :-)

    # bl align4komma # Align on 4 to make sure the last opcode is actually written to Flash and to fullfill ANS requirement.

    # Brenne die gesammelten Flags:  Flash in the collected Flags:
    pushdatos
    laf x3, FlashFlags
    lw x3, 0(x3)

    pushdatos
    laf x3, Fadenende
    lw x3, 0(x3)
    addi x3, x3, 4 # Skip Link field

    call flashstore

    .ifdef flushflash
      call flushflash
    .endif

    pop x1
    ret

  # -----------------------------------------------------------------------------
  # Smudge for RAM

smudge_ram:
  # bl align4komma # Align on 4 to fullfill ANS requirement.
  pushdaconst Flag_visible
  j setflags_intern

# -----------------------------------------------------------------------------
  Definition Flag_visible, "setflags" # ( x -- )
setflags: # Setflags collects the Flags if compiling for Flash, because we can write Flash field only once.
          # For RAM, the bits are simply set directly.
# -----------------------------------------------------------------------------
  push x1

setflags_intern:
  call here
  call addrinflash
  popda x5
  beq x5, zero, setflags_ram

  # -----------------------------------------------------------------------------
  # Setflags for Flash
  laf x6, FlashFlags
  lw x5, 0(x6)
  or x5, x5, x3  # Flashflags beginnt von create aus immer mit "Sichtbar" = 0.
  sw x5, 0(x6)
  drop
  pop x1
  ret

  # -----------------------------------------------------------------------------
  # Setflags for RAM
setflags_ram:

  # Hole die Flags des aktuellen Wortes   Fetch flags of current definition
  laf x6, Fadenende # Variable containing pointer to current definition
  lw x6, 0(x6)     # Address of current definition
  lw x5, 4(x6)      # Flags des zuletzt definierten Wortes holen  Fetch its Flags

  push x10
  li x10, -1
  bne x5, x10, 1f
    mv x5, x3     # Direkt setzen, falls an der Stelle noch -1 steht  Set directly, if there are no Flags before
1:  or x5, x5, x3 # Hinzuverodern, falls schon Flags da sind          If there already are Flags, OR them together.
  pop x10

  sw x5, 4(x6)
  drop
  pop x1
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible|Flag_foldable_1, "aligned" # ( c-addr -- a-addr )
# -----------------------------------------------------------------------------
  andi x5, x3, 1
  add x3, x3, x5
  andi x5, x3, 2
  add x3, x3, x5
  ret

# If your particular Flash controller doesn't support byte write access,
# you can remove align, and c, without breaking anything.
# They are available for the joy of the user, the core only depends on even aligned 16-Bit Flash writes.

#  .ifdef charkommaavailable
#  -----------------------------------------------------------------------------
#  Definition Flag_visible, "halign" # ( -- )
# lignkomma: # Macht den Dictionarypointer gerade
#  -----------------------------------------------------------------------------
#  ldr r0, =Dictionarypointer
#  ldr r1, [r0] # Hole den Dictionarypointer
#
#  movs r0, #1
#  ands r1, r0
#  beq 1f
#
#  pushdaconst 0
#  b.n ckomma
#
# : # Fertig.
#  bx lr
#  .endif

# # -----------------------------------------------------------------------------
#   Definition Flag_visible, "align" # ( -- )
# align4komma: # Macht den Dictionarypointer auf 4 gerade
# # -----------------------------------------------------------------------------
#   push {lr}
#
#   .ifdef charkommaavailable
#   bl alignkomma
#   .endif
#
#   ldr r0, =Dictionarypointer
#   ldr r1, [r0] # Hole den Dictionarypointer
#
#   movs r0, #2
#   ands r1, r0
#
#   beq 1f
#
#   .ifdef erasedflashcontainszero
#     pushdatos
#     .ifdef m0core
#     ldr tos, =writtenhalfword
#     .else
#     movw tos, #writtenhalfword
#     .endif
#     bl hkomma
#   .else
#     pushdaconst 0
#     bl hkomma
#   .endif
#
# 1: # Fertig.
#   pop {pc}


#   .ifdef flash16bytesblockwrite # Needed for LPC1114FN28...
# # -----------------------------------------------------------------------------
#   Definition Flag_visible, "align16," # ( -- )
# align16komma: # Macht den Dictionarypointer auf 16 gerade
# # -----------------------------------------------------------------------------
#   push {lr}
#
# 1:ldr r0, =Dictionarypointer
#   ldr r1, [r0] # Hole den Dictionarypointer
#
#   movs r0, #15
#   ands r1, r0
#   beq 2f
#
#     pushdaconst 0
#     bl hkomma
#     b 1b
#
# 2:pop {pc}
#   .endif


#   .ifdef charkommaavailable
# # -----------------------------------------------------------------------------
#   Definition Flag_visible, "c," # ( x -- )
# ckomma:  # Fügt 8 Bits an das Dictionary an.
# # -----------------------------------------------------------------------------
#   push {lr}
#   ldr r0, =Dictionarypointer
#   ldr r1, [r0] # Hole den Dictionarypointer
#
#   ldr r2, =Backlinkgrenze
#   cmp r1, r2
#   bhs.n ckomma_ram # Befinde mich im Ram. Schalte um !
#
#   # ckomma for Flash:
#   pushda r1 # Adresse auch auf den Stack
#   bl c_flashkomma
#   b.n ckomma_fertig
#
# ckomma_ram:
#   popda r2 # Inhalt holen
#   strb r2, [r1] # Schreibe das Halbword in das Dictionary
#
# ckomma_fertig:
#   pushdaconst 1
#   bl allot
#   pop {pc}
#   .endif

# # -----------------------------------------------------------------------------
#   Definition Flag_visible, "h," # ( x -- )
# hkomma: # Fügt 16 Bits an das Dictionary an.
# # -----------------------------------------------------------------------------
#   push {r0, r1, r2, r3, lr}
#   uxth tos, tos # Mask low 16 Bits, just in case.
#
#   # dup
#   # bl hexdot
#
#   .ifdef registerallocator
#     # Schon geschriebene Opcodes zählen !
#     ldr r0, =state
#     ldr r1, [r0]
#     cmp r1, #0        # Nicht aus dem Execute-Zustand herausschalten
#     beq 1f
#     adds r1, #1
#     beq 1f            # Das normale True-Flag nicht erhöhen :-)
#       str r1, [r0]
# 1:
#   .endif
#
#   ldr r0, =Dictionarypointer # Fetch Dictionarypointer to decide if compiling for RAM or for Flash
#   ldr r1, [r0] # Hole den Dictionarypointer
#
#   ldr r2, =Backlinkgrenze
#   cmp r1, r2
#   bhs.n hkomma_ram # Befinde mich im Ram. Schalte um !
#
#   # hkomma for Flash:
#   pushda r1 # Adresse auch auf den Stack  Put target address on datastack, too !
#   bl h_flashkomma
#
#   b.n hkomma_fertig
#
# hkomma_ram: # Simply write directly if compiling for RAM.
#   popda r2 # Inhalt holen
#   strh r2, [r1] # Schreibe das Halbword in das Dictionary
#
# hkomma_fertig:
#   pushdaconst 2
#   bl allot
#
#   .ifdef within_os
#   bl cacheflush
#   .endif
#
#   pop {r0, r1, r2, r3, pc}


# -----------------------------------------------------------------------------
  Definition Flag_visible, "here" # ( -- addr ) Gives Dictionarypointer
here: # Gibt den Dictionarypointer zurück
# -----------------------------------------------------------------------------
  pushdatos    # Platz auf dem Datenstack schaffen
  laf x3, Dictionarypointer
  lw x3, 0(x3) # Hole den Dictionarypointer
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "flashvar-here" # ( -- a-addr ) Gives RAM management pointer
flashvarhere:
# -----------------------------------------------------------------------------
  pushdatos
  laf x3, VariablenPointer
  lw x3, 0(x3)
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "addrinflash?" # ( a-addr -- a-addr ) Permanent memory there ?
addrinflash:
# -----------------------------------------------------------------------------
  laf x5, FlashAnfang
  bltu x3, x5, 1f
  laf x5, FlashEnde
  bgeu x3, x5, 1f

    li x3, -1
    ret

1:li x3, 0
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "addrinram?" # ( a-addr -- a-addr ) Volatile memory there ?
# -----------------------------------------------------------------------------
  laf x5, RamAnfang
  bltu x3, x5, 1f
  laf x5, RamEnde
  bgeu x3, x5, 1f

    li x3, -1
    ret

1:li x3, 0
  ret

# -----------------------------------------------------------------------------
kommairgendwo: # ( x addr -- ) For backpatching of jump opcodes.
# -----------------------------------------------------------------------------
  push x1
  dup
  j komma_intern

# -----------------------------------------------------------------------------
  Definition Flag_visible, "," # ( x -- )
komma: # Fügt 32 Bits an das Dictionary an  Write 32 bits in Dictionary
# -----------------------------------------------------------------------------
  push x1

#  write "Komma: "
#  call here
#  call hexdot
#  dup
#  call hexdot
#  writeln ""

  call here
  dup

  pushdaconst 4
  call allot

komma_intern:
  call addrinflash
  popda x5
  beq x5, zero, komma_ram

komma_flash:
  call flashstore
  j 1f

komma_ram:
  # Simply write directly if compiling for RAM.
  popda x5
  sw x3, 0(x5)
  drop

1:pop x1
  ret


# # -----------------------------------------------------------------------------
#   Definition Flag_visible, "><," # ( x -- )
# reversekomma: # Fügt 32 Bits an das Dictionary an   Write 32 bits in Dictionary using 16 bit write access only, but reverse high and low order before.
# # -----------------------------------------------------------------------------
#   push {lr}
#   dup
#   lsrs tos, #16 # High-Teil danach
#   bl hkomma
#
#   bl hkomma # Low-Teil zuerst - Little Endian ! Außerdem stimmen so die Linkfelder.
#   pop {pc}
#


#------------------------------------------------------------------------------
  Definition Flag_visible, "allot" # Erhöht den Dictionaryzeiger, schafft Platz !  Advance Dictionarypointer and check if there is enough space left for the requested amount.
allot:  # Überprüft auch gleich, ob ich mich noch im Ram befinde.
        # Ansonsten verweigtert Allot seinen Dienst.
#------------------------------------------------------------------------------

#   # Simple variant without any checks.
#   li x6, Dictionarypointer
#   lw x5, 0(x6)
#   add x5, x5, x3
#   sw x5, 0(x6)
#   drop
#   ret

  push_x1_x10

  popda x10 # Requested length

  call here
  call addrinflash
  popda x5
  beq x5, zero, allot_ram

allot_flash:
  laf x6, Dictionarypointer
  lw x5, 0(x6)
  add x5, x5, x10

  laf x10, FlashDictionaryEnde

  bltu x5, x10, 1f
    writeln "Flash full"
    j quit

1:sw x5, 0(x6)

  pop_x1_x10
  ret

allot_ram:
  call flashvarhere         # Am Ende des RAMs liegen die Variablen. Diese sind die Ram-Voll-Grenze...
                            # There are variables defined in Flash at the end of RAM. Don't overwrite them !
  laf x6, Dictionarypointer
  lw x5, 0(x6)
  add x5, x5, x10

  bltu x5, x3, 1f
    writeln "Ram full"
    j quit

1:sw x5, 0(x6)
  drop
  pop_x1_x10
  ret


# There are two sets of Pointers: One set for RAM, one set for Flash Dictionary.
# They are exchanged if you want to write to the "other" memory type.
# A small check takes care of the case if you are already in the memory you request.

# -----------------------------------------------------------------------------
  Definition Flag_visible, "forgetram"
# -----------------------------------------------------------------------------
  push x1
  call compiletoram

  # Dictionarypointer ins RAM setzen
  # Set dictionary pointer into RAM first
  laf x6, Dictionarypointer
  laf x5, RamDictionaryAnfang
  sw x5, 0(x6)

  # Fadenende fürs RAM vorbereiten
  # Set latest for RAM
  laf x6, Fadenende
  la x5, CoreDictionaryAnfang
  sw x5, 0(x6)

  pop x1
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "compiletoram?"
# -----------------------------------------------------------------------------
  push x1
  call here
  call addrinflash
  xor x3, x3, -1
  pop x1
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "compiletoram"
compiletoram:
# -----------------------------------------------------------------------------
  push x1
  call here
  call addrinflash

  popda x5
  beq x5, zero, 2f

  # Befinde mich im Flash. Prüfe auf Kollisionen der Variablen mit dem RAM-Dictionary und schalte um !
  laf x5, ZweitDictionaryPointer
  laf x6, VariablenPointer
  lw x5, 0(x5)
  lw x6, 0(x6)

  bltu x5, x6, Zweitpointertausch
   writeln " Variables collide with dictionary"
  j Zweitpointertausch

# -----------------------------------------------------------------------------
  Definition Flag_visible, "compiletoflash"
compiletoflash:
# -----------------------------------------------------------------------------
  push x1
  call here
  call addrinflash

  popda x5
  beq x5, zero, Zweitpointertausch # Befinde mich im Ram. Schalte um !

2:pop x1
  ret

Zweitpointertausch:
  push_x10_x11

  laf x5, Fadenende
  laf x6, ZweitFadenende
  lw x10, 0(x5)
  lw x11, 0(x6)
  sw x10, 0(x6)
  sw x11, 0(x5)

  laf x5, Dictionarypointer
  laf x6, ZweitDictionaryPointer
  lw x10, 0(x5)
  lw x11, 0(x6)
  sw x10, 0(x6)
  sw x11, 0(x5)

  # In x5 ist nun der aktuelle DictionaryPointer.
  # Der muss immer unterhalb des VariablenPointers sein !
  # Compare Dictionarypointer to Variablepointer and give warning if they collide.
  # That happens if your already have a lot of definitions in RAM,
  # then define a lot of variables in Flash and then switch back for compiling to RAM.

#   call flashvarhere
#   popda x5
#   bltu x5, x11, 1f
#    writeln " Variables collide with dictionary" ***
# 1:

  pop_x10_x11

  pushdaconst 0 # Trick: Allot will check for collisions, too, and reports RAM full then.
  call allot

  pop x1
  ret



# -----------------------------------------------------------------------------
  Definition Flag_visible, "(create)"
create: # Nimmt das nächste Token aus dem Puffer,
        # erstellt einen neuen Kopf im Dictionary und verlinkt ihn.
        # Fetch new token from buffer, create a new dictionary header and take care of links.
        # Links are very different for RAM and Flash !
        # As we can write Flash only once, freshly created definitions have no code at all.
# -----------------------------------------------------------------------------
  push x1
  call token # Hole den Namen der neuen Definition.  Fetch name for new definition.
  # ( Tokenadresse Länge )
  bne x3, zero, 1f

    # Check if token is empty. That happens if input buffer is empty after create.
    # Token ist leer. Brauche Stacks nicht zu putzen.
    writeln " Create needs name !"
    j quit

1:# Tokenname ist okay.               Name is ok.
  # Prüfe, ob er schon existiert.     Check if it already exists.
  ddup
  # ( Tokenadresse Länge Tokenadresse Länge )
  call find
  # ( Tokenadresse Länge Einsprungadresse Flags )
  drop # Benötige die Flags hier nicht. Möchte doch nur schauen, ob es das Wort schon gibt.  No need for the Flags...
  # ( Tokenadresse Länge Einsprungadresse )

  # Prüfe, ob die Suche erfolgreich gewesen ist.  Do we have a search result ?
  popda x5
  beq x5, zero, 2f
  # ( Tokenadresse Länge )
    ddup
    write "Redefine "
    call type # Den neuen Tokennamen nochmal ausgeben
    write ". "

2:# bl align4komma
  # ( Tokenadresse Länge )

  call here
  call addrinflash
  popda x5
  beq x5, zero, create_ram

  # -----------------------------------------------------------------------------
  # Create for Flash
  call here
  # ( Tokenadresse Länge Neue-Linkadresse )

  laf x6, FlashFlags
  li x5, Flag_visible
  sw x5, 0(x6) # Flags vorbereiten  Prepare Flags for collecting

  pushdaconst 8 # Lücke für die Flags und Link lassen  Leave space for Flags and Link - they are not known yet at this time.
  call allot

  call minusrot
  call stringkomma # Den Namen einfügen  Insert Name
  # ( Neue-Linkadresse )

  # Jetzt den aktuellen Link an die passende Stelle im letzten Wort einfügen,
  # falls dort FFFF FFFF steht:
  # Insert Link to fresh definition into old latest if there is still -1 in its Link field:

  laf x10, Fadenende # Hole das aktuelle Fadenende  Fetch old latest
  lw x11, 0(x10)

  lw x12, 0(x11) # Inhalt des Link-Feldes holen  Check if Link is set

  li x13, erasedword
  bne x12, x13, 1f # Ist der Link ungesetzt ?      Isn't it ?

    dup
    pushda x11
    call flashstore

1:# Backlink fertig gesetzt.  Finished Backlinking.
  # Fadenende aktualisieren:  Set fresh latest.
  sw x3, 0(x10) # Neues-Fadenende in die Fadenende-Variable legen
  drop

  j create_ende

  # -----------------------------------------------------------------------------
  # Create for RAM
create_ram:
  # ( Tokenadresse Länge )

  call here

    # Link setzen  Write Link
    pushdaaddrf Fadenende
    lw x3, 0(x3)
    call komma # Das alte Fadenende hinein   Old latest

  laf x6, Fadenende # Das Fadenende aktualisieren  Set new latest
  sw x3, 0(x6)
  drop

  # Flags setzen  Set initial Flags to Invisible.
  pushdaconst Flag_invisible
  call komma

  # Den Namen schreiben  Write Name
  call stringkomma

create_ende: # Save code entry point of current definition for recurse and dodoes

  call here
  laf x6, Einsprungpunkt
  sw x3, 0(x6)
  drop

  pop x1
  ret


# -----------------------------------------------------------------------------
  Definition Flag_visible, "variable" # ( n -- )
# -----------------------------------------------------------------------------
  pushdaconst 1
  j nvariable

# -----------------------------------------------------------------------------
  Definition Flag_visible, "2variable" # ( d -- )
# -----------------------------------------------------------------------------
  pushdaconst 2
  j nvariable

#------------------------------------------------------------------------------
  Definition Flag_visible, "nvariable" # ( Init-Values Length -- )
nvariable: # Creates an initialised variable of given length.
#------------------------------------------------------------------------------

  push_x1_x10_x12

  call create

  call here
  call addrinflash
  popda x5
  beq x5, zero, variable_ram

  # -----------------------------------------------------------------------------
  # Variable Flash

  # Variablenpointer erniedrigen und zurückschreiben
  # Stelle initialisieren
  # Code für diese Stelle schreiben

  # Decrement variable pointer and write back
  # Initialise allocated location
  # Write code into Flash for that location - it is ensured that catchflashpointers will
  # initialise exactly that physical address again on next Reset.
  # Order of instructions carefully choosen to not corrupt RAM management in any case.

      # Eine echte Flash-Variable entsteht so, dass Platz im Ram angefordert wird.
      # Prüfe hier, ob genug Ram da ist !?
      # Maybe check in future if there is enough RAM left ?

  andi x3, x3, 0x0F # Maximum length for flash variables ! Limit is important to not break Flags for catchflashpointers.

  # Variablenpointer erniedrigen und zurückschreiben   Decrement variable pointer

  sll x12, x3, 2 # Multiply number of elements with 4 to get byte count

  laf x10, VariablenPointer
  lw x11, 0(x10)
  sub x11, x11, x12  # Ram voll ?  Maybe insert a check for enough RAM left ?
    laf x12, RamDictionaryAnfang
    bge x11, x12, 1f
      writeln "Not enough RAM"
      j quit
1:sw x11, 0(x10)

  # Code schreiben:  Write code
  pushda x11
  call literalkomma

  .ifdef mipscore
  pushdaconst 0x03E00008
  call komma
  pushdaconst 0x00000000
  call komma
  .else
  pushdaconst 0x00008067 # ret
  call komma
  .endif

  # Amount of elements to write is in TOS.
  # Write code and initialise elements.
  # r1 is target location in RAM.

  popda x10   # Fetch amount of cells
  mv x12, x10 # Save the value for generating flags for catchflashpointers later
  beq x10, zero, 2f # If nvariable is called with length zero... Maybe this could be useful sometimes.

1:sw x3, (x11) # Initialize RAM location
  addi x11, x11, 4
  call komma      # Put initialisation value for catchflashpointers in place.
  addi x10, x10, -1
  bne x10, zero, 1b

2:# Finished.

  pushdaconst Flag_ramallot & ~Flag_visible # Finally (!) set Flags for RAM usage.
  or x3, x3, x12               # Or together with desired amount of cells.
  call setflags
  call smudge

  pop_x1_x10_x12
  ret

  # -----------------------------------------------------------------------------
  # Variable RAM
variable_ram:
  # This is simple: Write code, write value, a classic Forth variable.

  # pushdatos
  # mov tos, pc
  # adds tos, #2
  # bx lr
  # Value for Variable

#  pushdaconstw 0x3f04  # subs    r7, #4
#  bl hkomma
#  pushdaconstw 0x603e  # str     r6, [r7, #0]
#  bl hkomma
#  pushdaconstw 0x467e  # mov     r6, pc
#  bl hkomma
#  pushdaconstw 0x3602  # adds    r6, #2
#  bl hkomma
#  pushdaconstw 0x4770 # Opcode für bx lr --> 2 Bytes
#  bl hkomma

#   # This is to align dictionary pointer to have variable locations that are always 4-even
#     bl here
#     movs r0, #2
#     ands tos, r0
#     drop
#     bne 1f
#       pushdaconst 0x0036  # nop = movs tos, tos
#       bl hkomma
# 1:

  .ifdef mipscore

  pushdaconst 0x2484FFFC # dup
  call komma
  pushdaconst 0xAC830000
  call komma
  pushdaconst 0x03E01809 # jalr x3, x1
  call komma
  pushdaconst 0x00000000 # nop
  call komma

  .else

  pushdaconst 0xffc20213 # Opcodes for "dup"
  call komma
  pushdaconst 0x00322023
  call komma
  pushdaconst 0x000081e7 # Opcode for jalr x3, x1, 0
  call komma

  .endif


  # Amount of elements to write is in TOS.

  popda x10   # Fetch amount of cells
  beq x10, zero, 2f # If nvariable is called with length zero... Maybe this could be useful sometimes.

1:call komma
  addi x10, x10, -1
  bne x10, zero, 1b

2:# Finished.

  call setze_faltbarflag # Variables always are 0-foldable as their address never changes.
  call smudge
  pop_x1_x10_x12
  ret


#------------------------------------------------------------------------------
  Definition Flag_visible, "buffer:" # ( Length -- )
  # Creates an uninitialised buffer of given bytes length.
#------------------------------------------------------------------------------

  push_x1_x10_x12

  call create

  # Round requested buffer length to next 4-Byte boundary to ensure alignment
  andi x5, x3, 1
  add x3, x3, x5
  andi x5, x3, 2
  add x3, x3, x5

  call here
  call addrinflash
  popda x5
  beq x5, zero, rambuffer_ram

  # -----------------------------------------------------------------------------
  # Buffer Flash

  # Variablenpointer erniedrigen und zurückschreiben   Decrement variable pointer

  laf x10, VariablenPointer
  lw x11, 0(x10)
  sub x11, x11, x3  # Ram voll ?  Maybe insert a check for enough RAM left ?
    laf x12, RamDictionaryAnfang
    bge x11, x12, 1f
      writeln "Not enough RAM"
      j quit
1:sw x11, 0(x10)

  # Code schreiben:  Write code
  pushda x11
  call literalkomma

  .ifdef mipscore
  pushdaconst 0x03E00008
  call komma
  pushdaconst 0x00000000
  call komma
  .else
  pushdaconst 0x00008067 # ret
  call komma
  .endif

  # Write desired size of buffer at the end of the definition
  call komma

  # Finished
  pushdaconst Flag_buffer_foldable  # Finally (!) set Flags for buffer usage.
  call setflags
  call smudge

  pop_x1_x10_x12
  ret

  # -----------------------------------------------------------------------------
  # Buffer RAM
rambuffer_ram:
  # This is simple: Write code, allot space, a classic Forth buffer.

#   # This is to align dictionary pointer to have variable locations that are always 4-even
#     bl here
#     movs r0, #2
#     ands tos, r0
#     drop
#     bne 1f
#       pushdaconst 0x0036  # nop = movs tos, tos
#       bl hkomma
# 1:

  .ifdef mipscore

  pushdaconst 0x2484FFFC # dup
  call komma
  pushdaconst 0xAC830000
  call komma
  pushdaconst 0x03E01809 # jalr x3, x1
  call komma
  pushdaconst 0x00000000 # nop
  call komma

  .else

  pushdaconst 0xffc20213 # Opcodes for "dup"
  call komma
  pushdaconst 0x00322023
  call komma
  pushdaconst 0x000081e7 # Opcode for jalr x3, x1, 0
  call komma

  .endif

  call allot # Reserve space. Allot checks for itself if there is enough RAM left.

  call setze_faltbarflag # Buffers always are 0-foldable as their address never changes.
  call smudge

  pop_x1_x10_x12
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "dictionarystart"
dictionarystart: # ( -- Startadresse des aktuellen Dictionaryfadens )
                 # Da dies je nach Ram oder Flash unterschiedlich ist...
                 # Einmal so ausgelagert.
                 # Entry point for dictionary searches.
                 # This is different for RAM and for Flash and it changes with new definitions.
# -----------------------------------------------------------------------------


  # Prüfe, ob der Dictionarypointer im Ram oder im Flash ist:  Are we compiling into RAM or into Flash ?
  push x1

  call here
  call addrinflash
  pop x1
  beq x3, zero, 1f

  la x3, CoreDictionaryAnfang # Befinde mich im Flash mit Backlinks. Muss beim CoreDictionary anfangen:        In Flash: Start with core dictionary.
  ret

1:laf x3, Fadenende            # Kann mit dem Fadenende beginnen.                                               In RAM:   Start with latest definition.
  lw x3, 0(x3)
  ret

  # Zwei Möglichkeiten: Vorwärtslink ist $FFFFFFFF --> Ende gefunden
  # Oder Vorwärtslink gesetzt, aber an der Stelle der Namenslänge liegt $FF. Dann ist das Ende auch da.
  # Diese Variante tritt auf, wenn nichts hinzugetan wurde, denn im festen Teil ist der Vorwärtslink
  # immer gesetzt und zeigt auf den Anfang des Schreib/Löschbaren Teils.

  # There are two possibilities to detect end of dictionary:
  # - Link is $FFFFFFFF
  # - Link is set, but points to memory that contains $FF in name length.
  # Last case happens if nothing is compiled yet, as the latest link in core always
  # points to the beginning of user writeable/eraseable part of dictionary space.

  # Dictionary entry structure:
  # 4 Bytes Link ( 4-aligned )
  # 4 Bytes Flags
  # 1 Byte  Name length
  #         Counted Name string and sometimes a padding zero to realign.
  #         Code.

# -----------------------------------------------------------------------------
  Definition Flag_visible, "dictionarynext" # ( address -- address flag )
dictionarynext: # Scans dictionary chain and returns true if end is reached.
# -----------------------------------------------------------------------------
  li x5, erasedword # Check if link field is empty which does not happen with properly smudged flash definitions
  lw x6, 0(x3)
  beq x5, x6, 1f

    li x5, erasedbyte
    lbu x6, 8(x6) # Skip link and flags of the next definition to fetch its name length byte
    beq x5, x6, 1f

      lw x3, 0(x3)
        pushdaconst 0
        ret

1:pushdaconst -1
  ret

#  .ifdef registerallocator
#
#  # -----------------------------------------------------------------------------
#    Definition Flag_visible, "find"
#  find: # ( address length -- Code-Adresse Flags )
#  # -----------------------------------------------------------------------------
#    ldr r0, =hook_find
#    ldr r0, [r0]
#    mov pc, r0
#
#  #------------------------------------------------------------------------------
#    Definition Flag_visible|Flag_variable, "hook-find" # ( -- addr )
#    CoreVariable hook_find
#  #------------------------------------------------------------------------------
#    pushdatos
#    ldr tos, =hook_find
#    bx lr
#    .word core_find
#
#  # -----------------------------------------------------------------------------
#    Definition Flag_visible, "(find)"
#  core_find: # ( address length -- Code-Adresse Flags )
#  # -----------------------------------------------------------------------------
#
#  .else
#
#  # -----------------------------------------------------------------------------
#    Definition Flag_visible, "find"
#  find: # ( address length -- Code-Adresse Flags )
#  # -----------------------------------------------------------------------------
#
#  .endif

# -----------------------------------------------------------------------------
  Definition Flag_visible, "find"
find: # ( address length -- Code-Adresse Flags )
# -----------------------------------------------------------------------------
  push_x1_x10_x15

  # call dots
  # x10  Helferlein      Scratch
  # x11  Flags           Flags

  # x12  Zieladresse     Destination Address
  # x13  Zielflags       Destination Flags

  # x14  Adresse des zu suchenden Strings  Address of string that is searched for
  # x15  Dessen Länge                      Length

  # x3   Hangelpointer   Pointer for crawl the dictionary

  # over
  # over
  # writeln ""
  # write "("
  # call type
  # write ")"


  li x12, 0  # Noch keinen Treffer          No hits yet
  li x13, 0  # Und noch keine Trefferflags  No hits have no Flags

  popdadouble x15, x14
  # popda x15 # Fetch string length
  # popda x14 # Fetch string address

  call dictionarystart
  # dup
  # write "Dictionarystart in find: "
  # call hexdot
  # writeln ""

1:# Loop through the dictionary

  li x10, Flag_invisible
  lw x11, 4(x3) # Fetch Flags to see if this definition is visible.
  beq x10, x11, 2f # Skip this definition if invisible

  # Definition is visible. Compare the name !
  dup
  addi x3, x3, 8 # Skip Link and Flags
  call count     # Prepare an address-length string

  # call dots

  #over
  #over
  #write "["
  #call type
  #write "] "

  pushdadouble x14, x15
  #pushda x14
  #pushda x15
  call compare
  popda x10
  beq x10, zero, 2f

    # Gefunden ! Found !
    # String überlesen und Pointer gerade machen   Skip name string
    dup
    addi x3, x3, 8 # Skip Link and Flags
    call skipstring
    popda x12      # Codestartadresse  Note Code start address
    mv x13, x11    # Flags             Note Flags

    # j 3f # RAM only, finished on first hit.

    # Prüfe, ob ich mich im Flash oder im Ram befinde.  Check if in RAM or in Flash.
    # Im Ram beim ersten Treffer ausspringen. Search is over in RAM with first hit.
    # Im Flash wird weitergesucht, ob es noch eine neuere Definition mit dem Namen gibt.
    # When in Flash, whole dictionary has to be searched because of backwards link dictionary structure.
    pushda x12
    call addrinflash
    popda x5
    beq x5, zero, 3f

2:# Weiterhangeln  Continue crawl.
  call dictionarynext
  popda x10
  beq x10, zero, 1b


3:# Durchgehangelt. Habe ich etwas gefunden ?  Finished. Found something ?
  # Zieladresse gesetzt, also nicht Null bedeutet: Etwas gefunden !    Destination address <> 0 means successfully found.
  mv x3, x12    # Zieladresse    oder 0, falls nichts gefunden            Address = 0 means: Not found. Check for that !
  pushda x13    # Zielflags      oder 0  --> # ( 0 0 - Nicht gefunden )   Push Flags on Stack. ( Destination-Code Flags ) or ( 0 0 ).

  pop_x1_x10_x15
  ret

# -----------------------------------------------------------------------------
find_not_found: # Internal use. Gives "not found." message if find is not successful.
# -----------------------------------------------------------------------------
  push_x1_x10_x11

  lw x10, 0(x4) # Save string address and length for later use
  mv x11, x3

  call find

  lw x5, 0(x4) # Probe entry address
  bne x5, zero, 1f

    pushda x10
    pushda x11
    call type
    writeln " not found."
    j quit

1:pop_x1_x10_x11
  ret
