#
#    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 Routinen, die nötig sind, um neue Definitionen zu kompilieren.
# The compiler - parts that are the same for Flash and for Ram.

# -----------------------------------------------------------------------------
  Definition Flag_visible, "registerliteral," # ( x Register -- )
registerliteralkomma: # Compile code to put a literal constant into a register.
# -----------------------------------------------------------------------------
  .ifdef mipscore

  push_x1_x10
  popda x10 # Target register

  # 16 bit unsigned constant ?
  li x5, 0xFFFF0000 # Possible range for ori opcode
  and x6, x3, x5
  bne x6, zero, 1f

    li x6, 0x34000000 # ori zero, zero, 0
4:  andi x3, x3, 0xFFFF
    slli x5, x10, 16
    or x3, x3, x5
    or x3, x3, x6
    call komma  
    j 3f
    

1:# Sign + 15 bit negative constant ?
  li x5, 0xFFFF8000 # Possible range for addiu opcode
  and x6, x3, x5
  bne x5, x6, 2f
    li x6, 0x24000000 # addiu zero, zero, 0
    j 4b


2:# Long literal with two opcodes
  dup

  # High-Part
  srli x3, x3, 16
  slli x5, x10, 16
  or x3, x3, x5  
  li x5, 0x3C000000 # lui zero, 0
  or x3, x3, x5
  call komma

  # Low-Part

  andi x3, x3, 0xFFFF
  slli x5, x10, 16
  or x3, x3, x5  
  slli x5, x10, 16+5
  or x3, x3, x5
  li x6, 0x34000000 # ori zero, zero, 0
  or x3, x3, x6
  call komma
  
3:pop_x1_x10
  ret

  .else

  push_x1_x10
  popda x10 # Target register

  # Probe, ob sich die Konstante nicht auch kürzer laden lässt:

  li x5, 0xFFFFF800
  and x6, x3, x5
  beq x6, x5, 1f
  bne x6, zero, 2f

1:# Kurze Variante mit nur einem Opcode.

  sll x3, x3, 20
  li x5, 0x4013 # xori x0, x0, ...
  sll x6, x10, 7  # Zielregister
  or  x5, x5, x6  #  hinzuverodern
  j 4f

2:# Lange Variante mit zwei Opcodes.

  # Korrektur fürs negative Vorzeichen im xori-Opcode:
  li x5, 0x800
  and x5, x5, x3
  beq x5, zero, 3f
    li x5, 0xFFFFF000
    xor x3, x3, x5
3:
    
  dup
  li x5, 0xFFFFF000
  and x3, x3, x5
  ori  x3, x3, 0x000000037  # lui x0, ...
  sll x6, x10, 7  # Zielregister
  or  x3, x3, x6  #  hinzuverodern
  call komma
  
  sll x3, x3, 20
  li x5, 0x4013 # xori x0, x0, ...
  sll x6, x10, 7  # Zielregister
  or  x5, x5, x6  #  hinzuverodern
  sll x6, x10, 15 # Quellregister
  or  x5, x5, x6  #  hinzuverodern

4:or x3, x3, x5
  call komma

  pop_x1_x10
  ret
  .endif

# -----------------------------------------------------------------------------
  Definition Flag_visible, "literal," # ( x -- )
literalkomma:
# -----------------------------------------------------------------------------
  push x1
  
  .ifdef mipscore

  pushdaconst 0x2484fffc
  call komma
  pushdaconst 0xac830000
  call komma

  .else
  pushdaconst 0xffc20213
  call komma
  pushdaconst 0x00322023
  call komma
  .endif

  pushdaconst 3
  call registerliteralkomma
  
  pop x1
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "call," # ( x -- )
callkomma: # Hier kann ich noch eine Probe einfügen, ob ich nicht auch einen kurzen JAL-Opcode generieren könnte. ***
# -----------------------------------------------------------------------------

  .ifdef mipscore

  push x1

  # Take care of 256 MB borders ! Important for reaching Flash <--> RAM in real MIPS cores. ****

  call here
  popda x5
  li x6, 0xF0000000
  and x5, x5, x6
  and x6, x3, x6
  beq x5, x6, 1f

  # Generate long call sequence

  pushdaconst 5
  call registerliteralkomma

  pushdaconst 0x00A0F809 # jalr x1, x5
  call komma
  j 2f
  
