Rem ****************************************************************************
Rem *                                                                          *
Rem * VPSUBRTA -- RT-Assembler and RT-Processor                                *
Rem * =========================================                                *
Rem *                                                                          *
Rem * (C) ROLF BÖHM BAD SCHANDAU 2001, 2002, 2003, 2006                        *
Rem *                                                                          *
Rem * The RT-Assembler translates RTA-Sourcefile into                          *
Rem *                                                                          *
Rem * - a Code Table          RTACode                                          *
Rem * - a Symbol table        RTASymTab                                        *
Rem * - a Program Name String RTAName                                          *
Rem *                                                                          *
Rem * There are two assembler passes:                                          *
Rem *                                                                          *
Rem * - Proprecessing (Preprocessor time)                                      *
Rem * - Assemblimg (in a narrow sense) (Assembler time)                        *
Rem *                                                                          *
Rem * After Assembling the RT-Processor can execute the RTA-Code.              *
Rem *                                                                          *
Rem * Its the third Pass, the Runtime.                                         *
Rem *                                                                          *
Rem ****************************************************************************

Rem CONSTANTS

Global Const RTA_MAX As Double = 9.999999999999E+99                           ' Maximum
Global Const RTA_MIN As Double = -9.999999999999E+99
Global Const RTA_EPSILON As Double = 1E-99                                    ' Minimum
Global Const RTA_NEG_EPSILON As Double = -1E-99
Global Const RTA_WEAK_EPSILON As Double = 0.000000000001                      ' Smallest Value>0
Global Const RTA_NEG_WEAK_EPSILON As Double = -0.000000000001

Rem Some other (MATH_PI, MATH_E etc.) were declarated in main program

Option Explicit

Rem Internal "Processor registers"

Dim tida As Double  ' 1. Source operand.
Dim uIda As Double  ' 2. Source operand.
Dim vIda As Double  ' 3. Source operand.
Dim aIda As Double  ' 1. Scratch operand.
Dim bida As Double  ' 2. Scratch operand.
Dim cIda As Double  ' 3. Scratch operand.
Dim wida As Double  ' Targed operand
Dim ppp As Long     ' Pointer to target operand

Rem
Rem T H E   R T - A S S E M B L E R
Rem ===============================