1:# Generate JAL opcode
  srli x3, x3, 2
  li x5, 0x03FFFFFF
  and x3, x3, x5
  li x5, 0x0C000000
  or  x3, x3, x5
  call komma

2: # Fill nop into branch delay slot
  pushdaconst 0
  call komma

  pop x1
  ret

  .else

  push x1

  dup
  call here
  call minus
  call uj_encoding_q
  popda x5
  beq x5, zero, 2f

    # Kurzer JAL-Opcode ist möglich !
    li x5, 0x000000ef # jal x1, 0
    or x3, x3, x5
    call komma
    drop
    pop x1
    ret  

2:drop
  # 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, ...
  call komma
  
  sll x3, x3, 20
  li x5, 0x000280e7  # jalr x1, x5, 0
  or x3, x3, x5
  call komma
  
  pop x1
  ret
  .endif

# -----------------------------------------------------------------------------
  Definition Flag_visible, "inline," # ( x -- )
inlinekomma:
# -----------------------------------------------------------------------------

  .ifdef mipscore

  push_x1_x10

1:lw x10, 0(x3)
  li x5, 0x03e00008 # Ret-Opcode
  beq x10, x5, 2f

    pushda x10
    call komma
    addi x3, x3, 4
    j 1b

2:lw x3, 4(x3) # Check branch delay slot for an additional opcode.
  beq x3, zero, 3f

    call komma
    j 4f

3:drop
4:pop_x1_x10
  ret

  .else

  push_x1_x10

1:lw x10, 0(x3)
  li x5, 0x00008067 # Ret-Opcode
  beq x10, x5, 2f

    pushda x10
    call komma
    addi x3, x3, 4
    j 1b

2:drop
  pop_x1_x10
  ret

  .endif
  
# -----------------------------------------------------------------------------
  Definition Flag_visible, "skipdefinition" # ( addr -- addr )
suchedefinitionsende:
# -----------------------------------------------------------------------------
  .ifdef mipscore

  li x6, 0x03e00008 # Ret-Opcode
  
1:lw x5, 0(x3)
  addi x3, x3, 4
  bne x5, x6, 1b
  
  addi x3, x3, 4 # Skip branch delay slot
  ret

  .else

  li x6, 0x00008067 # Ret-Opcode
  
1:lw x5, 0(x3)
  addi x3, x3, 4
  bne x5, x6, 1b
  
  ret
  .endif

# -----------------------------------------------------------------------------
  Definition Flag_visible, "string," # ( c-addr length -- )
stringkomma: # Fügt ein String an das Dictionary an  Write a string in Dictionary.
# -----------------------------------------------------------------------------

  push_x1_x10_x13
  
  andi x10, x3, 0xFF   # Maximum counted string length
  lw x11, 0(x4)        # Fetch address of string
  addi x4, x4, 4  
  call clearbytes
  call addbyte # Strings begins with its length byte
  
1:beq x10, zero, 2f
  pushdatos
  lbu x3, 0(x11)  
  call addbyte  
  addi x10, x10, -1
  addi x11, x11,  1  
  j 1b
  
2:call flushbytes

  pop_x1_x10_x13
  ret
    
addbyte:
  sll x3, x3, x12
  or x13, x13, x3
  drop
  addi x12, x12, 8
  li x5, 32
  bne x12, x5, retbytes    
flushbytes:
  beq x12, zero, clearbytes
  push x1
  pushda x13
  call komma
  pop x1
clearbytes:
  li x12, 0 # How many bytes already written ?
  li x13, 0 # Data which needs to be flushed later
retbytes:
  ret  

#------------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "[']" # Sucht das nächste Wort im Eingabestrom  Searches the next token in input buffer and compiles its entry point as literal.
#------------------------------------------------------------------------------
  j tick # So sah das mal aus: ['] ' immediate 0-foldable ;

# -----------------------------------------------------------------------------
  Definition Flag_visible, "'" # Searches next token in unput buffer and gives back its code entry point.
tick: # Nimmt das nächste Token aus dem Puffer, suche es und gibt den Einsprungpunkt zurück.
# -----------------------------------------------------------------------------
  push x1
  call token
  call find_not_found
  popda x5 # Drop Flags into x5 - used by postpone !
  pop x1
  ret


#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "postpone" # Sucht das nächste Wort im Eingabestrom  Search next token and fill it in Dictionary in a special way.
                                       # und fügt es auf besondere Weise ein.
#------------------------------------------------------------------------------
  push x1
  # writeln "Postpone läuft"
  call tick # Stores Flags into x5 !

  # ( Einsprungadresse )  

#   .ifdef registerallocator
# 
#   pushda r0
#   swap
#   bl literalkomma
#   bl literalkomma
#   pushdatos
#   ldr tos, =kompilator
#   bl callkomma
#   pop {pc}
# 
#   .else

1:andi x6, x5, Flag_immediate & ~Flag_visible # In case definition is immediate: Compile a call to its address.
  bne x6, zero, 4f

2:andi x6, x5, Flag_inline & ~Flag_visible    # In case definition is inline: Compile entry point as literal and a call to inline, afterwards.
  beq x6, zero, 3f
                             # ( Einsprungadresse )
    call literalkomma                  # Einsprungadresse als Konstante einkompilieren
    pushdaaddr inlinekomma
    j 4f                             # zum Aufruf bereitlegen
    
3:# Normal                     # In case definition is normal: Compile entry point as literal and a call to call, afterwards.
    call literalkomma
    pushdaaddr callkomma

4:  call callkomma
    pop x1
    ret

  # .endif