Public Sub SUBRTAAssembler(Text As String, FIXHead0 As FIXHeader, FIXHead1 As FIXHeader)
Rem
Rem The Retro-Assembler translates RTA-Sourcefiles into
Rem
Rem - a Code Table          RTACode
Rem - a Symbol table        RTASymTab
Rem - a Program Name String RTAName
Rem
Rem There are two assembler passes:
Rem
Rem - Proprecessing (Preprocessor time)
Rem - Assemblimg (in a narrow sense) (Assembler time)
Rem
Rem This RTAAssembler implementation needs a FIXLIB Fiximage Header (the FIXHeader)
Rem to generate some pre-defined variables.
Rem
Rem EXTERNAL GLOBALS:
Rem
'''Type CodeTyp                                    ' CodeTab structure defintion
'''  ' The Code table
'''  Instruction As String                         ' instruction mnemonic
'''  Sym1 As Long                                  ' 1. Operand
'''  Sym2 As Long                                  ' 2. Operand
'''  Sym3 As Long                                  ' 3. Operand
'''  ' Some aux variables
'''  Group As Integer                              ' causes a faster execution
'''  ExeCount As Double                            ' exec couter
'''  ErrCount As Double                            ' error counter
'''  ErrCode As Byte                               ' last error counter
'''End Type
'''
'''Type SymTyp                                     ' SymTab structure definition
'''  Name As String                                ' symbol name
'''  Valu As Double                                ' Symbol value. HERE ARE ALL SYMBOL VALUES
'''End Type
'''
'''Rem MAIN GLOBALS: SymTab, CodeTab, ProgName ...
'''
'''Public RTAName As String                        ' ProgName
'''Public RTACode() As CodeTyp                     ' CodeTab
'''Public RTASymTab() As SymTyp                    ' SymTab
'''
'''Rem ASSEMBLER VARIABLES
'''
'''Public RTAIsInProc As Boolean                   ' True: Assembler works
'''Public RTAProgFileName As String                ' Source file name
'''Public RTASavedText As String                   ' Last saved source file text
'''
'''Public RTAProgLines() As String                 ' source text in single lines
'''Public RTACodeLine() As String                  ' actual source line in single token
'''
'''Rem PROCESSOR VARIABLES
'''
'''Public RTAExitSignal As Boolean                 ' True: Exit after current instruction
'''Public RTAHaltSignal As Boolean                 ' True: Stop after current instruction
'''Public RTATestMode As Long                      ' The mode 0='WithoutStop', 1='ErrorStop', 2='StepByStep'. See the mode-instruction
'''Public RTAPrintText As String                   ' The output text area
'''Public RTALun As Integer                        ' A Logical Unit Number for System use
'''Public RTAInstructionText As String             ' Actual instruction protocol
'''Public RTAWasError As Boolean                   ' True: Was am error in last instruction
'''
'''Rem POINTER INTO SYMBOL TABLE TO ACCESS FROM PROJECTION ENGINE
'''
'''Public RTAAdrX As Long                          ' x
'''Public RTAAdrY As Long                          ' y
'''Public RTAAdrZ As Long                          ' z
'''Public RTAAdrX_ As Long                         ' x'
'''Public RTAAdrY_ As Long                         ' y'
'''Public RTAAdrZ_ As Long                         ' z'

Rem INTERNAL DEFINITIONES

Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double

Dim e As Integer
Dim f As Integer
Dim g As Integer

Dim i As Long
Dim j As Long
Dim k As Long
Dim p As Long
Dim q As Long
Dim r As Long

Dim sa() As String
Dim appendflag As Boolean

Dim dummy As Long

Dim s As String
Dim T As String
Dim t1 As String
Dim T2 As String
Dim t3 As String
Dim IsInString As Boolean

If VIMAGETest = False Then On Error GoTo m20202
GoTo m20203

m20202:
fixErrCode = 107
Call VIMAGEError("RTA: Laufzeitfehler im Assembler")
RTAIsInProc = False
Exit Sub

m20203:

Rem
Rem INIT
Rem ----

If RTAIsInProc = True Then
  Call MsgBox("Prozessorruf bei aktivem Prozessor. Assemblieren wird abgelehnt.", vbYesNoCancel, "Retro-Assembler")
Exit Sub
End If
RTAIsInProc = True

ReDim RTACode(0 To 0)
RTACode(0).instruction = "init"   ' Always the first instruction
RTACode(0).Sym1 = 0
RTACode(0).Sym2 = 0
RTACode(0).Sym3 = 0
RTACode(0).Group = "7"
RTACode(0).ErrCount = 0
RTACode(0).ErrCode = 0

ReDim RTASymTab(0 To 1)
RTASymTab(0).name = "."
RTASymTab(0).type = "P"
tida = 0
RTASymTab(0).Valu = tida

RTALun = FreeFile()
RTAName = "Anwenderprogramm"     ' Default program name

Rem
Rem PRE-PROCESSING PASS
Rem -------------------

Rem Split in lines

RTAProgLines = Split(Text, vbCrLf)

Rem First Preprocess

j = -1
ReDim sa(0 To 0)
appendflag = False
For i = 0 To UBound(RTAProgLines)
 s = RTAProgLines(i)
 ' Tabs --> Spaces
 s = Replace(s, vbTab, " ")
 ' Multiple Spaces --> Single Spaces
 For k = 1 To Len(s)
   s = Replace(s, "  ", " ")
 Next k
 ' Delete Leading/Trailing Spaces
 s = LTrim(RTrim(s))
 If s = "" Then GoTo label_next_i
 ' Delete the trailing "¶"
 T = s
 If Mid(s, Len(s), 1) = "¶" Then T = Mid(s, 1, Len(s) - 1)
 ' Append
 If appendflag = True Then
   sa(j) = sa(j) & T
 Else
   j = j + 1
   ReDim Preserve sa(0 To j)
   sa(j) = T
 End If
 ' Test to append
 If Mid(s, Len(s), 1) <> "¶" Then
   appendflag = False
 Else
   appendflag = True
 End If
label_next_i:
Next i

RTAProgLines = sa

Rem Second Preprocess

For i = 0 To UBound(RTAProgLines)
  ' Remove Comment
  p = InStr(1, RTAProgLines(i), ";")
  If p >= 1 Then
    RTAProgLines(i) = Left(RTAProgLines(i), p - 1)
  End If
  ' Split into Token
  If RTAProgLines(i) <> "" Then
  ' RTAProgLines(i) = RTAProgLines(i) & " . . ."
  ' Split first time into token
    RTACodeLine() = Split(RTAProgLines(i), " ")
  ' Convert an „label123:“ into „_lab label123“
    If Right(RTACodeLine(0), 1) = ":" Then
      k = Len(RTACodeLine(0))
      s = Left(RTACodeLine(0), k - 1)
      RTAProgLines(i) = "_lab " & s
    End If
  '  _config-instruction
    If RTACodeLine(0) = "_config" Then
  ' Here can be impelmented a Configuration Code. Always processed before any other (pseudo)instruction
    End If
  End If
Next i

Rem
Rem ASSEMBLER PASS
Rem --------------

Rem Compile RTAProgLines into RTACode and RTASymTab
Rem Errors into Error protocol RTAInstructionText

HF.Text2.Text = "RTA: Assemblerpass ..."
HF.Refresh
RTAInstructionText = ""
fixErrCode = 0

Rem Pre-defined variables into SymTab

Rem Enter the Instruction Pointer

ReDim Preserve RTASymTab(0 To 1)
RTASymTab(1).name = ".."
RTASymTab(1).Valu = 0
RTASymTab(1).type = "P"

Rem Enter Pre-defined Constants ...

Rem Math and Nature Constants

p = RTAEnterSym("pi", 0, "P")
RTASymTab(p).Valu = MATH_PI
p = RTAEnterSym("pi/2", 0, "P")
RTASymTab(p).Valu = MATH_PI / 2
p = RTAEnterSym("pi/4", 0, "P")
RTASymTab(p).Valu = MATH_PI / 4
p = RTAEnterSym("e", 0, "P")
RTASymTab(p).Valu = MATH_E
p = RTAEnterSym("®", 0, "P")
RTASymTab(p).Valu = EARthRadiusEquator
p = RTAEnterSym("®f", 0, "P")
RTASymTab(p).Valu = EARthFlattening           ' Flattening of the Earth: (a-b)/a
p = RTAEnterSym("°(", 0, "P")
RTASymTab(p).Valu = (MATH_PI / 180)
p = RTAEnterSym("(°", 0, "P")
RTASymTab(p).Valu = (180 / MATH_PI)
p = RTAEnterSym("eps", 0, "P")
RTASymTab(p).Valu = RTA_EPSILON
p = RTAEnterSym("max", 0, "P")
RTASymTab(p).Valu = RTA_MAX
p = RTAEnterSym("r0", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym("r1", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym("r2", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym("r3", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym("r4", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym("r5", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym("r6", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym("r7", 0, "P")
RTASymTab(p).Valu = 0
p = RTAEnterSym(" ", 0, "P")   ' Thats an 160 codes Space to a better readabel Symbol Table
RTASymTab(p).Valu = 0

Rem Enter Pre-defined Variables on Symbols and save their Addresses on Vimage Globals RTAAdrX ...

RTAAdrX = RTAEnterSym("x", 0, "P")
RTAAdrY = RTAEnterSym("y", 0, "P")
RTAAdrZ = RTAEnterSym("z", 0, "P")
RTAAdrX_ = RTAEnterSym("x'", 0, "P")
RTAAdrY_ = RTAEnterSym("y'", 0, "P")
RTAAdrZ_ = RTAEnterSym("z'", 0, "P")

Rem Earth Radius in Geo coord units in Source and Target image

Call FIXCoordGetParameters(FIXHead0, s)
Select Case s:
  Case "km": a = 1 / 1000
  Case "m": a = 1
  Case "cm": a = 100
  Case "mm": a = 1000
  Case "µ": a = 1000000
  Case "°": a = (1 / EARthNauticalMileInM) / 60
  Case Chr(34): a = 1000 / 25.4
  Case "E": a = 10000
  Case "F": a = 100000
  Case Else: a = 1
End Select
p = RTAEnterSym("Rx", 0, "P")
RTASymTab(p).Valu = EARthRadiusEquator * a    ' a = Pixel per m
p = RTAEnterSym("Ry", 0, "P")
RTASymTab(p).Valu = EARthRadiusEquator * a    ' b = Pixel per m
Call FIXCoordGetParameters(FIXHead1, s)
Select Case s:
  Case "km": a = 1 / 1000
  Case "m": a = 1
  Case "cm": a = 100
  Case "mm": a = 1000
  Case "µ": a = 1000000
  Case "°": a = (1 / FIX_NAUTICAL_MILE_IN_M) / 60
  Case Chr(34): a = 1000 / 25.4
  Case "E": a = 10000
  Case "F": a = 100000
  Case Else: a = 1
End Select
p = RTAEnterSym("Rx'", 0, "P")
RTASymTab(p).Valu = EARthRadiusEquator * a    ' a = Pixel per m
p = RTAEnterSym("Ry'", 0, "P")
RTASymTab(p).Valu = EARthRadiusEquator * a    ' b = Pixel per m

Rem Image Center Geo coords in Source and Target image

p = RTAEnterSym("Cx", 0, "P")
RTASymTab(p).Valu = CDbl((FIXHead0.GeoNEPX + FIXHead0.GeoSWPX) / 2)
p = RTAEnterSym("Cy", 0, "P")
RTASymTab(p).Valu = CDbl((FIXHead0.GeoNEPY + FIXHead0.GeoSWPY) / 2)
p = RTAEnterSym("Cx'", 0, "P")
RTASymTab(p).Valu = CDbl((FIXHead1.GeoNEPX + FIXHead1.GeoSWPX) / 2)
p = RTAEnterSym("Cy'", 0, "P")
RTASymTab(p).Valu = CDbl((FIXHead1.GeoNEPY + FIXHead1.GeoSWPY) / 2)
p = RTAEnterSym("  ", 0, "P")   ' Two 160 codes Spaces to a better readable Symbol table
RTASymTab(p).Valu = 0
Rem Assembler pass

Rem i pointed into the line in the Source Code RTAProgLines,
Rem j pointed into the Code tablein RTACode

j = 1
For i = 0 To UBound(RTAProgLines)
  If RTAProgLines(i) <> "" Then
    '' Create a work exit instruction (if there is no code in the Program)
    ReDim Preserve RTACode(0 To j)
    RTACode(j).instruction = ""
    RTACode(j).Sym1 = 0
    RTACode(j).Sym2 = 0
    RTACode(j).Sym3 = 0
    RTACode(j).Group = 0 'RTACompile("exit")
    RTACode(j).ExeCount = 0
    RTACode(j).ErrCount = 0
    RTACode(j).ErrCode = 0
    ' Second split: line into Token
    RTACodeLine() = Split(RTAProgLines(i), " ")
    ReDim Preserve RTACodeLine(0 To 3)             ' shorter lines with empty token
    ' (pseudo) instruction interpretation
    fixErrCode = 0
    Select Case LCase(RTACodeLine(0))
    ' PSEUDO INSTR INTERPRETATION
    Case "_dim":
      dummy = RTAEnterSym(RTACodeLine(1), CLng(val((RTACodeLine(2)))), "A")
      If fixErrCode <> 0 Then
        Call SUBRTAAssemblerEnterError(i, "")
      End If
      fixErrCode = 0
    Case "_var":
      dummy = RTAEnterSym(RTACodeLine(1), 0, "")
    Case "_lab":
      p = RTAEnterSym(RTACodeLine(1), 0, "")
      RTASymTab(p).Valu = Int(j)
    Case "_name":
      RTAName = RTACodeLine(1)
      RTAName = Replace(RTAName, "~", " ")
      RTAName = Replace(RTAName, "\", " - ")           ' Leerzeichen Minus Leerzeichen statt CrLf
    Case "_config":
    Case "_end":
      
    ' COMPILE THE OTHER INSTRUCTIONS
    
    Case Else:
      q = RTACompile(RTACodeLine(0))
      If q <> -9999 Then
        ' 1. Token = instruction mnemonic
        If RTACodeLine(0) = "end" Then RTACodeLine(0) = "nop"    ' in the first language version was an end-instruction. Its now the pseudo instruction _end
        RTACode(j).instruction = LCase(RTACodeLine(0))
        ' Enter the 3 symbols in SymTab
        RTACode(j).Sym1 = RTAEnterSym(RTACodeLine(1), 0, "")
        If fixErrCode <> 0 Then Call SUBRTAAssemblerEnterError(i, "")
        RTACode(j).Sym2 = RTAEnterSym(RTACodeLine(2), 0, "")
        If fixErrCode <> 0 Then Call SUBRTAAssemblerEnterError(i, "")
        RTACode(j).Sym3 = RTAEnterSym(RTACodeLine(3), 0, "")
        If fixErrCode <> 0 Then Call SUBRTAAssemblerEnterError(i, "")
        ' The Group reduces the decicions by proc
        RTACode(j).Group = q
        ' Runtime statistics and protocol variables
        RTACode(j).ExeCount = 0
        RTACode(j).ErrCount = 0
        RTACode(j).ErrCode = 0
        j = j + 1
      Else
        fixErrCode = 116
        Call SUBRTAAssemblerEnterError(i, RTACodeLine(0))
      End If
    End Select
    If fixErrCode <> 0 Then GoTo M232425
  End If
Next i

Rem
Rem LAST INSTRUCTION
Rem

'ReDim Preserve RTACode(0 To j)
'RTACode(j).instruction = "nop"
'RTACode(j).Group = RTACompile("nop")
'RTACode(j).Sym1 = 0
'RTACode(j).Sym2 = 0
'RTACode(j).Sym3 = 0

Rem
Rem On error error message output
Rem
    
If RTAInstructionText <> "" Then
  Unload VFSHOTXT
  VFSHORTD.Caption = "Assemblerfehler"       ' VFSHORTD is the debugger formular
  VFSHORTD.Text1 = RTAInstructionText
  VFSHORTD.Show vbModal
  If fixAbortFlag = True Then        ' On abort exit
    fixAbortFlag = False
    fixErrCode = 90                  ' Thats the exit code
  End If
End If
    
M232425:
Rem error code execution (old code??)
If fixErrCode <> 0 Then
  If fixErrCode <> 90 Then
    Call VIMAGEError("Laufzeitfehler beim Assemblieren")  ' Dürfte, da EnterError den Fehlercode löscht eigentlich nicht passieren
  End If
  HF.Text2.Text = "Assembler abgebrochen"
  fixErrCode = 90
  RTAIsInProc = False
  Exit Sub
End If

Rem
Rem OPERATION PASS
Rem --------------

Rem init of visual basic randomizator
                   
Rnd (-1)
Randomize (-0.5)

Rem
Rem ASSEMBLER EXIT
Rem --------------

rtaexit:
If fixErrCode = 90 Then
  HF.Text2.Text = "Programm abgebrochen"
End If
RTAIsInProc = False
Exit Sub
End Sub

Rem SMALL PROGRAM: ENTERS AN ERROR MESSAGE INTO THE ERROR PROTOCOL

Private Sub SUBRTAAssemblerEnterError(i As Long, s As String)
Dim T As String
Dim u As String
Dim v As String
  Call FIXDescErrText(fixErrCode, u)
  v = Left(RTAProgLines(i) & "                                ", 32)
  If s <> "" Then
    T = "Zeile " & Format(i + 1, "0000") & ": " & v & " Fehlercode " & fixErrCode & " (" & u & " " & s & ")" & vbCrLf
  Else
    T = "Zeile " & Format(i + 1, "0000") & ": " & v & " Fehlercode " & fixErrCode & " (" & u & ")" & vbCrLf
  End If
  RTAInstructionText = RTAInstructionText & T
  fixErrCode = 0
End Sub

Rem ***************************************************************************

Rem
Rem T H E   R T - P R O C E S S O R
Rem ===============================

Public Sub SUBRTAProcessor()
Rem
Rem The Code of the third or Process pass or Operation pass
Rem
Rem It is the virtual RTA-machine.
Rem
Rem On start must be the
Rem
Rem           CodeTab  RTACode
Rem   and the SymTab   RTASymTab
Rem   ant the ProgName RTAProgName
Rem
Rem filled form the Retro-Assembler (RTA).

Rem k ... an all instruction counter
Rem i ... actual instruction pointer
Rem j ... next instruction pointer

Rem DECLARATIONS

Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double

Dim e As Integer
Dim i As Long
Dim j As Long
Dim k As Long

Dim o As Long  ' oder Double??
Dim p As Long
Dim q As Long
Dim r As Long

Dim s As String
Dim T As String

Dim IsIntegerExponent As Boolean
Dim IsNegativExponent As Boolean

If RTAIsInProc = True Then
  If MsgBox("Prozessorruf bei aktivem Prozessor. Abbruchsignal setzen?", vbYesNoCancel, "RTA: Prozessor") = vbYes Then
    fixAbortFlag = True   ' No Processor Run is Assembler does work
    fixErrCode = 90       ' Exit!
  End If
  Exit Sub
End If
RTAIsInProc = True
Dim ProtocolIsShown As Boolean

On Error GoTo mÜbelauf55
GoTo m55

mÜbelauf55:
  fixErrCode = 88
  Resume Next
m55:

If RTATestMode < 0 Then RTATestMode = 0
If RTATestMode > 2 Then RTATestMode = 2
'HF.Text2.Text = ""

i = 0
k = 0
j = -1

Rem T H E   L A R G E   I N S T R U C T I O N   L O O P

RTAInstructionLoop:

k = k + 1
RTASymTab(0).Valu = 0              ' Clears the Empty Sumbol (».«) after write accesses.
RTAExitSignal = False
RTASymTab(1).Valu = i                     ' On Address 1: Always the Instruction Pointer ".."
tida = RTASymTab(RTACode(i).Sym1).Valu    ' Get the source operandes from SymTab
uIda = RTASymTab(RTACode(i).Sym2).Valu
vIda = RTASymTab(RTACode(i).Sym3).Valu
ppp = 0                                   ' target pointer pointes into EmptySymbol
If RTACode(i).instruction <> "errcode" And RTACode(i).instruction <> "errjump" Then fixErrCode = 0

If fixAbortFlag = False Then

Rem THE INSTRUCTION LIST

Rem
Rem 0. AT FIRST: EXPRESS INSTRUCTION (NEGATIVE GROUP NUMBER):
Rem ---------------------------------------------------------

Rem Not only one instruction decicion -- faster are 2 levels: the group and then the instruction ...

If RTACode(i).Group < 0 Then
  Select Case RTACode(i).Group
  Case -1:
    Select Case RTACode(i).instruction

    Case "mov":
      RTASymTab(RTACode(i).Sym1).Valu = uIda
      j = i + 1

    Case "clr":
      RTASymTab(RTACode(i).Sym1).Valu = 0
      j = i + 1

    Case "jump":
    j = Int(RTASymTab(RTACode(i).Sym1).Valu)

    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select

  Case -2:
    Select Case RTACode(i).instruction

    Case "add":
      RTASymTab(RTACode(i).Sym1).Valu = tida + uIda
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "sub":
      RTASymTab(RTACode(i).Sym1).Valu = tida - uIda
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "mul":
      If Abs(tida) > RTA_MAX Or Abs(uIda) > RTA_MAX Then
        RTASymTab(RTACode(i).Sym1).Valu = Sgn(tida) * Sgn(uIda) * RTA_MAX
        ppp = RTACode(i).Sym1
        fixErrCode = 101
      Else
        RTASymTab(RTACode(i).Sym1).Valu = tida * uIda
        ppp = RTACode(i).Sym1
      End If
      j = i + 1

    Case "div":
      If uIda = 0 Then
        RTASymTab(RTACode(i).Sym1).Valu = Sgn(tida) * RTA_EPSILON
        ppp = RTACode(i).Sym1
      fixErrCode = 102
      Else
        RTASymTab(RTACode(i).Sym1).Valu = tida / uIda
        ppp = RTACode(i).Sym1
      End If
      j = i + 1

    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select

  Case -3:
    Select Case RTACode(i).instruction

    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select

  Case -4
    Select Case RTACode(i).instruction

    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select
  End Select
Else
  
Rem
Rem 1. SIMPLE INSTRUCTIONS
Rem ----------------------

  Select Case RTACode(i).Group

  Case 1:
    Select Case RTACode(i).instruction
    
' more fast as express instructions ...

'  Case "mov":
'    RTASymTab(RTACode(i).Sym1).Valu = uida
'    j = i + 1

'  Case "clr":
'    RTASymTab(RTACode(i).Sym1).Valu = 0
'    j = i + 1
'

    Case "neg":
      RTASymTab(RTACode(i).Sym1).Valu = 0 - tida
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "abs":
      RTASymTab(RTACode(i).Sym1).Valu = Abs(tida)
      j = i + 1
       
Rem
Rem 2. ELEMENTARY OPERATIONS
Rem ------------------------

 ' more fast as express instructions ...

 '  Case "add":
 '    RTASymTab(RTACode(i).Sym1).Valu = tida + uida
 '    j = i + 1
 '
 '  Case "sub":
 '    RTASymTab(RTACode(i).Sym1).Valu = tida - uida
 '    j = i + 1
 '
 '  Case "mul":
 '    RTASymTab(RTACode(i).Sym1).Valu = tida * uida
 '    j = i + 1
 '
 '  Case "div":
 '    If uida = 0 Then uida = RTA_EPSILON
 '    RTASymTab(RTACode(i).Sym1).Valu = tida / uida
 '    j = i + 1

    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select

Rem
Rem 3. POWER AND ROOT
Rem -----------------

  Case 2:
    Select Case RTACode(i).instruction
    
    Case "power":
      aIda = tida
      bida = uIda
      ' exponent < 0
      IsNegativExponent = False
      If bida < 0 Then
        IsNegativExponent = True
      End If
      ' exponent integer?
      IsIntegerExponent = False
      If bida = Int(bida) Then
        IsIntegerExponent = True
      End If
      ' 0 power 0
      If aIda = 0 And bida = 0 Then
        aIda = 1
        fixErrCode = 103
      End If
      ' rational power and exponent < 0: forbidden
      If IsIntegerExponent = False Then
        If aIda < 0 Then
          aIda = Abs(aIda)
          fixErrCode = 104
        End If
      End If
      ' overflow
      If Log(Abs(aIda) + 0.00000000001) * Abs(bida) > 700 Then      ' 700 digits on base e are ca. 300 decimal digits
        fixErrCode = 101
        wida = RTA_MAX
      Else
        wida = Abs(aIda ^ Abs(bida))         ' Thers a sign error in VB runtime
      End If
      ' take the value
      If IsIntegerExponent = True Then
        If bida <> ((bida \ 2) * 2) And aIda < 0 Then
          wida = 0 - wida
        Else
          wida = wida
        End If
      Else
        wida = wida
      End If
      ' negative exponent: reciproc value
      If IsNegativExponent = True Then
        If wida <> 0 Then wida = 1 / wida
      End If
      RTASymTab(RTACode(i).Sym1).Valu = wida
m_power_continue:
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "root"
      aIda = Abs(tida)
      bida = uIda
      ' zero-th root
      If bida = 0 Then
          ' zero-th root
          fixErrCode = 106
          RTASymTab(RTACode(i).Sym1).Valu = RTA_MAX * Sgn(tida)
          GoTo m_root_continue
      End If
      If aIda = 0 Then
          ' zero-th root
          
          RTASymTab(RTACode(i).Sym1).Valu = 0
          GoTo m_root_continue
      End If
      ' non-zero exponent
      If tida >= 0 Or _
         ((tida < 0) And (bida = Fix(bida)) And ((Fix(bida) \ 2) <> (Fix(bida) / 2))) Then
        bida = (1 / bida)
        ' positive radicant or nagative radicant and odd-integer exponent (3-th root of -1000 is -10)
        If (Log(aIda)) * bida > 300 Then
          ' root exist but overflow
          RTASymTab(RTACode(i).Sym1).Valu = RTA_MAX * Sgn(tida)
          fixErrCode = 101 ' overflow
        Else
          ' compute the root. Give it the sign from (possible negative) radicant
          RTASymTab(RTACode(i).Sym1).Valu = (aIda ^ bida) * Sgn(tida)
        End If
      Else
        ' negative radicant and rational or even-integer exponent
        RTASymTab(RTACode(i).Sym1).Valu = 0
        fixErrCode = 105
      End If
m_root_continue:
      ppp = RTACode(i).Sym1 ' set the pointer to result
      j = i + 1

Rem
Rem 4. LOG- AND EXP-RUNCTIONS
Rem -------------------------

    Case "exp":
      aIda = tida
      If aIda > 700 Then         ' 700 e-digits are 300 10-based digits
        fixErrCode = 101
        RTASymTab(RTACode(i).Sym1).Valu = RTA_MAX
        ppp = RTACode(i).Sym1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = MATH_E ^ aIda
        ppp = RTACode(i).Sym1
      End If
      j = i + 1
      
    Case "exp10":
      aIda = tida
      If aIda > 300 Then         ' 300 digits
        fixErrCode = 101
        RTASymTab(RTACode(i).Sym1).Valu = RTA_MAX
        ppp = RTACode(i).Sym1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = 10 ^ aIda
        ppp = RTACode(i).Sym1
      End If
      j = i + 1
        
    Case "exp2":
      aIda = tida
      If aIda > 900 Then         ' 900 2-based digits are 300 10-based digits
        fixErrCode = 101
        RTASymTab(RTACode(i).Sym1).Valu = RTA_MAX
        ppp = RTACode(i).Sym1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = 2 ^ aIda
        ppp = RTACode(i).Sym1
      End If
      j = i + 1
        
    Case "expx":
      aIda = tida
      bida = uIda
      Select Case bida
      Case Is < 0:
        fixErrCode = 104
        RTASymTab(RTACode(i).Sym1).Valu = 0
        ppp = RTACode(i).Sym1
      Case 0:
        If aIda <> 0 Then
          RTASymTab(RTACode(i).Sym1).Valu = 0
          ppp = RTACode(i).Sym1
        Else
          fixErrCode = 103
          RTASymTab(RTACode(i).Sym1).Valu = 0
          ppp = RTACode(i).Sym1
        End If
      Case 1:
        RTASymTab(RTACode(i).Sym1).Valu = aIda
        ppp = RTACode(i).Sym1
      Case Else:
        If Log(Abs(bida)) * aIda > 700 Then        ' 700 e-based digits ...
          fixErrCode = 101
          RTASymTab(RTACode(i).Sym1).Valu = RTA_MAX
          ppp = RTACode(i).Sym1
        Else
          RTASymTab(RTACode(i).Sym1).Valu = bida ^ aIda
          ppp = RTACode(i).Sym1
        End If
      End Select
      j = i + 1
              
    Case "log"
      aIda = tida
      If aIda <= 0 Then
        If aIda < 0 Then
          fixErrCode = 107
        Else
          fixErrCode = 108
        End If
        RTASymTab(RTACode(i).Sym1).Valu = RTA_MIN
        ppp = RTACode(i).Sym1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = Log(aIda)
        ppp = RTACode(i).Sym1
      End If
      j = i + 1
      
    Case "log10"
      aIda = tida
      If aIda <= 0 Then
        If aIda < 0 Then
          fixErrCode = 107
        Else
          fixErrCode = 108
        End If
        RTASymTab(RTACode(i).Sym1).Valu = RTA_MIN
        ppp = RTACode(i).Sym1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = Log(aIda) / Log(10)
        ppp = RTACode(i).Sym1
      End If
      j = i + 1
      
    Case "log2"
      aIda = tida
      If aIda <= 0 Then
        If aIda < 0 Then
          fixErrCode = 107
        Else
          fixErrCode = 108
        End If
        RTASymTab(RTACode(i).Sym1).Valu = RTA_MIN
        ppp = RTACode(i).Sym1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = Log(aIda) / Log(2)
        ppp = RTACode(i).Sym1
      End If
      j = i + 1
  
    Case "logx"
      aIda = tida
      bida = uIda
      Select Case bida
      Case Is < 0:
        fixErrCode = 109
        RTASymTab(RTACode(i).Sym1).Valu = 0
        ppp = RTACode(i).Sym1
      Case 0:
        fixErrCode = 110
        RTASymTab(RTACode(i).Sym1).Valu = 0
        ppp = RTACode(i).Sym1
      Case 1:
        fixErrCode = 111
        RTASymTab(RTACode(i).Sym1).Valu = RTA_MAX
        ppp = RTACode(i).Sym1
      Case Else:
        If aIda <= 0 Then
          If aIda < 0 Then
            fixErrCode = 107
          Else
            fixErrCode = 108
          End If
          RTASymTab(RTACode(i).Sym1).Valu = RTA_MIN
          ppp = RTACode(i).Sym1
        Else
          RTASymTab(RTACode(i).Sym1).Valu = Log(aIda) / Log(bida)
          ppp = RTACode(i).Sym1
      End If
      End Select
      j = i + 1
      
Rem
Rem 5. TRIG and ARC FUNCTIONS
Rem -------------------------

    Case "sin":
      aIda = tida
      If Abs(aIda) > 1E+18 Then
        aIda = 0 ' there is on >1e19 is an VB runtime overflow
        fixErrCode = 101
      End If
      RTASymTab(RTACode(i).Sym1).Valu = Sin(aIda)
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "cos":
      aIda = tida
      If Abs(aIda) > 1E+18 Then
        aIda = 0 ' there is on >1e19 is an VB runtime overflow
        fixErrCode = 101
      End If
      RTASymTab(RTACode(i).Sym1).Valu = Cos(aIda)
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "tan":
      aIda = tida
      If Abs(aIda) > 1E+18 Then
        aIda = 0 ' there is on >1e19 is an VB runtime overflow
        fixErrCode = 101
      End If
      RTASymTab(RTACode(i).Sym1).Valu = Tan(aIda)
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "cot":
      aIda = tida
      If Abs(aIda) > 1E+18 Then
        aIda = 0 ' there is on >1e19 is an VB runtime overflow
        fixErrCode = 101
      End If
      If aIda = 0 Then
        aIda = RTA_EPSILON
        fixErrCode = 112
      End If
      wida = 1 / Tan(aIda)
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "sec":
      aIda = tida
      If Abs(aIda) > 1E+18 Then
        aIda = 0 ' there is on >1e19 an VB runtime overflow
        fixErrCode = 101
      End If
      If aIda = 0 Then aIda = RTA_EPSILON
      wida = 1 / Cos(aIda)
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "csc":
      aIda = tida
      If Abs(aIda) > 1E+18 Then
        aIda = 0 ' there is on >1e19 is an VB runtime overflow
        fixErrCode = 101
      End If
      If aIda = 0 Then aIda = RTA_EPSILON
      wida = 1 / Sin(aIda)
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "asin":
      aIda = tida
      If aIda >= 1 Then
        If aIda < 1.0000000000001 Then
          aIda = 1 - RTA_WEAK_EPSILON
        Else
          aIda = 1 - RTA_WEAK_EPSILON
          fixErrCode = 112
        End If
      End If
      If aIda <= -1 Then
        If aIda > -1.0000000000001 Then
          aIda = -1 + RTA_WEAK_EPSILON
        Else
          aIda = -1 + RTA_WEAK_EPSILON
          fixErrCode = 112
        End If
      End If
      wida = Atn(aIda / Sqr(1 - aIda ^ 2))
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "acos":
      aIda = tida
      If aIda >= 1 Then
        If aIda < 1.0000000000001 Then   ' Ja, das ist eine Reaktion auf einen tatsächlich beocbachteteten Effekt beim Winkelschen-Entwurf im Meridian
          aIda = 1 - RTA_WEAK_EPSILON
        Else
          aIda = 1 - RTA_WEAK_EPSILON
          fixErrCode = 112
        End If
      End If
      If aIda <= -1 Then
        If aIda > -1.0000000000001 Then   ' Ja, das ist eine Reaktion auf einen tatsächlich beocbachteteten Effekt beim Winkelschen-Entwurf im Meridian
          aIda = -1 + RTA_WEAK_EPSILON
        Else
          aIda = -1 + RTA_WEAK_EPSILON
          fixErrCode = 112
        End If
      End If
      wida = MATH_PI_2 - Atn(aIda / Sqr(1 - aIda ^ 2))
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "atan":
      aIda = tida
      RTASymTab(RTACode(i).Sym1).Valu = Atn(aIda)
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "acot":
      aIda = tida
      If tida = 0 Then
        tida = RTA_EPSILON
        fixErrCode = 112
      Else
        wida = Atn(1 / tida)
      End If
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "asec":
      aIda = tida
      If aIda > 1 Or aIda < -1 Then
        aIda = 1 / aIda
        wida = MATH_PI_2 - Atn(aIda / Sqr(1 - aIda ^ 2))
      Else
        Select Case aIda
        Case 1:
          wida = 0
        Case -1:
          wida = MATH_PI
        Case Else:
          wida = 0
          fixErrCode = 112
        End Select
      End If
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "acsc":
      aIda = tida
      If aIda > 1 Or aIda < -1 Then
        aIda = 1 / tida
        wida = Atn(aIda / Sqr(1 - aIda ^ 2))
      Else
        Select Case aIda
        Case 1:
          wida = MATH_PI / 2
        Case -1:
          wida = 0 - MATH_PI / 2
        Case Else:
          wida = 0
          fixErrCode = 112
        End Select
      End If
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
      
Rem
Rem 6. HYPERBOLIC AND AREA FUNCTIONS
Rem --------------------------------
    
    Case "sinh":
      If Abs(tida) <= 225 Then    ' overflow > 225
        aIda = (Exp(tida))
        aIda = aIda - Exp(0 - tida)
        aIda = aIda / 2
      Else
        aIda = Sgn(tida) * RTA_MAX
        fixErrCode = 101
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "cosh":
      If Abs(tida) <= 225 Then
        aIda = (Exp(tida) + Exp(0 - tida)) / 2
      Else
        aIda = RTA_MAX
        fixErrCode = 101
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "tanh":
      If Abs(tida) <= 700 Then        ' if overflow ...
        aIda = Exp(tida)
        aIda = aIda - Exp(0 - tida)
        aIda = aIda / (Exp(tida) + Exp(0 - tida))
      Else                           ' ... result is 1
        aIda = Sgn(tida) * 1
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "coth":
      If Abs(tida) <= 700 Then
        If (Exp(tida) - Exp(0 - tida)) <> 0 Then
          aIda = (Exp(tida) + Exp(0 - tida)) / (Exp(tida) - Exp(0 - tida))
        Else
          aIda = RTA_MAX
          fixErrCode = 112
        End If
      Else
        aIda = Sgn(tida) * 1
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "sech":
      If Abs(tida) <= 700 Then
        If (Exp(tida) + Exp(0 - tida)) <> 0 Then
          aIda = 2 / (Exp(tida) + Exp(0 - tida))
        Else
          aIda = 0
        End If
      Else
        aIda = 0
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "csch":
      If Abs(tida) <= 700 Then
        If (Exp(tida) - Exp(0 - tida)) <> 0 Then
          aIda = 2 / (Exp(tida) - Exp(0 - tida))
        Else
          aIda = RTA_MAX
          fixErrCode = 112 ' n. def.
        End If
      Else
        aIda = 0
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "asinh":
      If tida >= 0 Then
        aIda = Log(tida + Sqr(1 + tida ^ 2))
      Else
        aIda = 0 - tida    ' negate
        aIda = Log(aIda + Sqr(1 + aIda ^ 2))
        aIda = 0 - aIda    ' negate
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "acosh":
      If tida >= 1 Then
        aIda = Log((tida) + (Sqr(tida - 1)) * (Sqr(tida + 1)))
      Else                       ' No acosh < 1
        aIda = RTA_MAX
        fixErrCode = 112
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "atanh":
      If Abs(tida) < 1 Then
        aIda = 0.5 * (Log(1 + tida) - Log(1 - tida))
      Else                 ' No atanh is abs > 1 ...
        aIda = RTA_MAX
        fixErrCode = 112
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "acoth":
      If Abs(tida) > 1 Then
        aIda = 1 / tida
        aIda = 0.5 * (Log(1 + aIda) - Log(1 - aIda))
      Else
        aIda = RTA_MAX
        fixErrCode = 112
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "asech":
      If tida > 0 Then
        Select Case tida
        Case Is < 1:
          aIda = 1 / tida
          aIda = Log(Sqr(aIda - 1) * Sqr(aIda + 1) + aIda)
        Case 1:
          aIda = 0
        Case Is > 1:
          aIda = 0
          fixErrCode = 112
        End Select
      Else
        aIda = RTA_MAX
        fixErrCode = 112
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "acsch":
      If tida <> 0 Then
        aIda = 1 / tida
        aIda = Log((Sqr(1 + (aIda ^ 2))) + aIda)
      Else
        aIda = RTA_MAX
        fixErrCode = 112
      End If
      RTASymTab(RTACode(i).Sym1).Valu = aIda
      ppp = RTACode(i).Sym1
      j = i + 1
      
Rem
Rem 7. LOGICAL INSTRUCTIONS
Rem -----------------------
      
    Case "bin":
      If tida = 0 Then
        RTASymTab(RTACode(i).Sym1).Valu = 0
      Else
        RTASymTab(RTACode(i).Sym1).Valu = 1
      End If
      ppp = RTACode(i).Sym1
      j = i + 1
   
    Case "not":
      If tida = 0 Then
        RTASymTab(RTACode(i).Sym1).Valu = 1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = 0
      End If
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "and":
      If tida <> 0 And uIda <> 0 Then
        RTASymTab(RTACode(i).Sym1).Valu = 1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = 0
      End If
      ppp = RTACode(i).Sym1
      j = i + 1
      
      
    Case "or":
      If tida <> 0 Or uIda <> 0 Then
        RTASymTab(RTACode(i).Sym1).Valu = 1
      Else
        RTASymTab(RTACode(i).Sym1).Valu = 0
      End If
      ppp = RTACode(i).Sym1
      j = i + 1
    
Rem
Rem 8. OTHER MATH INSTRUCTIONS
Rem --------------------------
      

    Case "inc":
      RTASymTab(RTACode(i).Sym1).Valu = tida + 1
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "dec":
      RTASymTab(RTACode(i).Sym1).Valu = tida - 1
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "sgn":
      RTASymTab(RTACode(i).Sym1).Valu = Sgn(tida)
      j = i + 1

    Case "round":
      RTASymTab(RTACode(i).Sym1).Valu = Round(tida)
      j = i + 1
   
    Case "ceil":
      RTASymTab(RTACode(i).Sym1).Valu = Int(tida + 1)
      j = i + 1
      
    Case "floor":
      RTASymTab(RTACode(i).Sym1).Valu = Int(tida)
      j = i + 1
      
    Case "fix":
      RTASymTab(RTACode(i).Sym1).Valu = Fix(tida)
      j = i + 1

    Case "frac":
    RTASymTab(RTACode(i).Sym1).Valu = Abs(tida) - Abs(Fix(tida))
      j = i + 1

    Case "clip":
      wida = tida
      ' if Minimum > Maximum change them
      If uIda > vIda Then
        aIda = uIda
        uIda = vIda
        vIda = aIda
      End If
      ' clip low
      If tida < uIda Then
        wida = uIda
      End If
      ' clip high
      If tida > vIda Then
        wida = vIda
      End If
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
    
    Case "cmod":        ' clip modulo
      ' if Minimum > Maximum change them
      If uIda > vIda Then
        aIda = uIda
        uIda = vIda
        vIda = aIda
      End If
      If uIda <> vIda Then
      ' Laden
        aIda = tida - uIda   ' Argument zerobased
        bida = vIda - uIda   ' Area zerobased
        cIda = aIda / bida   ' Quotient
        cIda = Int(cIda)     ' fix Quotient
        wida = aIda - (cIda * bida) ' Modulo = value - procukt
        wida = wida + uIda   ' add zerobase
      Else
        wida = 0
        fixErrCode = 102
      End If
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1
      
    Case "random"
      a = Rnd()
      b = Rnd() / 10000#
      c = Rnd() / 100000000#
      d = Rnd() / 10000000000000#
      RTASymTab(RTACode(i).Sym1).Valu = a + b + c + d
      ppp = RTACode(i).Sym1
      j = i + 1
    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select
   

Rem
Rem 9. BRANCH INSTRUCTIONS
Rem -----------------------

Rem COMPARE INSTRUCTIONS

  Case 3:
    
    Select Case RTACode(i).instruction
    Case "cmpgt":
      If tida > uIda Then j = Int(RTASymTab(RTACode(i).Sym3).Valu) Else j = i + 1
    Case "cmpge":
      If tida >= uIda Then j = Int(RTASymTab(RTACode(i).Sym3).Valu) Else j = i + 1
    Case "cmplt":
      If tida < uIda Then j = Int(RTASymTab(RTACode(i).Sym3).Valu) Else j = i + 1
    Case "cmple":
      If tida <= uIda Then j = Int(RTASymTab(RTACode(i).Sym3).Valu) Else j = i + 1
    Case "cmpeq":
      If tida = uIda Then j = Int(RTASymTab(RTACode(i).Sym3).Valu) Else j = i + 1
    Case "cmpne":
      If tida <> uIda Then j = Int(RTASymTab(RTACode(i).Sym3).Valu) Else j = i + 1
    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select
    
Rem TEST INSTRUCTIONS

  Case 4:
    Select Case RTACode(i).instruction

    Case "tstgt":
      If tida > 0 Then j = Int(RTASymTab(RTACode(i).Sym2).Valu) Else j = i + 1
    Case "tstge":
      If tida >= 0 Then j = Int(RTASymTab(RTACode(i).Sym2).Valu) Else j = i + 1
    Case "tstlt":
      If tida < 0 Then j = Int(RTASymTab(RTACode(i).Sym2).Valu) Else j = i + 1
    Case "tstle":
      If tida <= 0 Then j = Int(RTASymTab(RTACode(i).Sym2).Valu) Else j = i + 1
    Case "tsteq":
      If tida = 0 Then j = Int(RTASymTab(RTACode(i).Sym2).Valu) Else j = i + 1
    Case "tstne":
      If tida <> 0 Then j = Int(RTASymTab(RTACode(i).Sym2).Valu) Else j = i + 1

Rem JUMP ... is an express instruction

 '  Case "jump":         ' Der unbedingte Sprung
 '    j = Int(RTASymTab(RTACode(i).Sym1).Valu)
 '

  Case Else:
      fixErrCode = 116   ' unknown
      j = i + 1
  End Select
    
Rem
Rem 10. IO INSTRUCTIONS
Rem -------------------

Rem DIALOG-IO

  Case 6:
    Select Case RTACode(i).instruction
    
    Case "input"
      s = RTASymTab(RTACode(i).Sym2).name
      If RTACode(i).Sym2 = 0 Then s = ""          ' Empty string is not „.“, it is„“
      s = Replace(s, "~", " ")
      s = Replace(s, "\", vbCrLf)
      HF.Text2.Text = RTAName & ": input-Befehl ..."
      HF.Text2.Refresh
      Call VFDIARTA.RTADialog(i, RTAName, "input", s, RTASymTab(RTACode(i).Sym1).name, tida)
      
      If fixErrCode = 0 Then
        wida = tida
        RTASymTab(RTACode(i).Sym1).Valu = wida
        ppp = RTACode(i).Sym1
        j = i + 1
      End If
      HF.Text2.Text = ""

    Case "output"
      s = RTASymTab(RTACode(i).Sym2).name
      If RTACode(i).Sym2 = 0 Then s = ""          ' Empty string is not „.“, it is„“
      s = Replace(s, "~", " ")
      s = Replace(s, "\", vbCrLf)
      HF.Text2.Text = RTAName & ": output-Befehl ..."
      HF.Text2.Refresh
      Call VFDIARTA.RTADialog(i, RTAName, "output", s, RTASymTab(RTACode(i).Sym1).name, tida)
      ' s = s & vbCrLf & vbCrLf
      ' s = s & RTASymTab(RTACode(i).Sym1).name & " = " & Replace(Format(tida), ",", ".")
      If fixErrCode = 0 Then 'rtaexitfla' MsgBox(s, vbOKCancel, "RTA: " & RTAName) = vbOK Then
        j = i + 1
      End If
      HF.Text2.Text = ""

    Case "pause"
      s = RTASymTab(RTACode(i).Sym1).name
      If RTACode(i).Sym1 = 0 Then s = ""          ' Empty string is not „.“, it is„“
      s = Replace(s, "~", " ")
      s = Replace(s, "\", vbCrLf)
      HF.Text2.Text = RTAName & ": pause-Befehl ..."
      HF.Text2.Refresh
      
      Call VFDIARTA.RTADialog(i, RTAName, "pause", s, "", 0)
      
      If fixErrCode = 0 Then
        j = i + 1
      End If
      HF.Text2.Text = ""

    Case "proof"
      T = RTASymTab(RTACode(i).Sym2).name & " "
      If RTACode(i).Sym2 = 0 Then T = ""          ' Empty string is not „.“, it is„“
      T = Replace(T, "~", " ")
      T = Replace(T, "\", " / ")
      T = T & RTASymTab(RTACode(i).Sym1).name & " = " & tida
      HF.Text1.Text = T
      HF.Text1.Refresh
      j = i + 1

    Case "info":
      T = RTASymTab(RTACode(i).Sym1).name
      If RTACode(i).Sym1 = 0 Then T = ""           ' Empty string is not „.“, it is„“
      T = Replace(T, "~", " ")
      T = Replace(T, "\", " / ")
      HF.Text1.Text = T
      HF.Text1.Refresh
      j = i + 1

Rem OUTPUT TEXT AREA

    Case "cls"
      RTAPrintText = ""
      j = i + 1

    Case "printn"
      d = Int(uIda) ' Vorkommastellen
      If d > 100 Then d = 100
      If d < 0 Then d = 0
      e = Int(vIda) ' Nachkommastellen
      If e > 100 Then e = 100
      If e < 0 Then e = 0
      If e > 0 Then
        s = String(d, "0") & "." & String(e, "0")
      Else
        s = String(d, "0")
      End If
      ' convert
      T = Format(Abs(tida), s)
      ' too long: *************
      If Len(T) > (Len(s)) Then T = String(Len(s), "*")
      ' decimal point
      T = Replace(T, ",", ".")
      ' sign
      If tida >= 0 Then
        T = " " & T
      Else
        T = "-" & T
      End If
      RTAPrintText = RTAPrintText & T
      j = i + 1

    Case "prints"
      s = RTASymTab(RTACode(i).Sym1).name
      s = Replace(s, "~", " ")
      s = Replace(s, "\", vbCrLf)
      RTAPrintText = RTAPrintText & s
      j = i + 1
   
    Case "save"
      s = RTASymTab(RTACode(i).Sym1).name             ' Symbol name = file name
      s = RTASignToSlash(s)
      s = s & ".txt"
      Open s For Output As RTALun
      Print #RTALun, "a"                              ' Put any to file
      Close RTALun                                    ' Close.
      Kill s                                          ' Delete the file.
      Open s For Output As RTALun                     ' Now we have a new and ampty file with length zero.
      Print #RTALun, RTAPrintText                     ' Write the output text area
      Close RTALun
      j = i + 1
  
    
Rem FILE IO

    Case "read"
      s = RTASymTab(RTACode(i).Sym1).name             ' Symbol name = File name
      s = RTASignToSlash(s)
      s = s & ".dat"
      p = RTACode(i).Sym1                             ' Symbol address
      q = Int(uIda)                                   ' array length. If zero: Number (scalar)
      If q >= 0 Then                                  ' ignore negative array length
        Open s For Append As RTALun                   ' Append mode: always successful
        r = LOF(RTALun)                               ' File length
        Close RTALun
        If r > 0 Then
          Open s For Input As RTALun
          ' File Read Loop
          For r = p To p + q                         ' Read record r
            If r <= UBound(RTASymTab) Then           ' If no end of table
              If Not EOF(RTALun) Then
                Line Input #RTALun, T                 ' Line read
                d = VIMAGEVal(T)                      ' Convert
                If d > RTA_MAX Then                   ' Overflow??
                  fixErrCode = 101
                  d = RTA_MAX
                End If
                If d < RTA_MIN Then
                  fixErrCode = 101
                  d = RTA_MIN
                End If
                RTASymTab(r).Valu = d                ' Put to symbol
              Else
                fixErrCode = 113                      ' Ene of File detected
              End If
            Else
              fixErrCode = 114                        ' End of Symbol table
            End If
          Next r
          ' End of File Read Loop
          Close RTALun
        Else
          fixErrCode = 117                            ' If Binary-Length 0, then: No such file
        End If
      End If
      j = i + 1

    Case "write"
      s = RTASymTab(RTACode(i).Sym1).name             ' Symbol name = file name
      s = RTASignToSlash(s)
      s = s & ".dat"
      p = RTACode(i).Sym1                             ' Symbol address
      q = Int(uIda)                                   ' Array length; if zero it is a number (a scalar)
      If q >= 0 Then                                  ' ignore negative array length
        Open s For Output As RTALun
        Print #RTALun, "a"                            ' Put any to file. Now the file must exist.
        Close RTALun                                  ' Close.
        Kill s                                        ' Delete the File.
        Open s For Output As RTALun                   ' New open. File length ist zero.
        ' File Write Loop
        For r = p To p + q                            ' Write record r.
          If r <= UBound(RTASymTab) Then              ' If no end of table
            T = CStr(RTASymTab(r).Valu)               ' Get value and convert into string
            T = Replace(T, "'", "")                   ' English or german scheme ....
            T = Replace(T, " ", "")
            T = Replace(T, ",", ".")
            T = Replace(T, "±", "")
            T = Replace(T, "+", "")
            Select Case Left(T, 1)
              Case "+":  T = T
              Case "-":  T = T
              Case Else: T = " " & T
            End Select
            Print #RTALun, T                          ' Write it
          Else
            fixErrCode = 117                          ' End of symbol detected
          End If
        Next r                                        ' Next record
        ' End of File Write Loop
        Close RTALun
      End If
      j = i + 1

    Case Else:
      fixErrCode = 116
      j = i + 1
    End Select
   
Rem
Rem 11. POINTER INSTRUCTIONS
Rem ------------------------

  Case 5:
    Select Case RTACode(i).instruction

    Case "adrof"
      p = RTACode(i).Sym2
      wida = Int(p)
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "get"
      p = Int(uIda) + Int(vIda)
      If p < 0 Or p > UBound(RTASymTab) Then
        fixErrCode = 96
        p = 0
      End If
      wida = RTASymTab(p).Valu
      RTASymTab(RTACode(i).Sym1).Valu = wida
      ppp = RTACode(i).Sym1
      j = i + 1

    Case "put"
      p = Int(tida)
      q = Int(uIda)
      p = p + q
      If p < 0 Or p > UBound(RTASymTab) Then
        fixErrCode = 96
        p = 0
      End If
      RTASymTab(p).Valu = vIda
      ppp = p
      j = i + 1

    Case Else:
      fixErrCode = 116
      j = i + 1

    End Select

Rem
Rem 12. SYSTEM INSTRUCTIONS
Rem -----------------------

  Case 7:
    Select Case RTACode(i).instruction

    Case "init":
      ' Not used
      j = i + 1

    Case "nop":              ' no operation
      j = i + 1
      
    Case "mode":
        RTATestMode = Int(tida)
        If RTATestMode > 2 Then RTATestMode = 2
        If RTATestMode < 0 Then RTATestMode = 0
        j = i + 1

    Case "halt":
        RTAHaltSignal = True
        j = i + 1
        
    Case "errcode"             ' the errcode mov
      If fixErrCode <> 0 Then
        RTASymTab(RTACode(i).Sym1).Valu = CDbl(fixErrCode)
        RTAWasError = True     ' save the error
        fixErrCode = 0
      Else
        If RTAWasErrorCode <> 0 Then
          RTASymTab(RTACode(i).Sym1).Valu = CDbl(RTAWasErrorCode)
          RTAWasErrorCode = 0
        Else
          RTASymTab(RTACode(i).Sym1).Valu = 0
        End If
      End If
      j = i + 1

    Case "errjump"             ' errjump
      If fixErrCode = 0 Then
        j = i + 1
      Else
        RTASymTab(0).Valu = 0                      ' clear the empty,
        j = Int(RTASymTab(RTACode(i).Sym1).Valu)   ' it must ever be zero
        RTAWasError = True                         ' save the error
        RTAWasErrorCode = fixErrCode
        fixErrCode = 0
      End If

    Case "exit":
      RTAExitSignal = True
      
    Case "end":                  ' for compatibility with older versions
      j = i + 1

                              
Rem
Rem 13. PSEUDO INSTRUCTIONS
Rem -----------------------

Rem I believe it is an false code. There are not preudo instructions in the CodeTab


    'Case "_lab"
    '  j = i + 1

    Case "_var"
      j = i + 1

    Case "_dim"
      j = i + 1
      
    Case "_config"
      j = i + 1

    Case "_name":
      j = i + 1

    Case Else:
      fixErrCode = 116  ' unknown instruction
      j = i + 1
    End Select

Rem UNBEKANNTE BEFEHLE

  Case Else:
    fixErrCode = 116    ' unknown instruction group
    j = i + 1
  End Select
End If
End If

Rem E N D   O F   I N S T R U C  T I O N   L O O P

Rem
Rem OVERFLOW??
Rem ----------

If RTASymTab(ppp).Valu < RTA_MIN Then
  RTASymTab(ppp).Valu = RTA_MIN
  fixErrCode = 101
End If
If RTASymTab(ppp).Valu > RTA_MAX Then
  RTASymTab(ppp).Valu = RTA_MAX
  fixErrCode = 101
End If

Rem
Rem VALID JUMP ADDREESS??
Rem ---------------------

If fixAbortFlag = False Then               ' only if no abort
  If j < 1 Or j > UBound(RTACode) Then     ' only if out of range
    If RTAWasError = False Then            ' only if no an errjump jump
       fixErrCode = 36                     ' ERROR!!
    End If
    j = i + 1                              ' use next instruction in CodeTab as next instruction
  End If
End If

Rem
Rem PROTOCOL, ERRORCODE
Rem -------------------

RTACode(i).ExeCount = RTACode(i).ExeCount + 1
If fixErrCode <> 0 Then
  RTACode(i).ErrCount = RTACode(i).ErrCount + 1
  RTACode(i).ErrCode = fixErrCode
End If

Rem
Rem HALT SIGNAL EXECUTION
Rem ---------------------

s = ""
' 5 Times HALT:
' 1) Step mode: always HALT
If RTATestMode = 2 Then s = "Einzelschritt"
' 2) Errorstop mode: HALT after errjump or errcode execution
If RTATestMode = 1 And RTAWasError = True Then s = "Halt nach Fehlerbehandlung"
' 3) Errorstop mode: HALT on error
If RTATestMode = 1 And fixErrCode <> 0 Then s = "Fehlerhalt"
' 4) HALT if Halt signal is set by user
If RTAHaltSignal = True Then s = "Haltsignal erkannt"
' 5) HALT if halt instruction detected
If RTACode(i).instruction = "halt" Then s = "halt-Befehl"
If s <> "" Then
    RTAHaltSignal = False
    T = RTAGenerateInstructionText(i, j, k)
    VFSHORTD.Caption = s
    VFSHORTD.Text1 = T
    VFSHORTD.Show vbModal
    If RTAExitSignal = True Then fixErrCode = 90
End If
RTAWasError = False

Rem
Rem EXIT FLAG EXECUTION
Rem -------------------

' fixAbortFlag is the host's Abort flag (may be set by system or other processes)
' RTAExitSignal  is the RTA own Abort flag

If k Mod 1000 = 0 Then
  k = k
  VFSHORTA.Refresh
  DoEvents
End If
If fixAbortFlag = True Then
  fixAbortFlag = False
  fixErrCode = 90
  RTAExitSignal = True
End If

If RTAExitSignal = True Then GoTo rta_processor_exit

If j > UBound(RTACode) Then GoTo rta_processor_exit
i = j

GoTo RTAInstructionLoop

rta_processor_exit:
If fixErrCode <> 90 And fixErrCode <> 91 Then
fixErrCode = 0
  For i = 1 To UBound(RTACode)
    If RTACode(i).ErrCode <> 0 Then
      fixErrCode = RTACode(i).ErrCode
    End If
  Next i
End If
RTAIsInProc = False
End Sub

Rem ***************************************************************************

Rem
Rem S M A L L   S U B R O U T I N E S
Rem =================================

Rem
Rem SEARCH AND ENTER AN SYMBOL IN THE SymTab
Rem ========================================

Public Function RTAEnterSym(name As String, Elements As Long, STyp As String) As Long
Rem
Rem Search and enters a Symbol in the SymTab if no found.
Rem If Elements is ge 1 then the subroutine will create an array with Elements elements.
Rem Name will be a pointer to the zero element.
Rem It ist the realisation of the _dim pseudo instruction.
Rem
Rem if Elements=0 or always successful
Rem if Elements>0 then Error on found Symbol. Thats the double array declaration error.
Rem
Rem SType Semantics:
Rem
Rem    "P" = Set Symbol Type to "P" = Pre defined
Rem    "A" = Enter an array with Elements elements. The Elements get the Symbol Type "E"
Rem
  ' On Error GoTo 4444
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim c As String
  If Elements < 0 Then Elements = 0
  Rem Empty Symbol
  If name = "" Then name = "."
  Rem Illegal Symbol length?
  If Len(name) > 1024 Then
    fixErrCode = 120
    Exit Function
  End If
  Rem Space = ~, Newline = \
  name = Replace(name, " ", "~")
  name = Replace(name, vbCrLf, "/")
  Rem Symbol already in Table?
  For i = 0 To UBound(RTASymTab)
    If RTASymTab(i).name = name Then
      RTAEnterSym = i
      If Elements > 1 Then fixErrCode = 118
      Exit Function
    End If
  Next i
  Rem Not found: Enter ...
  i = UBound(RTASymTab) + 1
  If i > MAX_RTA_SYMBOL Then
    fixErrCode = 119
    Exit Function
  End If
  ReDim Preserve RTASymTab(0 To i)
  RTASymTab(i).name = name
  RTASymTab(i).Valu = 0
  RTASymTab(i).type = STyp
  RTAEnterSym = i
  
  Rem INTIALIZE A NUMBER
  
  Rem If Symbol is no Name: a numerous value?
  c = LCase(Left(RTASymTab(i).name, 1))
  Select Case c
    Case "a" To "z":
    Case "ä":
    Case "ö":
    Case "ü":
    Case "ß":
    Case "#":
    Case "%":
    Case "&":
    Case "@":
    Case "_$":
    Case "(":
    Case ")":
    Case "$":
    Case "+", "-", ".", "0" To "9":
      RTASymTab(i).Valu = VIMAGEVal(RTASymTab(i).name)    ' VIMAGEVal is only the Basic Val instruction with some comfort
    Case Else:
  End Select
  
  Rem ENTER AN ARRAY
  
  Rem Enter additional array elements
  If STyp = "A" Then
    i = UBound(RTASymTab)
    j = i + Elements + 1
    If j > MAX_RTA_SYMBOL Then
      fixErrCode = 119
      Exit Function
    End If
    ReDim Preserve RTASymTab(0 To j)
    RTASymTab(i).Valu = i + 1
    RTASymTab(i).type = "A"
    For k = 0 To Elements
      RTASymTab(i + 1 + k).name = name & "(" & Format(k) & ")"
      RTASymTab(i + 1 + k).Valu = 0
      RTASymTab(i + 1 + k).type = "E"
    Next k
  End If
  
  Rem END OF THE SUBROUTINE
  
  Exit Function
4444:
  fixErrCode = 101
  Exit Function
End Function

Rem
Rem DECODES SPECIAL CHARS INTO AN _
Rem ===============================

Public Function RTASignToSlash(s As String) As String
Rem
Rem CHanges Special Chars into a _
Rem
Dim c As String
Dim T As String
Dim i As Long
T = ""
For i = 1 To Len(s)
  c = Mid(s, i, 1)
  Select Case c
  Case "a" To "z": c = c
  Case "A" To "Z": c = LCase(c)
  Case "0" To "9": c = c
  Case "$": c = c
  Case "_": c = c
  Case "(": c = c
  Case ")": c = c
  Case Else: c = "_"
  End Select
  T = T & c
  RTASignToSlash = T
Next i
End Function

Rem
Rem UP TRANSLATE AN INTRUCTION IN A GROUP CODE
Rem ==========================================

Public Function RTACompile(s As String) As Integer
Rem
Rem RTACompile gives an instruction s a group number
Rem
Rem The group number supportes a faster execution. Theres no semantic meaning.
Rem
Dim c As Integer
    Select Case LCase(Left(s & "------", 7))
        Case "mov----": c = -1   ' negativ: express inteructions
        Case "clr----": c = -1
        Case "neg----": c = 1
        Case "abs----": c = 1
                                
        Case "add----": c = -2   ' negativ: express inteructions
        Case "sub----": c = -2
        Case "mul----": c = -2
        Case "div----": c = -2
        
        Case "power--": c = 2
        Case "root---": c = 2

        Case "sin----": c = 2
        Case "cos----": c = 2
        Case "tan----": c = 2
        Case "cot----": c = 2
        Case "sec----": c = 2
        Case "csc----": c = 2
        
        Case "asin---": c = 2
        Case "acos---": c = 2
        Case "atan---": c = 2
        Case "acot---": c = 2
        Case "asec---": c = 2
        Case "acsc---": c = 2
        
        Case "sinh---": c = 2
        Case "cosh---": c = 2
        Case "tanh---": c = 2
        Case "coth---": c = 2
        Case "sech---": c = 2
        Case "csch---": c = 2
        
        Case "asinh--": c = 2
        Case "acosh--": c = 2
        Case "atanh--": c = 2
        Case "acoth--": c = 2
        Case "asech--": c = 2
        Case "acsch--": c = 2
        
        Case "exp----": c = 2
        Case "exp10--": c = 2
        Case "exp2---": c = 2
        Case "expx---": c = 2
        
        Case "log----": c = 2
        Case "log10--": c = 2
        Case "log2---": c = 2
        Case "logx---": c = 2
        
        Case "bin----": c = 2
        Case "not----": c = 2
        Case "and----": c = 2
        Case "or-----": c = 2
        
        Case "inc----": c = 2
        Case "dec----": c = 2
        Case "sgn----": c = 2
        Case "round--": c = 2
        Case "ceil---": c = 2
        Case "floor--": c = 2
        Case "fix----": c = 2
        Case "frac---": c = 2
        Case "clip---": c = 2
        Case "cmod---": c = 2
        Case "random-": c = 2
                
        Case "cmpgt--": c = 3
        Case "cmpge--": c = 3
        Case "cmplt--": c = 3
        Case "cmple--": c = 3
        Case "cmpeq--": c = 3
        Case "cmpne--": c = 3

        Case "tstgt--": c = 4
        Case "tstge--": c = 4
        Case "tstlt--": c = 4
        Case "tstle--": c = 4
        Case "tsteq--": c = 4
        Case "tstne--": c = 4

        Case "jump---": c = -1   ' negativ: express inteructions

        Case "adrof--": c = 5
        Case "get----": c = 5
        Case "put----": c = 5

        Case "input--": c = 6
        Case "output-": c = 6
        Case "pause--": c = 6
        Case "proof--": c = 6
        Case "info---": c = 6

        Case "cls----": c = 6
        Case "printn-": c = 6
        Case "prints-": c = 6

        Case "read---": c = 6
        Case "write--": c = 6
        Case "save---": c = 6

        Case "init---": c = 7
        Case "nop----": c = 7
        Case "mode---": c = 7
        Case "halt---": c = 7
        Case "errjump": c = 7
        Case "errcode": c = 7
        Case "exit---": c = 7
        Case "end----": c = 7
        
        Case "_lab---": c = 99   ' invalid
        Case "_dim---": c = 99
        Case "_var---": c = 99
        Case "_config": c = 99
        Case "_name--": c = 99
        Case "_end---": c = 99

        Case Else: c = -9999      ' invalid
    End Select
    RTACompile = c
End Function

Rem
Rem EXECUTION PROTOCOL GENERATION
Rem =============================

Public Function RTAGenerateExecutionProtocol() As String
Rem
Rem Generate Exec Protocol as an string
Rem
Rem Call after execution.
Rem
Dim s As String
Dim T As String
  s = "" & vbCrLf
  s = s & "EXECUTION PROTOCOL" & vbCrLf
  s = s & "==================" & vbCrLf
  s = s & "" & vbCrLf
  s = s & "LINE INSTR  SYMBOL1  SYMBOL2  SYMBOL3   EXECUTIONS      ERRORS LAST ERROR CODE" & vbCrLf
  s = s & String(96, "-") & vbCrLf
  For i = 0 To UBound(RTACode)
    If RTACode(i).instruction <> "" Then
      T = ""
      If RTACode(i).ErrCode <> 0 Then
        Call FIXDescErrText(RTACode(i).ErrCode, T)
      End If
      s = s & Format(i, "0000") & " "
      s = s & Left(RTACode(i).instruction & "        ", 7)
      s = s & Left(RTASymTab(RTACode(i).Sym1).name & "        ", 8) & " "
      s = s & Left(RTASymTab(RTACode(i).Sym2).name & "        ", 8) & " "
      s = s & Left(RTASymTab(RTACode(i).Sym3).name & "        ", 8)
      s = s & Right("              " & Format(RTACode(i).ExeCount, "###########0"), 12)
      s = s & Right("              " & Format(RTACode(i).ErrCount, "###########0"), 12)
      s = s & Right("    " & Format(RTACode(i).ErrCode, "###0"), 4) & " "
      If T <> "" Then
        s = s & "(" & T & ")"
      End If
      s = s & vbCrLf
    End If
  Next i
  s = s & String(96, "-") & vbCrLf
  RTAGenerateExecutionProtocol = s
End Function

Rem
Rem DEBUGGER PROTOCOL GENERATION
Rem ============================

Public Function RTAGenerateInstructionText(i As Long, j As Long, k As Long) As String
Rem
Rem Generates the Debugger protocol as a string
Rem
Rem i ... instruction counter
Rem j ... instruction pointer
Rem k ... next instruction pointer
Rem
Rem Call on stop on end of instruction loop.
Rem
Dim s As String
Dim f As String
Dim f1 As String
Dim f2 As String
Dim f3 As String
Dim f4 As String
Dim f5 As String
Dim f6 As String
Dim xtra_ptr As Double
Dim xtra_str As String

Rem PUT/GET-PEPROCESS

If LCase(RTACode(i).instruction) = "get" Or LCase(RTACode(i).instruction) = "put" Then
  If LCase(RTACode(i).instruction) = "get" Then
    xtra_ptr = uIda + vIda
    xtra_str = "Get"
  Else
    xtra_ptr = tida + uIda
    xtra_str = "Put"
  End If
Else
  xtra_ptr = 0
  xtra_str = ""
End If

Rem FORMAT DEFINITION

f1 = "#.0000##########E+00"
f2 = "#.0000##########E+00"
f3 = "#.0000##########E+00"
f4 = "#.0000##########E+00"
f5 = "#.0000##########E+00"
f6 = "#.0000##########E+00"

If Abs(tida) < 10000 And Abs(tida) > 0.001 Then
  f1 = "###0.0###############"
End If
If Abs(uIda) < 10000 And Abs(uIda) > 0.001 Then
  f2 = "###0.0###############"
End If
If Abs(vIda) < 10000 And Abs(vIda) > 0.001 Then
  f3 = "###0.0###############"
End If
If Abs(RTASymTab(RTACode(i).Sym1).Valu) < 10000 And Abs(RTASymTab(RTACode(i).Sym1).Valu) > 0.001 Then
  f4 = "###0.0###############"
End If
If Abs(CLng(xtra_ptr)) < 10000 And Abs(CLng(xtra_ptr)) > 0.001 Then
  f5 = "###0.0###############"
End If
If Abs(RTASymTab(xtra_ptr).Valu) < 10000 And Abs(RTASymTab(xtra_ptr).Valu) > 0.001 Then
  f6 = "###0.0###############"
End If

If tida = 0 Then
  f1 = "###0.0000############"
End If
If uIda = 0 Then
  f2 = "###0.0000############"
End If
If vIda = 0 Then
  f3 = "###0.0000############"
End If
If RTASymTab(RTACode(i).Sym1).Valu = 0 Then
  f4 = "###0.0000############"
End If
If (CLng(xtra_ptr)) = 0 Then
  f5 = "###0.0000############"
End If
If RTASymTab(CLng(xtra_ptr)).Valu = 0 Then
  f6 = "###0.0000############"
End If

Rem 1ST TABLE PART

  s = ""
  s = s & "IC             :" & k & vbCrLf
  s = s & "IP             :" & Format(i, "0000") & vbCrLf & vbCrLf
  s = s & "Instruction    :" & _
                            Left(RTACode(i).instruction & "      ", 7) & " " & _
                            Left(RTASymTab(RTACode(i).Sym1).name & "                     ", 21) & " " & _
                            Left(RTASymTab(RTACode(i).Sym2).name & "                     ", 21) & " " & _
                            Left(RTASymTab(RTACode(i).Sym3).name & "                     ", 21) & vbCrLf
  s = s & "Op Address     :        " & _
                            Format(RTACode(i).Sym1, "000000") & "               " & " " & _
                            Format(RTACode(i).Sym2, "000000") & "               " & " " & _
                            Format(RTACode(i).Sym3, "000000") & "               " & vbCrLf
  
  s = s & "Op Value Pre   :        " & _
                            Replace(Left(Format(tida, f1) & "                     ", 21), ",", ".") & " " & _
                            Replace(Left(Format(uIda, f2) & "                     ", 21), ",", ".") & " " & _
                            Replace(Left(Format(vIda, f3) & "                     ", 21), ",", ".") & vbCrLf
  s = s & "Op Value Post  :        " & _
                        Replace(Left(Format(RTASymTab(RTACode(i).Sym1).Valu, f4) & "                     ", 21), ",", ".") & vbCrLf
                            
Rem 2ND TABLE PART (PUT/GET-INSTRUCTIONS)
  
  If xtra_str <> "" Then
  s = s & xtra_str & " Address    :        " & _
                            Left(Format(CLng(xtra_ptr)) & "                     ", 21) & vbCrLf
  If (xtra_ptr) > LBound(RTASymTab) And (xtra_ptr) < UBound(RTASymTab) Then
  s = s & xtra_str & " Value Post :        " & _
                            Replace(Left(Format(RTASymTab(CLng(xtra_ptr)).Valu, f6) & "                     ", 21), ",", ".") & vbCrLf
  Else
  s = s & xtra_str & " Value Post :        " & _
                            "***" & vbCrLf
  End If
  Else
  s = s & "No get/put ..." & vbCrLf & "No get/put ..." & vbCrLf
  End If
  s = s & vbCrLf
  
  Call FIXDescErrText(fixErrCode, f)
  s = s & "Error Code     : " & fixErrCode & " (" & f & ")" & vbCrLf
  s = s & "Exit Signal    : " & RTAExitSignal & vbCrLf
  s = s & "Halt Signal    : " & RTAHaltSignal & vbCrLf
  s = s & "Next IP        : " & Format(j, "0000") & vbCrLf
'  Select Case RTATestMode
'  Case 0:   s = s & "TestMode  : 0='Ohne Halt'"
'  Case 1:   s = s & "TestMode  : 1='Fehlerhalt'"
'  Case 2:   s = s & "TestMode  : 2='Schrittweise'"
'  End Select
RTAInstructionText = s           ' Aufheben auf globaler Variable
RTAGenerateInstructionText = s
End Function

Rem
Rem CODETAB PROTOCOL GENERATION
Rem ===========================

Public Function RTAGenerateCodeText() As String
Rem
Rem RTACodeTab transforms the RTACode table in a printable string
Rem
Dim s As String
  s = "" & vbCrLf
  s = s & "CODE TABLE" & vbCrLf
  s = s & "==========" & vbCrLf
  s = s & "" & vbCrLf
  s = s & "LINE INSTR  SYMBOL1  SYMBOL2  SYMBOL3  ADDR1  ADDR2  ADDR3   VALUE1  VALUE2  VALUE3" & vbCrLf
  s = s & String(84, "-") & vbCrLf
  For i = 0 To UBound(RTACode)
    If RTACode(i).instruction <> "" Then
      s = s & Format(i, "0000") & " "
      s = s & Left(RTACode(i).instruction & "        ", 7)
      s = s & Left(RTASymTab(RTACode(i).Sym1).name & "        ", 8) & " "
      s = s & Left(RTASymTab(RTACode(i).Sym2).name & "        ", 8) & " "
      s = s & Left(RTASymTab(RTACode(i).Sym3).name & "        ", 8) & " "
      s = s & Format(RTACode(i).Sym1, "000000") & " "
      s = s & Format(RTACode(i).Sym2, "000000") & " "
      s = s & Format(RTACode(i).Sym3, "000000") & " "
      s = s & RTAGenerateCodeFormat(RTASymTab(RTACode(i).Sym1).Valu) & " "
      s = s & RTAGenerateCodeFormat(RTASymTab(RTACode(i).Sym2).Valu) & " "
      s = s & RTAGenerateCodeFormat(RTASymTab(RTACode(i).Sym3).Valu) & " "
      s = s & vbCrLf
    End If
  Next i
  s = s & String(84, "-") & vbCrLf
  RTAGenerateCodeText = s
End Function

Private Function RTAGenerateCodeFormat(d As Double) As String
Dim s As String
  If d < 99999999 And d > -9999999 And Round(d) = d Then
    s = Right("       " & Format(d, "######0"), 7)
  Else
    If d < 99999 And d > -9999 And Round(d) <> d Then
      s = Right("       " & Format(d, "####0.0"), 7)
    Else
      s = Format(d, "#.0E+00")  ' 8 Chars
      s = Replace(s, "E+", "E")  ' 7 Chars
      If Len(s) <= 7 Then
        s = Right("      " & s, 7)
      Else
        s = "*******"
      End If
    End If
  End If
s = Replace(s, ",", ".")
RTAGenerateCodeFormat = s
End Function

Rem
Rem SYMTAB PROTOCOL GENERATION
Rem ==========================

Public Function RTAGenerateSymText(LongTable As Boolean) As String
Rem
Rem RTASymTab transforms the RTASymTab in a printable string
Rem
Rem If LongTable is true then al lonh table including all Array elements and Pre defined Symbols
Rem
Dim a() As String
Dim s As String
Dim T As String
Dim p As Integer
Dim i As Long
Dim j As Long
Dim k As Long
  s = "" & vbCrLf
  If LongTable = False Then
    s = s & "SYMBOL TABLE" & vbCrLf
    s = s & "============" & vbCrLf
  Else
    s = s & "FULL SYMBOL TABLE" & vbCrLf
    s = s & "=================" & vbCrLf
  End If
  s = s & "" & vbCrLf
  s = s & "ADDR   T NAME                     VALUE" & vbCrLf
  s = s & String(74, "-") & vbCrLf
  ReDim a(0 To UBound(RTASymTab))
  For i = 0 To UBound(RTASymTab)
    If LongTable = True Or RTASymTab(i).type <> "E" Then ' ArrayElements: Symbols with ( and )
      a(i) = Format(i, "000000") & " "
      a(i) = a(i) & Mid(RTASymTab(i).type & " ", 1, 1) & " "
      a(i) = a(i) & Left(RTASymTab(i).name & String(24, " "), 24) & " "
      
      a(i) = a(i) & Replace(Left(Format(RTASymTab(i).Valu) & String(22, " "), 22), ",", ".") & " "
      a(i) = a(i) & vbCrLf
    End If
    If i Mod 1000 = 0 Then
      HF.Text2.Text = "Symbol " & i & "/" & UBound(RTASymTab) & " protokollieren"
      HF.Text2.Refresh
    End If
  Next i
  ' Append 1000 Empty Lines
  j = UBound(a)
  ReDim Preserve a(0 To j + 1000)
  For i = j + 1 To j + 1000
    a(i) = ""
  Next i
  ' More fast in blocks a 1000 lines
  For i = 0 To j \ 1000
    T = ""
    For k = 0 To 999
      T = T & a(i * 1000 + k)
    Next k
    s = s & T
    HF.Text2.Text = "Symbol " & i * 1000 & "/" & UBound(RTASymTab) & " tabellieren"
    HF.Text2.Refresh
  Next i
  s = s & String(74, "-") & vbCrLf
  If LongTable = True Then
    s = s & "TYPE T: P = PRE DEFINED SYMBOL, A = ARRAY POINTER, E = ARRAY ELEMENT" & vbCrLf
    s = s & String(74, "-") & vbCrLf
  Else
    s = s & "TYPE T: P = PRE DEFINED SYMBOL, A = ARRAY POINTER, E = ARRAY ELEMENT" & vbCrLf
    s = s & String(74, "-") & vbCrLf
  End If
  RTAGenerateSymText = s
End Function

Rem
Rem ONLINE DOCUMENTATION GENERATION
Rem ===============================

Public Function RTAGenerateHelpText() As String
Rem
Rem Gives an online documentation string.
Rem
Rem In German.
Rem
Dim i As Byte
Dim s As String

  s = "" & vbCrLf
  s = s & "BESCHREIBUNG DER ASSEMBLERSPRACHE RETRO" & vbCrLf
  s = s & "=======================================" & vbCrLf
  s = s & vbCrLf
 
  s = s & "1.  B e f e h l e" & vbCrLf
  s = s & vbCrLf
  s = s & "Einfache Befehle" & vbCrLf
  s = s & vbCrLf
  s = s & "mov     b a       a nach b schaffen (Transportbefehl)          " & vbCrLf
  s = s & "clr     a         a auf 0 setzen (Löschbefehl)                 " & vbCrLf
  s = s & "inc     a         a = a + 1 (Inkrement)                        " & vbCrLf
  s = s & "dec     a         a = a - 1 (Dekrement)                        " & vbCrLf
  s = s & vbCrLf
  s = s & "Grundrechenarten" & vbCrLf
  s = s & vbCrLf
  s = s & "add     a b       a = a + b                                    " & vbCrLf
  s = s & "sub     a b       a = a - b                                    " & vbCrLf
  s = s & "mul     a b       a = a * b                                    " & vbCrLf
  s = s & "div     a b       a = a / b                                    " & vbCrLf
  s = s & vbCrLf
  s = s & "Höhere Rechenarten " & vbCrLf
  s = s & vbCrLf
  s = s & "power   a b       a = a hoch b " & vbCrLf
  s = s & "root    a b       a = b-te Wurzel aus a " & vbCrLf
  s = s & vbCrLf
  s = s & "Exponentialfunktionen " & vbCrLf
  s = s & vbCrLf
  s = s & "exp     a         a = e hoch a  " & vbCrLf
  s = s & "exp10   a         a = 10 hoch a " & vbCrLf
  s = s & "exp2    a         a = 2 hoch a  " & vbCrLf
  s = s & "expx    a b       a = b hoch a  " & vbCrLf
  s = s & vbCrLf
  s = s & "Logarithmusfunktionen " & vbCrLf
  s = s & vbCrLf
  s = s & "log     a         a = natürlicher Logarithmus aus a (Basis e) " & vbCrLf
  s = s & "log10   a         a = dekadischer Logarithmus aus a (Basis 10)" & vbCrLf
  s = s & "log2    a         a = dyadischer Logarithmus aus a (Basis 2)  " & vbCrLf
  s = s & "logx    a b       a = beliebiger Logarithmus aus a (Basis b)  " & vbCrLf
  s = s & vbCrLf
  s = s & "Winkelfunktionen" & vbCrLf
  s = s & vbCrLf
  s = s & "sin     a         a = sin(a)               " & vbCrLf
  s = s & "cos     a         a = cos(a)               " & vbCrLf
  s = s & "tan     a         a = tan(a)               " & vbCrLf
  s = s & "cot     a         a = cot(a)               " & vbCrLf
  s = s & "sec     a         a = sec(a)   = 1 / cos(a)" & vbCrLf
  s = s & "csc     a         a = cosec(a) = 1 / sin(a)" & vbCrLf
  s = s & vbCrLf
  s = s & "Arkusfunktionen " & vbCrLf
  s = s & vbCrLf
  s = s & "asin    a         a = arcsin(a)            " & vbCrLf
  s = s & "acos    a         a = arccos(a)            " & vbCrLf
  s = s & "atan    a         a = arctan(a)            " & vbCrLf
  s = s & "acot    a         a = arccot(a)            " & vbCrLf
  s = s & "asec    a         a = arcsec(a)            " & vbCrLf
  s = s & "acsc    a         a = arccosec(a)          " & vbCrLf
  s = s & vbCrLf
  s = s & "Hyperbelfunktionen " & vbCrLf
  s = s & vbCrLf
  s = s & "sinh    a         a = sinus hyperbolicus (a)         " & vbCrLf
  s = s & "cosh    a         a = cosinus hyperbolicus (a)       " & vbCrLf
  s = s & "tanh    a         a = tangens hyperbolicus (a)       " & vbCrLf
  s = s & "coth    a         a = cotangens hyperbolicus (a)     " & vbCrLf
  s = s & "sech    a         a = secans hyperbolicus (a)        " & vbCrLf
  s = s & "csch    a         a = cosecans hyperbolicus (a)      " & vbCrLf
  s = s & vbCrLf
  s = s & "Areafunktionen " & vbCrLf
  s = s & vbCrLf
  s = s & "asinh   a         a = area sinus hyperbolicus (a)    " & vbCrLf
  s = s & "acosh   a         a = area cosinus hyperbolicus (a)  " & vbCrLf
  s = s & "atanh   a         a = area tangens hyperbolicus (a)  " & vbCrLf
  s = s & "acoth   a         a = area cotangens hyperbolicus (a)" & vbCrLf
  s = s & "asech   a         a = area secans hyperbolicus (a)   " & vbCrLf
  s = s & "acsch   a         a = area cosecans hyperbolicus (a) " & vbCrLf
  s = s & vbCrLf
  s = s & "Logische Befehle " & vbCrLf
  s = s & vbCrLf
  s = s & "bin     a         a = 1, sofern a<>0, sonst 0 (Log. Identität)" & vbCrLf
  s = s & "not     a         a = 1, sofern a=0, sonst 0 (Log. Negation)  " & vbCrLf
  s = s & "and     a b       a = 1, sofern a<>0 und b<>0, sonst 0        " & vbCrLf
  s = s & "or      a b       a = 1, sofern a<>0 oder b<>0, sonst 0       " & vbCrLf
  s = s & vbCrLf
  s = s & "Sonstige Rechenbefehle " & vbCrLf
  s = s & vbCrLf
  s = s & "neg     a         Vorzeichen von a umkehren (Negation)         " & vbCrLf
  s = s & "abs     a         Absolutbetrag von a bilden                   " & vbCrLf
  s = s & "sgn     a         Vorzeichen von a (+1, 0 oder -1)             " & vbCrLf
  s = s & "round   a         a runden                                     " & vbCrLf
  s = s & "ceil    a         a aufrunden                                  " & vbCrLf
  s = s & "floor   a         a abrunden                                   " & vbCrLf
  s = s & "fix     a         Vorkommastellen von a (a zur 0 hin runden)   " & vbCrLf
  s = s & "frac    a         Nachkommastellen von a                       " & vbCrLf
  s = s & "clip    a b c     a = a, wenn a<b dann a = b, wenn a>c, dann a = c" & vbCrLf
  s = s & "cmod    a b c     a mit Modulofunktion (Sägezahn) in b ... c clippen" & vbCrLf
  s = s & "random  a         a = Zufallszahl zwischen 0 und 1        " & vbCrLf
  s = s & vbCrLf
  s = s & "Sprungbefehle " & vbCrLf
  s = s & vbCrLf
  s = s & "cmpgt   a b m     wenn a >  b, Sprung nach m („compare greather than“)" & vbCrLf
  s = s & "cmpge   a b m     wenn a >= b, Sprung nach m („compare greather equal“)" & vbCrLf
  s = s & "cmplt   a b m     wenn a <  b, Sprung nach m („compare less than“) " & vbCrLf
  s = s & "cmple   a b m     wenn a <= b, Sprung nach m („compare less equal“)" & vbCrLf
  s = s & "cmpeq   a b m     wenn a =  b, Sprung nach m („compare equal“)     " & vbCrLf
  s = s & "cmpne   a b m     wenn a <> b, Sprung nach m („compare not equal“) " & vbCrLf
  s = s & vbCrLf
  s = s & "tstgt   a m       wenn a >= 0, Sprung nach m („test greather than“)" & vbCrLf
  s = s & "tstge   a m       wenn a >  0, Sprung nach m („test greather equal“)" & vbCrLf
  s = s & "tstlt   a m       wenn a <  0, Sprung nach m („test less than“)    " & vbCrLf
  s = s & "tstle   a m       wenn a <= 0, Sprung nach m („test less equal“)   " & vbCrLf
  s = s & "tsteq   a m       wenn a =  0, Sprung nach m („test equal“)        " & vbCrLf
  s = s & "tstne   a m       wenn a <> 0, Sprung nach m („test not equal“)    " & vbCrLf
  s = s & vbCrLf
  s = s & "jump    m         Unbedingter Sprung nach m                        " & vbCrLf
  s = s & vbCrLf
  s = s & "Ein-/Ausgabebefehle" & vbCrLf
    s = s & vbCrLf
  s = s & "input   a s       fordert a mit Text s im Dialog an (mit Pause)    " & vbCrLf
  s = s & "output  a s       zeigt a mit Text s im Dialog an (mit Pause)      " & vbCrLf
  s = s & "pause   s         Programmpause mit Dialogtext s (mit Pause)       " & vbCrLf
  s = s & "proof   a s       Testausgabe von a mit Mitteilung s (ohne Pause)  " & vbCrLf
  s = s & "info    s         Mitteilung s (ohne Pause) " & vbCrLf
  s = s & vbCrLf
  s = s & "cls               Löschen des Ausgabetextes                        " & vbCrLf
  s = s & "printn  a b c     Ausgabe der Zahl a mit b Vor- und c Nachkommastellen" & vbCrLf
  s = s & "prints  s         Ausgabe der Zeichenkette s in den Ausgabetext    " & vbCrLf
  s = s & "save    s         Speichern des Ausgabetextes in Textdatei s       " & vbCrLf
  s = s & vbCrLf
  s = s & "read    a b       b+1 Symbole aus Datei a.dat lesen und ab Symbol a in Symboltabelle ablegen. & vbCrLf"
  s = s & "write   a b       Ab Symbol a fortlaufend b+1 Symbole aus Symboltabelle in Datei a.dat schreiben." & vbCrLf
  s = s & vbCrLf
  s = s & "Indirektbefehle" & vbCrLf
  s = s & vbCrLf
  s = s & "adrof   p a       Adresse von a nach p schaffen. p wird Pointer auf a " & vbCrLf
  s = s & "get     a p q     Das Symbol mit der Adresse (p+q) nach a schaffen " & vbCrLf
  s = s & "put     p q a     a auf das Symbol mit der Adresse (p+q) schaffen  " & vbCrLf
  s = s & vbCrLf
  s = s & "Systembefehle" & vbCrLf
  s = s & vbCrLf
  s = s & "init              Erste Zeile eines Programmes (wird automatisch erzeugt)" & vbCrLf
  s = s & "nop               Nullbefehl. Dieser Befehl macht nichts " & vbCrLf
  s = s & "mode    a         a=0: 'Ohne Halt', 1: 'Fehlerhalt', 2: 'Schrittweise'" & vbCrLf
  s = s & "halt              Hält das Programm an " & vbCrLf
  s = s & "errcode a         Fehlercode nach a. 0: Kein Fehler" & vbCrLf
  s = s & "errjump m         Bei Fehler Sprung nach m" & vbCrLf
  s = s & "exit              Programmbeendigung " & vbCrLf
  s = s & vbCrLf
  s = s & "Pseudobefehle " & vbCrLf
  s = s & vbCrLf
  s = s & "Pseudobefehle sind Befehle, die nicht in fertigen Programm („zur Laufzeit“), " & vbCrLf
  s = s & "sondern vom Assembler („zur Assemblerzeit“) abgearbeitet werden. " & vbCrLf
  s = s & vbCrLf
  s = s & "_name   s         Dem Programm den Namen s geben " & vbCrLf
  s = s & "_var    a         Variable a deklarieren " & vbCrLf
  s = s & "_dim    a i       Feld a mit den Feldelementen a, a(0) ... a(i) deklarieren " & vbCrLf
  s = s & "_lab    m         Marke m definieren " & vbCrLf
  s = s & "_config i         Virtuelle Maschine mit Parameter i konfigurieren " & vbCrLf
  s = s & "_end              Programmende " & vbCrLf
  s = s & vbCrLf
  s = s & "Für den markendefinierenden Befehl „_lab xyz“ gibt es auch die Kurzschreibweise „xyz:“." & vbCrLf
  s = s & vbCrLf
  s = s & "(Die Operanden bedeuten: " & vbCrLf & vbCrLf
  s = s & " a, b, c, p, q" & vbTab & "Zahlen oder Variablen " & vbCrLf
  s = s & " i    " & vbTab & vbTab & "nur Zahlen [Variablen gelten als Null]" & vbCrLf
  s = s & " m    " & vbTab & vbTab & "Marken                " & vbCrLf
  s = s & " s    " & vbTab & vbTab & "Zeichenketten)         " & vbCrLf
  s = s & vbCrLf
  s = s & vbCrLf
  
  s = s & "2.  D a s   P r o g r a m m" & vbCrLf & vbCrLf
  
  s = s & "Jeder Befehl steht auf einer Zeile. Alle Befehle zusammen bilden das Programm. " & vbCrLf & vbCrLf
  s = s & "Die Befehle werden in ihrer Reihenfolge abgearbeitet, z. B.: " & vbCrLf & vbCrLf
  
  s = s & "    mov     a      b       ; Transportiere b nach a " & vbCrLf
  s = s & "    div     a      10      ; Dividiere a durch 10 " & vbCrLf
  s = s & "    sin     a              ; Berechne nun den Sinus von a " & vbCrLf & vbCrLf
  
  s = s & "Auf diese Art wird z. B. a=sin(b/10) berechnet. " & vbCrLf & vbCrLf
  
  s = s & "Leerzeilen, Kommentare, Fortsetzungszeilen: Eine Zeile kann auch leer sein. Nach Semikolon kann Kommentar folgen. "
  s = s & "Wenn das letzte Zeichen einer Zeile das Zeichen ¶ (Zeichencode Alt/182) ist, so "
  s = s & "gilt die folgende Zeile nicht als neue Zeile, sondern als Fortsetzung." & vbCrLf
  s = s & vbCrLf
  s = s & vbCrLf
  
      
  s = s & "3.  O p e r a n d e n" & vbCrLf & vbCrLf
  
  s = s & "Ein Befehl besteht aus dem Befehlscode und bis zu drei Operanden. Befehlscode und Operanden "
  s = s & "werden durch Leerzeichen oder Tabulatoren voneinander getrennt. Alle Operanden werden in einer "
  s = s & "Symboltabelle verzeichnet und haben dort einen Symbolnamen und einen Symbolwert. "
  s = s & "Der Symbolname ist die Zeichenkette, die im Programm steht. "
  s = s & "Auf dem Symbolwert stehen die Zahlen, mit dem der Befehl rechnet. "
  s = s & "Die Zeilennummer in der Symboltabelle heißt Symboladresse. "
  
  s = s & "Ein Symbol kann als Variable, Zahl, Zeichenkette oder Marke genutzt werden. " & vbCrLf & vbCrLf
      
  s = s & "Variablen: Auf jedem Symbol kann ein beliebiger Zahlenwert gespeichert werden. Symbolnamen wie z. B. " & vbCrLf & vbCrLf
  s = s & "  a  x1  alpha  b11  aber auch  ??9  (°  055$  oder  [PM343]" & vbCrLf & vbCrLf
  s = s & "lassen sich so als Variablen nutzen." & vbCrLf & vbCrLf
    
  s = s & "Zahlen: Wenn sich der Symbolname als Zahlenwert interpretieren lässt, so "
  s = s & "wird der Symbolwert beim Programmstart mit diesem Zahlenwert gefüllt. So kann man mit Symbolnamen "
  s = s & "wie z. B. " & vbCrLf & vbCrLf
  s = s & "  1  2  +1.5  -3.3E6 -2.3E-2" & vbCrLf & vbCrLf
  s = s & "die Zahlen 1, 2, 1.5, -3300000 -0.023 usw. erzeugen. Das Dezimaltrennzeichen ist der Punkt, "
  s = s & "niemals das Komma. Ein E oder e wird als Exponentialkennzeichen aufgefasst. " & vbCrLf & vbCrLf
    
  s = s & "Marken: Sprungbefehle benötigen Marken als Ziele. Dies sind Symbole "
  s = s & "deren Symbolwert als Programmzeilennummer aufgefasst wird. Derartige "
  s = s & "Marken können mit Markendefinitionsbefehlen wie "
  s = s & "„_lab marke1“ (bzw. „marke1:“) "
  s = s & "gesetzt werden. " & vbCrLf & vbCrLf
  
  s = s & "Zeichenketten: Manche Befehle benötigen Zeichenketten als Operanden "
  s = s & "z. B. für Dialogtexte. Hier wird der Symbolname als Zeichenkette "
  s = s & "verwendet. "
  s = s & "In Zeichenketten gilt „~“ als Leerzeichen und „\“ als Zeilenumbruchzeichen. "
  s = s & "Zeichenketten dürfen nicht mehr als 1024 Zeichen enthalten. Beispiel:" & vbCrLf & vbCrLf
  s = s & "  \Beginn~der~Berechnung\\" & vbCrLf & vbCrLf
  s = s & "Variablen, Zahlen, Marken und Zeichenketten sind aber lediglich verschiedene Interpretationen "
  s = s & "von Symbolen, keinesfalls etwa verschiedene Datentypen o. ä. Retro unterscheidet keine Datentypen. Jeder Operand ist immer nur ein Symbol." & vbCrLf & vbCrLf
  s = s & vbCrLf
    
  s = s & "4.  V o r d e f i n i e r t e   V a r i a b l e n" & vbCrLf & vbCrLf
  
  s = s & "Bei jedem Programmstart werden bestimmte vordefinierte Symbole bereitgestellt: " & vbCrLf & vbCrLf
  s = s & " ." & vbTab & vbTab & "Das Leersymbol. Immer 0 " & vbCrLf
  s = s & " .." & vbTab & vbTab & "Der Befehlszeiger. Hier steht immer die Adresse des aktuellen Befehls " & vbCrLf
  s = s & " e" & vbTab & vbTab & "Die Eulersche Zahl e" & vbCrLf
  s = s & " pi" & vbTab & vbTab & "Pi" & vbCrLf
  s = s & " pi/2" & vbTab & vbTab & "1/2 Pi" & vbCrLf
  s = s & " pi/4" & vbTab & vbTab & "1/4 Pi" & vbCrLf
  s = s & " ®" & vbTab & vbTab & "Erdradius am Äquator im Metern (Zeichencode ® Alt/0174)" & vbCrLf
  s = s & " ®f" & vbTab & vbTab & "Abplattung des Erdellipsoides (Polradius ist ®-®f*®)" & vbCrLf
  s = s & " º(" & vbTab & vbTab & "Faktor, der Grad in Bogenmaß umrechnet. (Zeichencode ° Alt/0176)" & vbCrLf
  s = s & " (º" & vbTab & vbTab & "Faktor, der Bogenmaß in Gradmaß umrechnet. (Grad=Alt/0176)" & vbCrLf
  s = s & " eps" & vbTab & vbTab & "Kleinste mögliche Zahl über Null" & vbCrLf
  s = s & " max" & vbTab & vbTab & "Größte zulässige Zahl" & vbCrLf
  s = s & " r0 ... r7" & vbTab & "8 allgemeine Register" & vbCrLf
  s = s & " x" & vbTab & "y" & vbTab & "gegebene, zu transformierende Koordinaten " & vbCrLf
  s = s & " x'" & vbTab & "y'" & vbTab & "gesuchte, transformierte Koordinaten " & vbCrLf
  s = s & " z" & vbTab & vbTab & "eine Testvariable" & vbCrLf
  s = s & " z'" & vbTab & vbTab & "eine Testvariable" & vbCrLf
  s = s & " Rx" & vbTab & "Ry" & vbTab & "Äquatorialradius im Quellbild-Geokoordinatenmaß (x-/y-Richtung) " & vbCrLf
  s = s & " Rx'" & vbTab & "Ry'" & vbTab & "Äquatorialradius im Zielbild-Geokoordinatenmaß (x-/y-Richtung) " & vbCrLf
  s = s & " Cx" & vbTab & "Cy" & vbTab & "Bildmittelpunkt im Quellbild-Geokoordinatenmaß (x-/y-Richtung) " & vbCrLf
  s = s & " Cx'" & vbTab & "Cy'" & vbTab & "Bildmittelpunkt im Zielbild-Geokoordinatenmaß (x-/y-Richtung)" & vbCrLf
  s = s & vbCrLf
  s = s & vbCrLf
    
  s = s & "5.  E i n -   u n d   A u s g a b e " & vbCrLf & vbCrLf
  
  s = s & "Es gibt drei Möglichkeiten, Zahlenwerte in ein Assemblerprogramm ein- und auszugeben: "
  s = s & "Dialoge, einen globalen Ausgabetext und Dateien. " & vbCrLf & vbCrLf
    
  s = s & "Dialoge: Mit den Befehlen input und output können Variablen über Textfenster "
  s = s & "eingegeben und angezeigt werden. In diese Gruppe gehören auch die Befehle "
  s = s & "pause, proof und info. " & vbCrLf & vbCrLf
  
  s = s & "Globaler Ausgabetext: Es gibt einen globalen Ausgabetext, in den beliebige Texte mit den Befehlen "
  s = s & "printn und prints geschrieben werden können. Der Ausgabetext kann mit dem cls-Befehl gelöscht und mit "
  s = s & "dem save-Befehl als Datei gespeichert werden. " & vbCrLf & vbCrLf
  
  s = s & "Dateien: Mit den Befehlen write und read lassen sich Variablen in Dateien abspeichern "
  s = s & "und wieder einlesen. Diese Dateien sind gewöhnliche Textdateien mit dem Dateityp „.dat“, "
  s = s & "der Dateiname ist der Variablenname. Man kann auch mehrere Variablen speichern, indem man "
  s = s & "den zweiten Operanden mit einem Wert > 0 belegt. Dieser gibt dann die Anzahl der Symbole "
  s = s & "vermindert um 1 an, die fortlaufend aus der Symboltabelle übertragen werden. Mit b=0 wird also eine einzelne Zahl, "
  s = s & "mit b=1 zwei Werte, mit b=2 drei 3 Werte usw. übertragen. " & vbCrLf & vbCrLf
    
  s = s & "" & vbCrLf
  
  s = s & "6.  F e l d e r   u n d   P o i n t e r" & vbCrLf & vbCrLf
  
  s = s & "Felder" & vbCrLf & vbCrLf
      
  s = s & "Der Befehl „_dim a 10“ definiert zunächst ein gewöhnliches Symbol a. "
  s = s & "Weiterhin werden 11 weitere Symbole mit den Namen "
  s = s & "a(0), a(1), a(2), a(3) ... a(10) erzeugt. Dies sind die Feldelemente. "
  s = s & "Schließlich trägt _dim auf a die Nummer der Zeile, auf welcher a(0) in der Symboltabelle steht, ein. "
  s = s & "Damit wird a zu einem Pointer auf das Feld („Feldpointer“). " & vbCrLf & vbCrLf
  
  s = s & "Der Pointerzugriff" & vbCrLf & vbCrLf
  
  s = s & "Die Befehle put und get realisieren den Pointerzugriff, bei dem ein Symbol nicht direkt über seinen Namen, sondern indirekt angesprochen wird. "
  s = s & "Diese Befehle enthalten als Operanden einen Pointer p sowie einen Offset q. Pointer und Offset "
  s = s & "ergeben zusammengerechnet die Adresse des Symbols, welches geschrieben/gelesen wird. "
  s = s & "Auf diese Art liefert der Befehl „get z a i“ das Feldelement Nr. i des Feldes a nach z. "
  s = s & "Der Befehl „put b j 22“ schreibt eine 22 auf das j-te Element des Feldes b. " & vbCrLf & vbCrLf
  
  s = s & "Pointer sind nicht unbedingt an Felder gebunden. Man kann mit Ihnen auch auf gewöhnliche "
  s = s & "Symbole zugreifen. Die Symboladresse stellt der Befehl adrof bereit. " & vbCrLf & vbCrLf
  
  s = s & "Auch können mit _dim, put, get und adrof Stacks, Matrizen, Listen und ähnliche Datenstrukturen organisiert werden. "
  s = s & "Wenn der Offset q bei put oder get nicht benötigt wird, so setze man ihn einfach auf das Leersymbol „.“ " & vbCrLf & vbCrLf
    
  s = s & "Die Befehle read und write für Felder" & vbCrLf & vbCrLf
    
  s = s & "Mit den Befehlen read und write kann man auch Felder lesen bzw. schreiben. "
  s = s & "Hierfür ist als 2. Operand der Index des letzten zu schreibenden Feldelementes plus 1 anzugeben. Auf der ersten Dateizeile "
  s = s & "steht dann jeweils der Feldpointer, auf der zweiten Dateizeile das nullte Feldelement. "
  s = s & "Der Feldpointer hat nach einem write in der Datei einen Wert ohne Bedeutung. "
  s = s & "Nach dem Lesen mit dem read-Befehl ist der Feldpointer in der Symboltabelle dann falsch eingestellt. Darum soll er nach einem read "
  s = s & "immer mit dem adrof-Befehl richtig eingestellt werden. Dies erfolgt z. B. mit „adrof  f  f(0)“." & vbCrLf & vbCrLf
  
  s = s & "Hinweise" & vbCrLf & vbCrLf
    
  s = s & "Es gibt keine Pointerüberprüfung. Mit falschen Pointern kann man sich sehr schnell die Symboltabelle "
  s = s & "zerstören, darum bitte "
  s = s & vbCrLf
  s = s & "  · Felder müssen mit _dim deklariert werden. " & vbCrLf
  s = s & "  · Die Feldlänge im _dim-Befehl unbedingt als Zahl angeben. Variablen gelten als 0." & vbCrLf
  s = s & "  · Symbolnamen wie „a(64)“ ausschließlich für Feldelemente nutzen. " & vbCrLf
  s = s & "  · Symbolnamen wie „a(b)“ besser nicht verwenden. " & vbCrLf
  s = s & "  · Beim put-Befehl in Felder auf korrekten Pointer und Offset achten. " & vbCrLf
  s = s & "  · Beim read-Befehl in Felder niemals zu große Feldlängen angeben. " & vbCrLf
  
  
  s = s & vbCrLf & vbCrLf
  
  s = s & "7.  A b a r b e i t e n   u n d   D e b u g g e n " & vbCrLf & vbCrLf
  
  s = s & "Es gibt 3 Programmabarbeitungsmodi: 0=Abarbeitung 'Ohne Halt', 1=Abarbeitung "
  s = s & "mit 'Fehlerhalt', 2='Schrittweise' Abarbeitung. Den Modus kann man an der "
  s = s & "Benutzeroberfläche einstellen oder mit dem Befehl mode "
  s = s & "setzen. " & vbCrLf & vbCrLf
  
  s = s & "Weiterhin gibt es zwei Signale, mit denen man das laufende Programm beeinflussen "
  s = s & "kann. " & vbCrLf & vbCrLf
  
  s = s & "Das Haltsignal bewirkt eine Programmunterbrechung nach dem laufenden Befehl. Es "
  s = s & "kann vom Debugger aus oder mit dem halt-Befehl gesetzt werden. " & vbCrLf & vbCrLf
  
  s = s & "Das Abbruchsignal bewirkt eine sofortige Programmbeendigung. Es wirkt wie "
  s = s & "der exit-Befehl und kann auch mit dem Z-Interrupt (Ctrl/Z) ausgelöst werden. " & vbCrLf & vbCrLf
  
  s = s & vbCrLf
  
  s = s & "8.  A n m e r k u n g e n  " & vbCrLf & vbCrLf
  
  s = s & "Zahlen: Alle Symbole sind immer vom Datentyp Double-Gleitkomma. "
  s = s & "Es sind Zahlenbeträge bis ±1E99 zulässig, intern sogar bis ±1E308. "
  s = s & "Die Berechnungen erfolgen auf 14 Dezimalstellen genau. "
  s = s & "Es gilt die Faustregel: Über 100.000.000.000.000 kann es "
  s = s & "zu Einschränkungen der Genauigkeit kommen. " & vbCrLf & vbCrLf
  
  s = s & "Symbolnamen: Symbolnamen können beliebige Sonderzeichen enthalten und es werden auch Groß- und Kleinbuchstaben "
  s = s & "unterschieden. Die Klammern ( ) werden allerdings vom dim-Befehl benutzt und sollten deshalb nicht andersweitig verwendet werden. "
  s = s & vbCrLf & vbCrLf

  s = s & "Dateinamen: "
  s = s & "Die Befehle read, write und save dulden in Dateinamen nur die Sonderzeichen "
  s = s & "_, $, ( und ). Andere Sonderzeichen werden in Unterstrich umkodiert. Auch werden Großbuchstaben in Kleinbuchstaben umgewandelt. "
  s = s & "Daher sollten hier Sonderzeichen außer _, $, ( und ) und Großbuchstaben nicht genutzt werden. "
  s = s & vbCrLf & vbCrLf
    
  s = s & "Das Leersymbol: Fehlen Operanden (Symbole) in Befehlen, so tritt an ihre Stelle das Leersymbol. "
  s = s & "So werden fehlende Operanden mit Null gelesen. Das ist fast immer sinnvoll. "
  s = s & vbCrLf & vbCrLf

  s = s & "Leersymbol und Befehlszeiger: Die Symbole . und .. sind nicht beschreibbar. Diese Symbole enthalten immer "
  s = s & "den Wert 0 bzw. die Zeilennummer des aktuellen Befehls. Alle anderen Symbole, also auch z. B. „2“, "
  s = s & "„10“, oder „pi“ lassen sich beschreiben. So sollte man aber nicht programmieren."
  s = s & vbCrLf & vbCrLf
    
  s = s & "Kein Deklarationszwang: Jedes Symbol wird bei seiner erstmaligen "
  s = s & "Verwendung automatisch in die Symboltabelle eingetragen. Symbole brauchen also nicht deklariert "
  s = s & "zu werden. Dessenungeachtet ist eine "
  s = s & "Deklaration mit dem _var-Befehl sinnvoll. Die Symboltabelle wird so besser lesbar und Doppeldeklarationen "
  s = s & "infolge von Tippfehlern sammeln sich „unten“ in der Symboltabelle an. Dort können sie schnell entdeckt werden. "
  s = s & "Felder müssen allerdings immer (mit _dim) deklariert werden (sonst weiß der Assembler ja nicht, wie lang sie sein sollen)."
  s = s & vbCrLf & vbCrLf
    
  s = s & "Veraltet: Der »Vater« von Retro ist der Z17-Assembler. Dessen Befehle max, eps, com, sft, sftl, sftr, sftd, sftdr, sftdl, sftp, sftpl, sftpr, "
  s = s & "int, rnd, pow, sqr, toa, tob, toc, tod, froma, fromb, fromc, fromd, valid, rec und end "
  s = s & "werden von Retro nicht unterstützt. "
  s = s & vbCrLf & vbCrLf
  s = s & vbCrLf
      
  s = s & "9.  F e h l e r c o d e s " & vbCrLf & vbCrLf
  
  s = s & "101: Überlauf. Betrag > 9E99" & vbCrLf
  s = s & "102: Division durch 0" & vbCrLf
  s = s & "103: Potenz 0 hoch 0" & vbCrLf
  s = s & "104: Rationale Potenz von Zahl < 0" & vbCrLf
  s = s & "105: Rationale oder gerade Wurzel aus Zahl < 0" & vbCrLf
  s = s & "106: Wurzelexponent 0" & vbCrLf
  s = s & "107: Logarithmus aus Zahl < 0" & vbCrLf
  s = s & "108: Logarithmus aus 0" & vbCrLf
  s = s & "109: Logarithmenbasis < 0" & vbCrLf
  s = s & "110: Logarithmenbasis 0" & vbCrLf
  s = s & "111: Logarithmenbasis 1" & vbCrLf
  s = s & "112: Funktionswert nicht definiert" & vbCrLf
  s = s & "113: Dateifehler" & vbCrLf
  s = s & "114: [frei]" & vbCrLf
  s = s & "115: [frei]" & vbCrLf
  s = s & "116: Unbekannter Befehl" & vbCrLf
  s = s & "117: Symbol nicht definiert" & vbCrLf
  s = s & "118: Symbol bereits definiert" & vbCrLf
  s = s & "119: Symboltabelle voll" & vbCrLf
  s = s & "120: Symbolname länger als 1024 Zeichen" & vbCrLf
  s = s & "121: [frei]"
    s = s & vbCrLf

  RTAGenerateHelpText = s
End Function