#  # -----------------------------------------------------------------------------
#    Definition Flag_visible, "inline," # ( addr -- )
#  inlinekomma:
#  # -----------------------------------------------------------------------------
#    push {lr}
#    # Übernimmt eine Routine komplett und schreibt sie ins Dictionary.
#    # TOS enthält Adresse der Routine, die eingefügt werden soll.
#    # Copy the whole code of a definition into Dictionary.
#  
#    # Es gibt drei besondere Opcodes:     There are three special opcodes:
#    #  - push {lr} wird übersprungen        will be skipped
#    #  - pop {pc} ist Ende                  is end of definition
#    #  - bx lr ist auch eine Endezeichen.   is end often used in core.
#  
#  
#    .ifdef m0core
#    ldr r1, =0xb500 # push {lr}
#    ldr r2, =0xbd00 # pop {pc}
#    ldr r3, =0x4770 # bx lr
#    .else
#    movw r1, #0xb500 # push {lr}
#    movw r2, #0xbd00 # pop {pc}
#    movw r3, #0x4770 # bx lr
#    .endif
#  
#  1:ldrh r0, [tos] # Hole die nächsten 16 Bits aus der Routine.  Fetch next opcode...
#    cmp r0, r1 # push {lr}
#    beq 2f
#    cmp r0, r2 # pop {pc}
#    beq 3f
#    cmp r0, r3 # bx lr
#    beq 3f
#  
#    pushda r0
#    bl hkomma # Opcode einkompilieren  After checking is done, insert opcode into Dictionary.
#  
#  2:adds tos, #2 # Pointer weiterrücken  Advance pointer
#    b 1b 
#  
#  3:drop
#    pop {pc}
#  
#  # An der ersten Stelle wird geprüft: Ist es eine Routine mit pop {pc} oder mit bx lr am Ende ?
#  # -----------------------------------------------------------------------------
#  suchedefinitionsende: # Rückt den Pointer in r0 ans Ende einer Definition vor.
#                        # Advance r0 to the end of code of current definition by searching for pop {pc} or bx lr opcodes.
#  # -----------------------------------------------------------------------------
#          # Suche wie in inline, nach pop {pc} oder bx lr.
#          push {r1, r2, r3}
#  
#           .ifdef m0core
#           ldr r2, =0xbd00 # pop {pc}
#           ldr r3, =0x4770 # bx lr
#           .else
#           movw r2, #0xbd00 # pop {pc}
#           movw r3, #0x4770 # bx lr
#           .endif
#  
#  
#  1:        ldrh r1, [r0]  # Hole die nächsten 16 Bits aus der Routine.
#            adds r0, #2    # Pointer Weiterrücken
#  
#            cmp r1, r2  # pop {pc}
#            beq 2f
#            cmp r1, r3  # bx lr
#            bne 1b
#  
#  2:      pop {r1, r2, r3}
#          bx lr
#  
#  
#  # -----------------------------------------------------------------------------
#    Definition Flag_visible, "ret," # ( -- )
#  retkomma: # Write pop {pc} opcode
#  # -----------------------------------------------------------------------------
#    # Mache das mit pop {pc}
#    pushdaconstw 0xbd00 # Opcode für pop {pc} schreiben
#    b.n hkomma
#  

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "exit" # Kompiliert ein ret mitten in die Definition.
exitkomma:  # Writes a ret opcode into current definition. Take care with inlining !
#------------------------------------------------------------------------------
  push x1
  
  # Write opcodes for "pop x1 ret"
  .ifdef mipscore
  pushdaconst 0x8C5F0000 
  call komma
  pushdaconst 0x03E00008
  call komma 
  pushdaconst 0x24420004
  call komma
  .else
  pushdaconst 0x00012083 # lw	ra,0(sp)
  call komma
  pushdaconst 0x00410113 # addi	sp,sp,4
  call komma  
  pushdaconst 0x00008067 # ret
  call komma
  .endif

  pop x1
  ret

# Some tests:
#  : fac ( n -- n! )   1 swap  1 max  1+ 2 ?do i * loop ;
#  : fac-rec ( acc n -- n! ) dup dup 1 = swap 0 = or if drop else dup 1 - rot rot * swap recurse then ; : facre ( n -- n! ) 1 swap fac-rec ;

#------------------------------------------------------------------------------
  Definition Flag_immediate_compileonly, "recurse" # Für Rekursion. Führt das gerade frische Wort aus. Execute freshly defined definition.
#------------------------------------------------------------------------------
  pushdaconst Einsprungpunkt
  lw x3, 0(x3)
  j callkomma

# -----------------------------------------------------------------------------
  Definition Flag_visible|Flag_variable, "state" # ( -- addr )
  CoreVariable state
# -----------------------------------------------------------------------------
  pushdatos
  laf x3, state
  ret
  .word 0

#------------------------------------------------------------------------------
  Definition Flag_visible, "]" # In den Compile-Modus übergehen  Switch to compile mode
# -----------------------------------------------------------------------------
  laf x6, state
  li x5, -1
  sw x5, 0(x6)
  ret

#------------------------------------------------------------------------------
  Definition Flag_immediate, "[" # In den Execute-Modus übergehen  Switch to execute mode
# -----------------------------------------------------------------------------
  laf x6, state
  li x5, 0
  sw x5, 0(x6)
  ret

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

  laf x6, Datenstacksicherung # Setzt den Füllstand des Datenstacks zur Probe.
  sw x4, 0(x6)               # Save current datastack pointer to detect structure mismatch later.

  call create


#   .ifdef registerallocator
# 
#     ldr r0, =state
#     movs r1, #1 # So eine Art bx lx-Kompilierzustand-Flag in State legen
#     str r1, [r0]
# 
#     # Neue Definition: Auf jeden Fall den Inline-Cache frisch leeren !
#     ldr r0, =inline_cache_count
#     movs r1, #0
#     str r1, [r0]  # Inline Cache empty
# 
#   .else

  # Write opcodes for "push x1"  
  .ifdef mipscore
  pushdaconst 0x2442FFFC
  call komma
  pushdaconst 0xAC5F0000
  call komma
  .else
  pushdaconst 0xffc10113 # addi	sp,sp,-4
  call komma
  pushdaconst 0x00112023 # sw	ra,0(sp)
  call komma
  .endif

  laf x6, state
  li x5, -1
  sw x5, 0(x6)

  pop x1
  ret

# -----------------------------------------------------------------------------
#  .ifdef registerallocator
#  Definition Flag_immediate_compileonly|Flag_bxlr, ";" # ( -- )
#  .else
  Definition Flag_immediate_compileonly, ";" # ( -- )
#  .endif
# -----------------------------------------------------------------------------
  push x1

  laf x6, Datenstacksicherung # Prüft den Füllstand des Datenstacks.
  lw x5, 0(x6)               # Check fill level of datastack.
  beq x5, x4, 1f
    writeln " Stack not balanced."
    j quit
1: # Stack balanced, ok


#   .ifdef registerallocator
#     # Jetzt entweder bx lr oder pop {pc} schreiben.
#      
#      ldr r0, =state
#      ldr r0, [r0]
#      adds r1, r0, #1
#      beq 3f
#        cmp r0, #rawinlinelength + 1  # Kurze Definitionen mit bis zu 5 Einfach-Opcodes (State zählt ab 1) werden direkt als inline markiert.
#        bhi 2f         
#          pushdaconstw (Flag_inline | Flag_bxlr ) & ~Flag_visible
#          bl setflags
# 2:     pushdaconstw 0x4770 # bx lr
#        bl hkomma # bx lr schreiben !
# 
#        # Prinzipiell ist diese Definition Inline-tauglich, auch wenn sie vielleicht ein bisschen zu lang geworden sein könnte.
#        # An dieser Stelle ist es also sicher, aus dem Inline-Cache heraus den RA zu bemühen.
#        # Mal schauen, was daraus wird !
# 
#        bl inline_cache_schreiben
#        b.n 4f
# 3:   # Doch ein pop {pc} ? Dann war wohl etwas enthalten, was nicht durch inline laufen darf.
#   .endif

  call exitkomma

4:call smudge

  laf x6, state
  li x5, 0
  sw x5, 0(x6)

  pop x1
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "execute"
execute:
# -----------------------------------------------------------------------------
  popda x5
  .ifdef mipscore
  jr x5
  .else
  jalr zero, x5, 0
  .endif

# -----------------------------------------------------------------------------
  Definition Flag_immediate, "immediate" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_immediate & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "inline" # ( -- )
setze_inlineflag:
# -----------------------------------------------------------------------------
  pushdaconst Flag_inline & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate, "compileonly" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_immediate_compileonly & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "0-foldable" # ( -- )
setze_faltbarflag:
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_0 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "1-foldable" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_1 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "2-foldable" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_2 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "3-foldable" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_3 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "4-foldable" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_4 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "5-foldable" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_5 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "6-foldable" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_6 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_immediate|Flag_foldable_0, "7-foldable" # ( -- )
# -----------------------------------------------------------------------------
  pushdaconst Flag_foldable_7 & ~Flag_visible
  j setflags

# -----------------------------------------------------------------------------
  Definition Flag_visible, "constant" # ( n -- )
# -----------------------------------------------------------------------------
  push x1
  call create
1:call literalkomma

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

  call setze_faltbarflag
  call smudge
  pop x1
  ret

# -----------------------------------------------------------------------------
  Definition Flag_visible, "2constant" # ( n -- )
# -----------------------------------------------------------------------------
  push x1
  call create
  swap
  call literalkomma
  j 1b
