' This is file h_2_bi_Main.bas
' (C) 2010-2011 by TJF, GPLv3
' It's part of 'h_2_bi.bas' package, see for details:
' http://www.freebasic.net/forum/viewtopic.php?t=15364&postdays=0&postorder=asc&start=0

TYPE H_2_Bi
  DECLARE CONSTRUCTOR
Private:
  AS ErrorHandler PTR Er
  AS CFileReader PTR In
  AS BiWriter PTR Ou
  AS Options PTR Op
  AS Macros PTR Ma
  AS Config PTR Co
  AS STRING Tex, Nam, Typ
  AS UBYTE Af
  AS INTEGER Kl, ModI, ModO, Ebne, BlNr, BlAZ, BlCo
  AS STRING BlXx, BlRp, BlVo
  AS STRING Einr, Tabz
  AS STRING IfNa, BlTy

  DECLARE FUNCTION Act(BYREF F AS STRING) AS INTEGER
  DECLARE FUNCTION Line_() AS STRING
  DECLARE FUNCTION PreCo() AS STRING
  DECLARE FUNCTION Block(BYVAL A AS INTEGER = 0) AS STRING

  DECLARE FUNCTION addZStrDim(BYVAL A AS INTEGER, BYVAL E AS INTEGER, BYVAL M AS INTEGER) AS STRING
  DECLARE FUNCTION addPTR(BYVAL A AS INTEGER, BYVAL E AS INTEGER) AS STRING
  DECLARE FUNCTION addTypeDim(BYVAL A AS INTEGER, BYVAL E AS INTEGER) AS STRING
  DECLARE FUNCTION genDefLine(BYREF Pr AS STRING) AS STRING
  DECLARE FUNCTION genFieldDim(BYREF Di AS STRING, BYVAL Zp AS INTEGER) AS STRING
  DECLARE FUNCTION ParaList(BYVAL A AS INTEGER, BYVAL L AS INTEGER) AS STRING
  DECLARE SUB checkNaTy()
  DECLARE SUB checkTy()
  DECLARE SUB translate()

  DECLARE FUNCTION UnsaveDefine() AS INTEGER
  DECLARE FUNCTION checkCast(BYVAL Aa AS INTEGER, BYVAL Ee AS INTEGER, _
                   BYREF Lt AS INTEGER, _
                   Pa() AS STRING) AS INTEGER
  DECLARE FUNCTION genCast(BYREF P AS INTEGER, BYREF Lt AS INTEGER) AS INTEGER
  DECLARE FUNCTION genLogic(BYREF T AS STRING, BYVAL Mo AS INTEGER = 0) AS STRING
  DECLARE FUNCTION genIfComment(BYVAL Mo AS INTEGER = 0) AS STRING
  DECLARE SUB genIif(BYVAL Aa AS INTEGER, BYVAL Lt AS INTEGER)
  DECLARE SUB genQuoteNLogic(BYREF T AS STRING, BYVAL Aa AS INTEGER, _
                             BYREF Lt AS INTEGER, BYVAL Mo AS INTEGER = 0)

  DECLARE FUNCTION BlockENUM() AS STRING
  DECLARE FUNCTION BlockTyUn() AS STRING
  DECLARE SUB BlockName(BYVAL Mo AS INTEGER)
  DECLARE SUB read2(BYREF S AS STRING, BYVAL Mo AS INTEGER = 0)
END TYPE

CONSTRUCTOR H_2_Bi
  Op = NEW Options(COMMAND)
  VAR allJobs = ""
  IF Op->RunMod <> 1 THEN '                                    Geany mode
    MSG_WELLCOME
    IF LEN(Op->Msg) THEN ? Op->Msg
    SELECT CASE AS CONST Op->RunMod
    CASE 0
      ? "  Directory: " & CURDIR
      IF LEN(COMMAND) THEN
        ? "   Cmd-line: " & COMMAND;
      ELSE
        ? "  Default configuration (no parameters specified).";
      END IF
    CASE 2 : MSG_VERSION : DELETE Op : EXIT CONSTRUCTOR
    CASE ELSE : MSG_HELP : DELETE Op : EXIT CONSTRUCTOR
    END SELECT
  END IF

  VAR a = 1, e = INSTR(a, Op->Jobs, CHR(1)), e1 = 0
  DO
    VAR n = MID(Op->Jobs, a, e - a)
    IF checkH2Bi(n, Op->RunMod) THEN allJobs &= n & CHR(1)
    a = e + 1 : e = INSTR(a, Op->Jobs, CHR(1))
  LOOP UNTIL e <= 1

  IF Op->RunMod = 1 THEN '                                    Geany mode
    NL = CHR(10)
    IF LEN(allJobs) <= 1 THEN allJobs = GEANY_FILE & !"\001" : CHDIR EXEPATH
  ELSE
    IF LEN(allJobs) <= 1 THEN DELETE Op : EXIT CONSTRUCTOR
  END IF

  DO '                                            all Jobs (.h2bi-files)
    VAR a1 = e1 + 1 : e1 = INSTR(a1, allJobs, CHR(1)) : IF e1 <= a1 THEN EXIT DO
    VAR job = MID(allJobs, a1, e1 - a1)
    In = NEW CFileReader(job & H2BI_FILE_SUFFIX)
    IF LEN(In->Erro) THEN
      ?In->Erro
    ELSE
      Er = NEW ErrorHandler(Op->O.ER + 2 * Op->O.ET)
      Co = NEW Config(In, Op) : IF Op->RunMod <> 1 THEN ? NL & Co->Msg;
      Ma = NEW Macros(Co->Macros, Op, Er)
      BlCo = Op->FLI AND FLI_MASK_CC
      Op->I.COMM = Op->I.SHCC
      IF Op->Tabs < 0 THEN Tabz = !"\t" ELSE Tabz = STRING(Op->Tabs, 32)
      IF Op->RunMod = 1 THEN '                                Geany mode
        Ou = NEW BiWriter("", Co, Op, Ma, In, Er)
        IF Ou->Deep = 0 THEN Act("")
        DELETE Ou
      ELSE '                                                   File mode
        VAR a2 = 1, e2 = INSTR(a2, Co->FNams, ";")
        IF Op->O.SI THEN '                          all-in-one file mode
          genTestBas(job, job & ".h;")
          Ou = NEW BiWriter(job, Co, Op, Ma, In, Er)
          IF Ou->Deep = 0 THEN
            WHILE e2 > a2
              IF Act(MID(Co->FNams, a2, e2 - a2)) THEN ? Tex
              a2 = e2 + 1 : e2 = INSTR(a2, Co->FNams, ";")
            WEND
          END IF : DELETE Ou
        ELSE '                                          single file mode
          genTestBas(job, Co->FNams)
          WHILE e2 > a2
            VAR fn = MID(Co->FNams, a2, e2 - a2)
            VAR a1 = INSTRREV(fn, ANY "\/") + 1, e1 = INSTRREV(fn, ".")
            Ou = NEW BiWriter(MID(fn, a1, e1 - a1), Co, Op, Ma, In, Er)
            IF Ou->Deep = 0 THEN IF Act(fn) THEN ? Tex
            DELETE Ou
            a2 = e2 + 1 : e2 = INSTR(a2, Co->FNams, ";")
          WEND
        END IF
      END IF
      DELETE Ma
      DELETE Co
      DELETE Er
    END IF : DELETE In
  LOOP : DELETE Op
END CONSTRUCTOR

' translation
' wertet Eingabe aus (.h oder stdin)
FUNCTION H_2_Bi.Act(BYREF F AS STRING) AS INTEGER
  VAR r = Ou->IncEbne(F) : IF r THEN In = r ELSE Tex = F : RETURN -1
  IF Op->RunMod <> 1 THEN ? "==> "; F
  WHILE In->weGo() : Einr = ""
    read2(!";#{}=")
    SELECT CASE AS CONST In->LaCh()
    CASE 0
      IF LEN(In->Tex) THEN In->Tex = "' " & In->Tex & " ???"
      Ou->add(In->Tex) : EXIT WHILE
    CASE ASC("#") : Ou->add(PreCo())
    CASE ASC("}") : Ou->add(Block())
    CASE ASC("{")
      VAR i = 0 : i = IIF(nextWord(In->Tex, i) = "typedef", i, 0)
      Ou->add(Block(i))
    CASE ASC(";"), ASC("="), ASC(!"\n")
      IF In->LaCh() = ASC("=") THEN
        In->Tex &= "=" : IF In->weGO() THEN read2(";") ' !!! #-PreCo Zeilen
      END IF : IF LEN(In->Tex) THEN Ou->add(Line_())
    CASE ELSE
      Ou->add("' " & In->Tex & " ??? Unknown termination") : EXIT WHILE
    END SELECT : In->newTex()
  WEND
  In = Ou->DecEbne() : RETURN 0
END FUNCTION

' reads to one of the S characters, Mo = 1 : new block
' liest bis zu einem der Zeichen von S, Mo = 1 : neuer Block
SUB H_2_Bi.read2(BYREF S AS STRING, BYVAL Mo AS INTEGER = 0)
  IF Mo THEN In->newTex()
  WHILE In->weGo()
    In->readTo(S)
    VAR bl = STACK_NEW : In->Tex = Ma->expand(In->Tex, bl)
    Kompri(In->Tex, 1)
    IF In->LaCh() <> ASC(!"\n") THEN EXIT WHILE
    IF LEN(In->Tex) THEN EXIT WHILE
  WEND
END SUB

' returns matching comment for '#endif'
' liefert passenden Kommentar fuer '#endif'
FUNCTION H_2_Bi.genIfComment(BYVAL Mo AS INTEGER = 0) AS STRING
  IF Op->O.MI = 0 ORELSE LEN(IfNa) = 0 THEN RETURN ""
  VAR p = INSTRREV(IfNa, CHR(1)) : IF Mo THEN RETURN " ' " & MID(IfNa, p + 1)
  VAR r = MID(IfNa, p + 1) : IfNa = LEFT(IfNa, p - 1) : RETURN " ' " & r
END FUNCTION

' generates a line for ZSTRING declaration
' erzeugt eine Deklarationszeile fuer ZSTRING
FUNCTION H_2_Bi.addZStrDim(BYVAL A AS INTEGER, BYVAL E AS INTEGER, BYVAL M AS INTEGER) AS STRING
  VAR t = MID(Nam, A, E - A)
  IF MID(Nam, A, 4) = "*" & NO_DIM THEN
    IF INSTR(t, "=") THEN
      VAR az = INSTRREV(t, """") - INSTR(t, """") - 1
      t = "*" & STR(az) & MID(t, 5) : Er->E.USDI = 1
    ELSE
      MID(t, 1, 4) = " PTR" : Er->E.NODI = 1
    END IF
  END IF : IF INSTR(t, NO_DIM) THEN Er->E.NODI = 1
  VAR p = INSTR(t, "(") : IF M ORELSE p = 0 THEN RETURN "AS " & Typ & t
  VAR sp = INSTR(t, " ") + 1, r = MID(t, sp, p - sp) & NL & Tabz & "AS "
  RETURN r & Typ & LEFT(t, sp - 1) & TYKENN & MID(t, p) & NL & "END TYPE"
END FUNCTION

' generates a line for PTR declaration
' erzeugt eine Deklarationszeile fuer PTR
FUNCTION H_2_Bi.addPTR(BYVAL A AS INTEGER, BYVAL E AS INTEGER) AS STRING
  IF MID(Nam, E - 4, 3) = NO_DIM THEN RETURN " PTR " & MID(Nam, A, E - 5 - A)
  RETURN MID(Nam, A, E - A)
END FUNCTION

' generates a line for TYPE declaration
' erzeugt eine Deklarationszeile fuer TYPE
FUNCTION H_2_Bi.addTypeDim(BYVAL A AS INTEGER, BYVAL E AS INTEGER) AS STRING
  VAR p = INSTR(A, Nam, "("), r = MID(Nam, A, p - A) & NL & Tabz & "AS "
  RETURN r & Typ & " " & TYKENN & MID(Nam, p, E - p) & NL & "END TYPE"
END FUNCTION

#DEFINE SET_CODE(_V_) Op->I.CODE = Op->I._V_ : IF Op->T._V_ = 0 THEN RETURN "" ELSE

' generates line to define one (or more) type(s)
' erzeugt Zeile(n) zur Definition von Typen
' ModO = output modus
' Bit 0: multi names (default single)
' Bit 1: fields/dims (default none)
' Bit 2: other/ZSTRING
' Bit 3: SUB
' Bit 4: Function
FUNCTION H_2_Bi.genDefLine(BYREF Pr AS STRING) AS STRING
  SELECT CASE AS CONST ModO
  CASE 0 '                                         one name, normal type
    IF ASC(Pr) <> ASC("T") THEN RETURN Pr & "AS " & Typ & " " & Nam
    RETURN Pr & Nam & " AS " & Typ
  CASE 1 '                                   multiple names, normal type
    RETURN Pr & "AS " & Typ & " " & Nam
  CASE 2, 3 '                                one or multiple names, dims
    VAR p = INSTR(Nam, !"\t") + 1
    IF ASC(Pr) <> ASC("T") THEN
      VAR aa = 0, ee = p - 2, ln = LEN(Nam) - 1
      VAR r = Pr & "AS " & Typ & " "
      IF p > 1 THEN r &= LEFT(Nam, p - 2) & ", "
      DO
        aa = ee + 2 : ee = findBlockEnd(Nam, aa, ln, ASC(",")) + 1
        IF ee <= aa THEN ee = ln + 2
        r &= MID(Nam, aa, ee - aa) & ", "
      LOOP UNTIL ee >= ln : RETURN RTRIM(r, ", ")
    END IF '                                                        TYPE
    VAR r = "", aa = 0, ee = p - 2, ln = LEN(Nam) - 1
    IF p > 1 THEN r = Pr & "AS " & Typ & " " & LEFT(Nam, p - 2) & NL
    DO
      aa = ee + 2 : ee = findBlockEnd(Nam, aa, ln, ASC(",")) + 1
      IF ee > aa THEN r &= Pr & addTypeDim(aa, ee) & NL ELSE EXIT DO
    LOOP : RETURN r & Pr & addTypeDim(aa, ln + 2)
  CASE 4, 5 '                                                  undefined
  CASE 6, 7 '                             one or multiple names, ZSTRING
    VAR p = INSTR(Nam, !"\t") + 1, fl = ASC(Pr) <> ASC("T")
    VAR r = "", aa = 0, ee = p - 2, ln = LEN(Nam) - 1
    IF p > 1 THEN r = Pr & "AS UBYTE " & LEFT(Nam, p - 2) & NL
    DO
      aa = ee + 2 : ee = findBlockEnd(Nam, aa, ln, ASC(",")) + 1
      IF ee > aa THEN r &= Pr & addZStrDim(aa, ee, fl) & NL ELSE EXIT DO
    LOOP : RETURN r & Pr & addZStrDim(aa, ln + 2, fl)
  CASE ELSE '                                               SUB/FUNCTION
    IF ASC(Pr) = ASC(Tabz) THEN RETURN Pr & Nam & " AS " & Typ
    IF Op->T.PT THEN IF STACK_FIN(Ou->SuFu, Nam) = 0 THEN STACK_ADD(Ou->SuFu, Nam)
    IF ASC(Pr) <> ASC("D") THEN RETURN Pr & Nam & " AS " & Typ
    SET_CODE(DE)
    SELECT CASE AS CONST ModO
    CASE  8 : RETURN "DECLARE SUB " & Nam & MID(Typ, 4)
    CASE 16 : RETURN "DECLARE FUNCTION " & Nam & MID(Typ, 9)
    CASE 40, 48 : RETURN Pr & Nam & " AS " & Typ '      function pointer
    END SELECT
  END SELECT : Er->E.UNDE = 1 : RETURN Pr & Nam & " AS " & Typ
END FUNCTION

' translates a single line
' uebersetzt einzelne Zeile
FUNCTION H_2_Bi.Line_() AS STRING
  VAR i = 0, Text = ""
  SELECT CASE nextWord(In->Tex, i)
  CASE "typedef" : SET_CODE(TY) i += 2 : ModI = &b0001011 : Text = "TYPE "
  CASE "struct", "enum", "union", "class"
                   SET_CODE(TY) i = 1  : ModI = &b0001011 : Text = "TYPE "
  CASE "static"  : SET_CODE(ST) i += 2 : ModI = &b0001011 : Text = "STATIC "
  CASE "const"   : SET_CODE(CO) i += 2 : ModI = &b1001010 : Text = "CONST "
  CASE "extern"  : SET_CODE(EX) i += 2 : ModI = &b0011001 : Text = "EXTERN "
  CASE ELSE      : SET_CODE(DI) i = 1  : ModI = &b0001011 : Text = "DIM "
  END SELECT
  Tex = LTRIM(MID(In->Tex, i), TRIMM)
  translate()
  IF Er->E.NONA ANDALSO Er->E.NOTY THEN RETURN ""
  IF Er->E.NOTY THEN
    IF Text[0] = ASC("T") THEN
      IF Op->T.UT ANDALSO STACK_FIN(Ou->TyNa, Nam) = 0 THEN _
         STACK_ADD(Ou->TyNa, Nam) : Typ = Nam & TYKENN
    ELSE
      IF Op->T.AN THEN IF LEN(Typ) THEN Typ = "ANY " & Typ ELSE Typ = "ANY PTR"
    END IF
  ELSE
    IF Op->T.UT ANDALSO _
       Typ = Nam ANDALSO _
       STACK_FIN(Ou->TyNa, Nam) = 0 THEN STACK_ADD(Ou->TyNa, Nam) : Typ = Nam & TYKENN
  END IF : RETURN genDefLine(Text)
END FUNCTION

' generates a FB field dimension
' erzeugt eine FB Feld-Dimensionierung, wenn eingeschaltet
FUNCTION H_2_Bi.genFieldDim(BYREF Di AS STRING, BYVAL Zp AS INTEGER) AS STRING
  VAR i = 1, l = 0, az = 0, t = "", r = ""
  WHILE i < LEN(Di)
    l = CVI(MID(Di, i, 4))
    i += 4
    IF l THEN
      t = TRIM(MID(Di, i, l), TRIMM)
      i += l
      IF LEN(t) THEN
        IF t[0] >= ASC("A") THEN IF Op->T.KW THEN IF checkFbKw(t) THEN t &= TYKENN
        IF Op->O.NT THEN
          r &= "0 TO " & t & "-1"
        ELSE
          l = VALINT(t)
          IF l THEN r &= STR(l - 1) ELSE r &= t & "-1"
        END IF
      ELSE
        r &= NO_DIM
      END IF
    ELSE
      t = NO_DIM : r &= t : Er->E.NODI = 1
    END IF : r &= ", " : az += 1
  WEND : IF Zp = 0 THEN RETURN "(" & RTRIM(r, ", ") & ")"
  Di = t : IF az = 1 THEN RETURN ""
  RETURN "(" & LEFT(r, INSTRREV(RTRIM(r, ", "), ",") - 1) & ")"
END FUNCTION

' replaces array dimensions in VAR names
' ersetzt Feldgroessen in Variablennamen: [5][10] -> (0 TO 5-1, 0 TO 10-1)
SUB H_2_Bi.checkNaTy()
  DIM AS INTEGER l, az, ln = LEN(Nam), e
  DIM AS STRING n, n1, n2, zu, di, al
  VAR zp = IIF(RIGHT(" " & Typ, 8) = " ZSTRING", LEN(Typ) - 6, 0)
  Nam &= ","
  FOR i AS INTEGER = 0 TO ln
    SELECT CASE AS CONST Nam[i]
    CASE ASC("="), ASC(":") '                      init [ : or = {...} ]
      e = findBlockEnd(Nam, i, ln, ASC(","))
      IF BIT(ModI, 1) THEN
        IF e >= 0 THEN
          l = e - i - 1
          zu = " " & CHR(Nam[i]) & " " & LTRIM(MID(Nam, i + 2, l), TRIMM)
          i = 3 : l += 1 : genQuoteNLogic(zu, i, l, 1)
        END IF
      ELSE
        Er->E.NOIN = 1
      END IF : i = e - 1
    CASE ASC("*") '                                                  PTR
      e = findBlockEnd(Nam, i, ln)
      di &= MKI(0)
    CASE ASC("[") '                                 dimension [][xyz][5]
      e = findBlockEnd(Nam, i, ln)
      IF BIT(ModI, 0) THEN
        IF e >= 0 THEN
          l = e - i - 1
          VAR r = MID(Nam, i + 2, l)
          l -= 1 : genQuoteNLogic(r, 0, l, 1)
          di &= MKI(l + 1) & r
        END IF
      ELSE
        Er->E.NODI = 1
      END IF : i = e
    CASE ASC(",")
      IF LEN(n) THEN
        IF Op->O.AL ANDALSO BIT(ModI, 4) THEN al = " ALIAS """ & n & """"
        IF Op->T.KW ANDALSO BIT(ModI, 3) THEN
          IF checkFbKw(n) THEN
            IF BIT(ModI, 4) THEN al = " ALIAS """ & n & """"
            n &= TYKENN
          END IF
        END IF
      ELSE
        Er->E.NONA = 1
      END IF

      IF BIT(ModI, 2) THEN '                         paralist/SuFu modus
        IF Er->E.NODI THEN
          IF LEN(Typ) THEN Typ &= " PTR"
        ELSE
          IF zp THEN Typ = LEFT(Typ, zp - 1) & "UBYTE" : Er->E.NODI = 0
          Typ &= zu
        END IF : Nam = n & al: ModO = 0 : EXIT SUB
      END IF

      IF LEN(di) = 0 ANDALSO LEN(zu) = 0 THEN
        n1 &= n & al & ", " : al = ""
      ELSE
        IF LEN(di) THEN '                           dimension (0 TO ...)
          n &= genFieldDim(di, zp)
          IF zp THEN n = "*" & di & " " & n
          di = ""
        END IF : n2 &= n & zu & ", " : zu = ""
      END IF : n = "" : az += 1
    CASE ELSE
      IF CHAR_TYP(Nam[i]) < 0 THEN n &= CHR(Nam[i])
    END SELECT
  NEXT : az = IIF(az > 1, 1, 0) + IIF(zp, 4, 0)
  IF LEN(n2) = 0 THEN
    IF zp THEN Typ = LEFT(Typ, zp - 1) & "UBYTE" : Er->E.NODI = 0 : az -= 4
    Nam = RTRIM(n1, ", ") : ModO = az : EXIT SUB
  ELSEIF LEN(n1) = 0 THEN
    IF BIT(ModI, 0) = 0 THEN IF LEN(Typ) THEN Typ &= " PTR"
    Nam = RTRIM(n2, ", ") : ModO = 2 + az : EXIT SUB
  END IF : Nam = RTRIM(n1, ", ") & !"\t" & RTRIM(n2, ", ") : ModO = 2 + az
END SUB

' checks types, replaces by definition in TYPES
' prueft types, ersetzt ggf. gemaess TYPES
SUB H_2_Bi.checkTy()
  VAR l = 0, az = 0, fl = 0
  FOR i AS INTEGER = 0 TO LEN(Typ) - 1
    SELECT CASE AS CONST Typ[i]
    CASE 0 : EXIT FOR
    CASE 1 TO 32 : IF l THEN fl = 1
    CASE ASC("*") : az += 1 : IF l THEN fl = 1
    CASE ELSE
      IF fl THEN Typ[l] = ASC(" ") : l += 1 : fl = 0
      Typ[l] = Typ[i] : l += 1
    END SELECT
  NEXT : Typ = LEFT(Typ, l) & " " : l += 1
  VAR r = ""
  WHILE l
    DO
      fl = 1
      WITH Co->Typ_
        VAR a = 6, e = INSTR(.Su, CHR(2))
        WHILE e > a
          VAR ls = e - a : e += 1
          VAR x = INSTR(e, .Su, CHR(1))
          IF LEFT(Typ, ls) = MID(.Su, a, ls) THEN
            Typ = MID(Typ, ls + 1)
            VAR z = SADD(.Er) + VALINT("&H" & MID(.Su, e, x - e))
            *CAST(INTEGER PTR, z - 4) += 1
            l -= ls
            IF z[0] THEN r &= *z & " "
            fl = 0 : EXIT WHILE
          END IF : a = x + 1 : e = INSTR(a, .Su, CHR(2))
        WEND : IF l <= 0 THEN EXIT WHILE
      END WITH
    LOOP UNTIL fl
    VAR p = INSTR(Typ, " ") - 1, n = LEFT(Typ, p)
    IF Op->T.KW THEN IF checkFbKw(n) THEN n &= TYKENN
    IF p <= l THEN r &= n & " " ELSE r &= n : EXIT WHILE
    Typ = MID(Typ, p + 2) : l -= p + 1
  WEND : Typ = RTRIM(r)
  IF LEN(Typ) = 0 THEN
    Er->E.NOTY = 1
  ELSE
    IF Typ = "UNSIGNED" THEN Typ = "UINTEGER"
    IF Op->T.PT THEN IF STACK_FIN(Ou->SuFu, Typ) THEN az -= 1
  END IF : FOR i AS INTEGER = 1 TO az : Typ &= " PTR" : NEXT
END SUB

' generates name and type of a C declination (type may be a FB SUB/FUNCTION)
' wandelt C-Deklaration in Name und Typ (Typ ist ggf. FB SUB/FUNCTION)
' ModI wirkt in: translate, checkNaTy
' 0: allow field dimensioning
' 1: Initialisierung (= ... | : ...)
' 2: only one name (no ,)
' 3: FB keyword check
' 4: ALIAS for name
' 5: parameter list mode
' 6: const mode
SUB H_2_Bi.translate()
  Nam = "" : Typ = "" : Af = 0 : Kl = 0
  VAR p = -2, lt = LEN(Tex) - 1, ka = "", kz = "", a = 0, e = 0, fp = 0
  FOR i AS INTEGER = lt TO 0 STEP -1 '               search for the name
    SELECT CASE AS CONST Tex[i]
    CASE ASC("(")
      kl += 1 : p = -2
      IF kl = 0 THEN IF Af = 0 THEN ka &= MKI(i)
    CASE ASC(")")
      IF kl = 0 THEN IF Af = 0 THEN kz &= MKI(i)
      kl -= 1 : p = -2
    CASE ASC("'"), ASC("""") : checkAf(Af, Tex, i) : p = -2
    CASE ASC("[") : p = -2 : IF Af = 0 THEN kl += 1
    CASE ASC("]") : p = -2 : IF Af = 0 THEN kl -= 1
    CASE ASC("*") : IF p < 0 THEN p = i
    CASE ASC(" ") : IF p = -1 THEN p = i
    CASE ASC(","), ASC(":"), ASC("=") : p = -2
    CASE ELSE : IF p < -1 THEN IF CHAR_TYP(Tex[i]) < -2 THEN p = -1
    END SELECT
  NEXT : VAR mo = ModI
  IF p < 0 THEN IF BIT(mo, 5) THEN p = LEN(Tex) - 1 ' para-list, no name

  SELECT CASE AS CONST LEN(ka)
  CASE 0 '                                                   declaration
    Nam = TRIM(MID(Tex, p + 2), TRIMM)
  CASE 4 '                                                  SUB/FUNCTION
    a = CVI(ka)
    e = CVI(kz)
    VAR l = a - p - 1 : IF l < 0 THEN l = e - p - 1
    Nam = TRIM(MID(Tex, p + 2, l), TRIMM)
    ModI = &b0011100
  CASE ELSE '                                     check FUNCTION pointer
    VAR x = LEN(ka) - 3
    DO
      a = CVI(MID(ka, x, 4))
      e = CVI(MID(kz, x, 4))
      Nam = TRIM(MID(Tex, a + 2, e - a - 1), TRIMM)
      IF INSTR(Nam, TRIMM) THEN x -= 4 : Er->E.ISMA = 1 : CONTINUE DO
      Nam = LTRIM(Nam, "*")
      p = a - 1
      a = CVI(MID(ka, x - 4, 4))
      e = CVI(MID(kz, x - 4, 4))
      IF x > 5 THEN Er->E.ISMA = 1
      fp = 32 : EXIT DO
    LOOP UNTIL x < 5 : ModI = IIF(fp, &b0001100, &b0011100)
  END SELECT
  Typ = LEFT(Tex, p + 1) : checkTy() : checkNaTy() : IF LEN(ka) = 0 THEN EXIT SUB

  Er->shift(SHIFT_SUFU)
  IF INSTR(Nam, ANY ";*") THEN Er->E.CHNA = 1
  VAR na = Nam, ty = " AS ", pl = ""
  IF Typ = "ANY" ANDALSO INSTR(" " & LEFT(Tex, a) & " ", " void ") THEN
    ty = "SUB"
    mo = ModO + 8 + fp
  ELSE
    IF BIT(mo, 6) THEN ty &= "CONST "
    ty &= Typ
    mo = ModO + 16 + fp
  END IF
  IF Op->O.CD THEN
    p = INSTR(na, " ")
    IF p THEN na = LEFT(na, p) & "CDECL" & MID(na, p) ELSE pl = " CDECL"
  END IF
  pl &= ParaList(a + 2, e - a - 1) : IF Er->E.PATY THEN Er->E.ISMA = 1
  Nam = na : ModO = mo
  IF ty[0] = ASC("S") THEN Typ = ty & pl ELSE Typ = "FUNCTION" & pl & ty
END SUB

#MACRO TRANS_PARA(le)
  ModI = &b0101110 : translate() : IF Op->O.BV THEN r &= "BYVAL "
  IF Er->E.NOTY THEN Typ = "???" & Typ
  IF Er->E.NONA THEN
    IF Op->O.NA THEN IF Op->T.UV THEN r &= TYKENN & " " ELSE Er->E.NONA = 0
  ELSE
    IF Op->O.NA THEN r &= Nam & " "
  END IF : Er->shift(SHIFT_PARA) : r &= "AS " & Typ & le
#ENDMACRO

' generates FB parameter list from C parameter list
' generiert FB-Parameterliste aus C-Parameterliste
FUNCTION H_2_Bi.ParaList(BYVAL A AS INTEGER, BYVAL L AS INTEGER) AS STRING
  VAR t = TRIM(MID(Tex, A, L), TRIMM) : IF t = "void" THEN RETURN "()"
  VAR lt = LEN(t) - 1 : IF lt < 0 THEN RETURN "()"
  VAR r = "", le = ", "
  VAR p = 0, e = findBlockEnd(t, 0, lt, ASC(","))
  Einr &= Tabz
  IF Op->O.WR THEN r = " _" & NL & Einr : le &= MID(r, 2)
  WHILE e > p
    Tex = TRIM(MID(t, p + 1, e - p), TRIMM)
    TRANS_PARA(le)
    p = e + 1 : e = findBlockEnd(t, p, lt, ASC(","))
  WEND : Tex = TRIM(MID(t, p + 1), TRIMM)
  IF Tex = "..." THEN
    r &= Tex
  ELSE
    TRANS_PARA("")
  END IF : Einr = LEFT(Einr, LEN(Einr) - LEN(Tabz)) : RETURN "(" & r & ")"
END FUNCTION

' returns 1 if context of () may be a cast (or 0)
' liefert 1 wenn Zeichenkette CAST sein kann, sonst 0
FUNCTION H_2_Bi.checkCast(BYVAL Aa AS INTEGER, BYVAL Ee AS INTEGER, _
                          BYREF Lt AS INTEGER, _
                          Pa() AS STRING) AS INTEGER
  WITH *In
    VAR p = skipTrenn(.Tex, Aa + 1, Lt) : IF CHAR_TYP(.Tex[p]) > -3 THEN RETURN 0
    DIM AS INTEGER i, fl, q
    FOR i = p + 1 TO Ee - 1
      IF CHAR_TYP(.Tex[i]) >= 0 THEN IF INSTR(!" *#\t", CHR(.Tex[i])) = 0 THEN RETURN 0
    NEXT : Typ = RTRIM(MID(.Tex, p + 1, Ee - p), TRIMM)
    checkTy() : IF Er->E.NOTY THEN Er->E.NOTY = 0 : RETURN 0
    IF Op->T.KW THEN
      FOR i = 0 TO UBOUND(Pa) ' remove mangling on macro parameter names
        IF checkFbKw(Pa(i)) THEN STRreplace(Typ, Pa(i) & TYKENN, Pa(i))
      NEXT
    END IF
    p = skipTrenn(.Tex, Ee + 1, Lt) : IF p > Lt THEN RETURN 0
    IF INSTR("*&-+!~", CHR(.Tex[p])) THEN
      fl = -1 : p += 1 : IF Op->T.CU = 0 THEN RETURN 0
    END IF
    p = skipTrenn(.Tex, p, Lt) : IF p <= Lt THEN i = p ELSE RETURN 0

    VAR neu = ""
    IF CHAR_TYP(.Tex[p]) > -2 THEN
      i = INSTR("('""", CHR(.Tex[p])) :IF i = 0 THEN RETURN 0
      IF i = 3 THEN neu &= "@"
      p = findBlockEnd(.Tex, p, Lt) + 1 : IF p < 1 THEN RETURN 0
    ELSE
      WHILE CHAR_TYP(.Tex[p]) < 0 ORELSE .Tex[p] = ASC("#")
        p += 1 : IF p > Lt THEN EXIT WHILE
      WEND : VAR s = "(" : IF p > i THEN s &= "["
      i = skipTrenn(.Tex, p, Lt) : IF i > Lt THEN RETURN 0
      IF INSTR(s, CHR(.Tex[i])) THEN
        p = findBlockEnd(.Tex, i, Lt) + 1 : IF p < 1 THEN RETURN 0
      END IF
    END IF
    neu &= LTRIM(MID(.Tex, Ee + 2, p - Ee - 1)) : IF LEN(neu) = 0 THEN RETURN 0
    IF fl THEN IF Op->O.UC THEN Er->E.USCA = 1 ELSE RETURN 0
    VAR w = *IIF(CHAR_TYP(.Tex[Aa - 1]) < 0, @" ", @"") & "CAST("
    .Tex = LEFT(.Tex, Aa) & w & Typ & ", " & neu & ")" & MID(.Tex, p + 1)
    Lt = LEN(.Tex) - 1
  END WITH : RETURN 1
END FUNCTION

' checks #define line, translates CASTs into FB source, returns start pos
' prueft #define-Zeile, wandelt CASTs in FB Quelltext, liefert Startpos
FUNCTION H_2_Bi.genCast(BYREF P AS INTEGER, BYREF Lt AS INTEGER) AS INTEGER
  VAR n = nextWord(In->Tex, P)
  IF Op->T.KW ANDALSO checkFbKw(n) THEN
    In->Tex = LEFT(In->Tex, P) & TYKENN & MID(In->Tex, P + 1)
    P += LEN(TYKENN) : Lt += LEN(TYKENN)
  END IF : IF P >= Lt THEN RETURN 0
  REDIM AS STRING pa(0)
  IF In->Tex[P] = ASC("(") THEN
    VAR az = Ma->getParList(In->Tex, P, Lt, pa())
  END IF
  IF Op->T.CS = 0 ANDALSO Op->T.CU = 0 THEN RETURN 0
  VAR a = Lt + 1, e = 0, fl = 0
  WHILE a >= P
    e = findBlockEnd(In->Tex, a - 1, P, ASC(")")) : IF e < P THEN RETURN fl
    a = findBlockEnd(In->Tex, e, P) : IF a < P THEN RETURN fl
    IF checkCast(a, e, Lt, pa()) THEN fl += 1
  WEND : RETURN fl
END FUNCTION

#DEFINE AddOp(v1,f1) fl = f1 : r &= *IIF(RIGHT(r, 1) > " ", @" ", @"") & v1

' checks T for C logic, replaces by FB commands and numbers
' prueft T auf C-LogiK-Befehle, ersetzt sie durch FB-Befehle bzw. Zahlen
FUNCTION H_2_Bi.genLogic(BYREF T AS STRING, BYVAL Mo AS INTEGER = 0) AS STRING
  IF Op->T.LO = 0 THEN RETURN T
  VAR fl = 0, lt = LEN(T) - 1 : IF lt <= 0 THEN RETURN T
  DIM AS STRING r, _or, _and, _not
  IF Mo THEN _or = "ORELSE" : _and = "ANDALSO" : _not = "0 = " _
        ELSE _or = "OR" : _and = "AND" : _not = "NOT "
  FOR i AS INTEGER = 0 TO lt
    SELECT CASE AS CONST fl
    CASE 2 '                                                      indent
      SELECT CASE AS CONST T[i]
      CASE ASC(!"\t"), ASC(" ") : r &= " "
      CASE ELSE : fl = 0
      END SELECT
    CASE 3 '                                                     decimal
      SELECT CASE AS CONST T[i]
      CASE ASC("0") TO ASC("9") : r &= CHR(T[i])
      CASE ASC("."), ASC("E"), ASC("e") : r &= CHR(T[i])
      CASE ASC("-"), ASC("+") : r &= CHR(T[i])
      CASE ELSE : fl = 0
      END SELECT
    CASE 4 '                                                 hexadecimal
      SELECT CASE AS CONST T[i]
      CASE ASC("0") TO ASC("9") : r &= CHR(T[i])
      CASE ASC("a") TO ASC("f") : r &= UCASE(CHR(T[i]))
      CASE ASC("A") TO ASC("F") : r &= CHR(T[i])
      CASE ELSE : fl = 0
      END SELECT
    CASE 5 '                                                       octal
      SELECT CASE AS CONST T[i]
      CASE ASC("0") TO ASC("7") : r &= CHR(T[i])
      CASE ELSE : fl = 0
      END SELECT
    CASE 6 '                                                leading zero
      SELECT CASE AS CONST T[i]
      CASE ASC("0") TO ASC("7") : r &= "&o" & CHR(T[i]) : fl = 5
      CASE ASC("8"), ASC("9"), ASC(".") : r &= "0" & CHR(T[i]) : fl = 3
      CASE ASC("x"), ASC("X") : r &= "&h" : fl = 4
      CASE ELSE : r &= "0" : fl = 0
      END SELECT
    CASE 32 : IF T[i] > ASC(" ") THEN r &= " " : fl = 0
    CASE ASC("!")
      SELECT CASE AS CONST T[i]
      CASE ASC("=") : AddOp("<>", 1)
      CASE ELSE : AddOp(_not, 0)
      END SELECT
    CASE ASC(">") : IF T[i] = ASC(">") THEN AddOp("SHR", 32) ELSE AddOp(">", 0)
    CASE ASC("<") : IF T[i] = ASC("<") THEN AddOp("SHL", 32) ELSE AddOp("<", 0)
    CASE ASC("|")
      SELECT CASE AS CONST T[i]
      CASE ASC("|") : AddOp(_or, 32)
      CASE ASC("=") : AddOp("OR=", 1)
      CASE ELSE : AddOp("OR", 0)
      END SELECT
    CASE ASC("&")
      SELECT CASE AS CONST T[i]
      CASE ASC("&") : AddOp(_and, 32)
      CASE ASC("=") : AddOp("AND=", 1)
      CASE ELSE
        IF CHAR_TYP(T[i]) <= -3 ORELSE T[i] = ASC("(") THEN
          r &= "@" : fl = 0
        ELSE
          AddOp("AND", 0)
        END IF
      END SELECT
    CASE ASC("=")
      AddOp("=", IIF(T[i] = ASC("="), 1, 0))
    CASE ELSE : fl = 0
    END SELECT

    IF fl = 0 THEN
      SELECT CASE AS CONST T[i]
      CASE ASC(!"\n")
        fl = LEN(r) : IF fl THEN fl -= 1 : IF r[fl] = ASC("\") THEN r[fl] = ASC("_")
        r &= CHR(T[i]) : fl = 2
      CASE ASC("0") : fl = 6
      CASE ASC("1") TO ASC("9") : r &= CHR(T[i]) : fl = 3
      CASE ASC(!"\t"), ASC(" ") : fl = 32
      CASE ASC("^") : AddOp("XOR", 32)
      CASE ASC("~") : AddOp("NOT", 32)
      CASE ASC("%") : AddOp("MOD", 32)
      CASE ASC("!") : fl = T[i]
      CASE ASC(">") : fl = T[i]
      CASE ASC("<") : fl = T[i]
      CASE ASC("|") : fl = T[i]
      CASE ASC("&") : fl = T[i]
      CASE ASC("=") : fl = T[i]
      CASE ELSE : r &= CHR(T[i])
      END SELECT
    END IF
  NEXT : IF fl > 5 THEN r &= CHR(IIF(fl = 6, ASC("0"), fl))
  STRreplace(r, "defined", "DEFINED")
  STRreplace(r, "sizeof", "SIZEOF") : RETURN r
END FUNCTION

' translates 'x' into ASC("x"), places ! before "
' wandelt 'x' in ASC("x"), ergaenzt ! vor "
SUB H_2_Bi.genQuoteNLogic(BYREF T AS STRING, BYVAL Aa AS INTEGER, _
                          BYREF Lt AS INTEGER, BYVAL Mo AS INTEGER = 0)
  VAR e = Aa, y = "", z = "", r = T
  T = LEFT(T, Aa)
  FOR i AS INTEGER = Aa TO Lt
    IF CHAR_TYP(r[i]) = 3 THEN
      T &= genLogic(MID(r, e + 1, i - e), Mo)
      IF Op->T.QU THEN
        y = "!""" : z = """"
        IF r[i] = ASC("'") THEN y = "ASC(" & y : z &= ")"
        IF RIGHT(T, 2) = " L" THEN y = "WSTR(" & y : z &= ")" : T = LEFT(T, LEN(T) - 1)
      ELSE
        y = CHR(r[i]) : z = y
      END IF
      e = findBlockEnd(r, i, Lt) : IF e < 0 THEN T &= y : e = i + 1 : EXIT FOR
      IF y[0] = ASC("A") THEN IF r[i + 1] = ASC("""") THEN y &= "\"
      T &= y & MID(r, i + 2, e - i - 1) & z
      i = e : e += 1
    END IF
  NEXT : T &= genLogic(MID(r, e + 1), Mo) : Lt = LEN(T) - 1
END SUB

' checks In->Tex for ( ? : )
' prueft In->Tex auf C-Bloecke IIF, ersetzt sie durch FB-Befehle
SUB H_2_Bi.genIif(BYVAL Aa AS INTEGER, BYVAL Lt AS INTEGER)
  VAR i = Lt + 1
  Af = 0
  WITH *In
    DO
      DO
        i -= 1 : IF i < Aa THEN EXIT SUB
        SELECT CASE AS CONST CHAR_TYP(.Tex[i])
        CASE 3 : checkAf(Af, .Tex, i) '              ASC("'"), ASC("""")
        CASE 6 : IF Af = 0 THEN EXIT DO '                       ASC(":")
        END SELECT
      LOOP
      VAR p = findBlockEnd(.Tex, i - 1, Aa, ASC("?")) : IF p < 0 THEN EXIT SUB
      .Tex[i] = ASC(",")
      .Tex[p] = ASC(",")
      p = findBlockEnd(.Tex, i - 1, Aa, ASC("("))
      IF p < 0 THEN p = findBlockEnd(.Tex, i - 1, Aa, ASC("["))
      IF p < 0 THEN .Tex = LEFT(.Tex, Aa) & "IIF(" & MID(.Tex, Aa + 1) & ")" : EXIT SUB
      .Tex = LEFT(.Tex, p) & "IIF" & MID(.Tex, p + 1)
      i += 3
    LOOP
  END WITH
END SUB

' checks if a define line is unsave
' prueft ob eine define Zeile unsicher ist
FUNCTION H_2_Bi.UnsaveDefine() AS INTEGER
  Af = 0
  FOR i AS INTEGER = 0 TO LEN(In->Tex) - 1
    SELECT CASE AS CONST CHAR_TYP(In->Tex[i])
    CASE 3 : checkAf(Af, In->Tex, i)
    CASE 7 : IF Af = 0 THEN Er->E.USDE = 1 : RETURN -1
    END SELECT
  NEXT : RETURN 0
END FUNCTION

' reads one (or multiple) line starting with '#'
' liest eine oder mehrere Zeilen fuer den Praeprozessor
FUNCTION H_2_Bi.PreCo() AS STRING
  In->readLine(1) : Kompri(In->Tex, -1)
  VAR a = 0
  SELECT CASE nextWord(In->Tex, a)
  CASE "include" : SET_CODE(PI) VAR l = LEN(In->Tex) - 1
    a = findBlockEnd(In->Tex, l, 0) : IF a < 0 THEN RETURN genKom("#" & In->Tex)
    VAR fn = MID(In->Tex, a + 2, l - a - 1)
    IF Op->O.SI THEN IF Act(fn) THEN RETURN Tex ELSE RETURN ""
    VAR er = Ou->checkFileNam(fn) : IF LEN(er) THEN RETURN er
    fn = MID(In->Tex, a + 2, l - a - 1)
    RETURN "#INCLUDE ONCE """ & LEFT(fn, INSTRREV(fn, ".")) & "bi"""
  CASE "ifdef"  : SET_CODE(PX)
    IF Op->O.MI THEN IfNa &= CHR(1) & TRIM(MID(In->Tex, a + 2), TRIMM)
    MID(In->Tex, a - 4, 5) = "IFDEF"
  CASE "ifndef" : SET_CODE(PX)
    IF Op->O.MI THEN IfNa &= CHR(1) & TRIM(MID(In->Tex, a + 2), TRIMM)
    MID(In->Tex, a - 5, 6) = "IFNDEF"
  CASE "if"     : SET_CODE(PX) genQuoteNLogic(In->Tex, a, LEN(In->Tex) - 1)
    IF Op->O.MI THEN
      VAR t = CHR(1) & LTRIM(MID(In->Tex, a + 2), TRIMM)
      IF LEN(t) > 16 THEN IfNa &= LEFT(t, 16) & "..." ELSE IfNa &= t
    END IF : MID(In->Tex, a - 1, 2) = "IF"
  CASE "elif"   : SET_CODE(PX) genQuoteNLogic(In->Tex, a, LEN(In->Tex) - 1)
    In->Tex = "ELSEIF" & MID(In->Tex, a + 1)
  CASE "else"   : SET_CODE(PX) MID(In->Tex, a - 3, 4) = "ELSE"
    In->Tex &= genIfComment(1)
  CASE "endif"  : SET_CODE(PX) MID(In->Tex, a - 4, 5) = "ENDIF"
    In->Tex &= genIfComment()
  CASE "error"  : SET_CODE(PE) MID(In->Tex, a - 4, 5) = "ERROR"
  CASE "undef"  : SET_CODE(PU) MID(In->Tex, a - 4, 5) = "UNDEF"
  CASE "define" : SET_CODE(PD) MID(In->Tex, a - 5, 6) = "DEFINE"
    VAR lt = LEN(In->Tex) - 1
    IF a >= lt THEN Er->E.NOMN = 1 : RETURN genKom("#" & In->Tex)
    IF genCast(a, lt) THEN Op->I.CODE OR= Op->I.CA
    genQuoteNLogic(In->Tex, a, lt, 1)
    IF Op->T.II THEN genIif(a, lt)
    IF UnsaveDefine() THEN IF Op->O.UD THEN RETURN genKom("#" & In->Tex)
  CASE ELSE : RETURN genKom("#" & In->Tex)
  END SELECT : RETURN "#" & In->Tex
END FUNCTION

#MACRO OP_I_BLCO(_N_, _M_)
  IF Op->I.BLCO THEN
    c = In->readCCom(BlCo + _M_) : IF LEN(c) THEN r &= _N_ & c
  END IF
#ENDMACRO

' generating FB lines for ENUM block
' erzeugt FB-Zeilen eines ENUM-Blockes
FUNCTION H_2_Bi.BlockENUM() AS STRING
  VAR c = "", r = "", a = "" : Typ = "" : BlAZ = 0
  'OP_I_BLCO("0", &b10)
  'OP_I_BLCO("0", &b0)
  'IF Op->I.BLCO THEN r &= In->readCCom(BlCo + &b10)
  'WHILE In->weGo()
    'OP_I_BLCO("1", &b0)
    'read2(",}#", 1)
    ''OP_I_BLCO("1", &b0)
    ''IF Op->I.BLCO THEN r &= ">" & In->readCCom(BlCo + &b10) & "<"
'?CHR(In->LaCh()),r
    'SELECT CASE AS CONST In->LaCh()
    'CASE ASC("#")
      'OP_I_BLCO(NL & "A", 0)
      'r &= NL & PreCo() & Er->show()
    'CASE ASC(","), ASC("}")
      'IF LEN(In->Tex) THEN
        'Nam = In->Tex : ModI = &b0001010 : checkNaTy()
        ''OP_I_BLCO(NL & "B", 0)
        'r &= NL & Tabz
        'IF Er->FLE ANDALSO Op->I.ER THEN r &= genKom(Nam) & NL & Tabz
        'r &= Nam & Er->show() : BlAZ += 1
      'END IF
      'IF In->LaCh() = ASC("}") THEN EXIT WHILE
    'CASE ELSE
      'r &= NL & "' " & In->Tex & " unknown termination ???"
      'OP_I_BLCO(NL & "C", 0)
      'EXIT WHILE
    'END SELECT
  'WEND
  WHILE In->weGo()
    OP_I_BLCO("1", &b0)
    read2(",}#", 1)
    r &= a
    'OP_I_BLCO("1", &b0)
    'IF Op->I.BLCO THEN r &= ">" & In->readCCom(BlCo + &b10) & "<"
'?CHR(In->LaCh()),r
    SELECT CASE AS CONST In->LaCh()
    CASE ASC("#")
      OP_I_BLCO(NL & "A", 0)
      r &= NL & PreCo() & Er->show()
    CASE ASC(","), ASC("}")
'?">";In->Tex;"<"
      IF LEN(In->Tex) THEN
        Nam = In->Tex : ModI = &b0001010 : checkNaTy()
        'OP_I_BLCO(NL & "B", 0)
        a = NL & Tabz
        IF Er->FLE ANDALSO Op->I.ER THEN a &= genKom(Nam) & NL & Tabz
        a &= Nam & Er->show() : BlAZ += 1
      END IF
      IF In->LaCh() = ASC("}") THEN
        OP_I_BLCO("X", &b0)
        r &= a : EXIT WHILE
      END IF
    CASE ELSE
      r &= NL & "' " & In->Tex & " unknown termination ???"
      OP_I_BLCO(NL & "C", 0)
      EXIT WHILE
    END SELECT
  WEND
  OP_I_BLCO("Z", &b0)
  'IF Op->I.BLCO THEN r &= In->readCCom(BlCo + &b10)
  RETURN r
END FUNCTION

' generates FB lines for blocks
' erzeugt FB-Zeilen fuer einen Block (TYPE/UNION)
FUNCTION H_2_Bi.BlockTyUn() AS STRING
  VAR c = "", r = "" : BlAZ = 0
  IF Op->I.BLCO THEN r &= In->readCCom(BlCo + &b10)
  WHILE In->weGo()
    read2(";={}#", 1)
    IF Op->I.BLCO THEN r &= In->readCCom(BlCo + &b10)
    SELECT CASE AS CONST In->LaCh()
    CASE ASC("#")
      OP_I_BLCO(NL, 0)
      r &= NL & PreCo() & Er->show()
    CASE ASC(";"), ASC("=")
      IF In->LaCh() = ASC("=") THEN In->Tex &= "=" : read2(";") ' !!! #-PreCo Zeilen
      IF LEN(In->Tex) = 0 THEN CONTINUE WHILE
      IF Op->I.BLCO THEN
        VAR c = In->readCCom(BlCo) : IF LEN(c) THEN r &= NL & c
      ELSE
        IF Er->FLE ANDALSO Op->I.ER THEN r &= NL & genKom(In->Tex)
      END IF : ModI = &b0000011 : Tex = In->Tex : translate()
      r &= NL & genDefLine(Tabz) & Er->show() : BlAZ += 1
    CASE ASC("{")
      IF Op->I.BLCO THEN r &= NL & genKom(In->Tex) & "{"
      VAR neu = Block()
      IF Op->I.BLCO THEN IF LEN(In->Tex) THEN r &= "} " & In->Tex & ";" ELSE r &= "};"
      r &= NL
      VAR p = INSTR(neu, "AS "), l = LEN(r) ' remember position of nested block names
      WHILE p
        BlRp = MKI(l + p + 3) & BlRp : p = INSTR(p + 1, neu, "AS ")
      WEND : r &= neu & Er->show() : BlAZ += 1
    CASE ELSE
      IF In->LaCh() <> ASC("}") THEN r &= NL & "' " & In->Tex & " unknown termination ???"
      OP_I_BLCO(NL, 0)
      EXIT WHILE
    END SELECT
  WEND : RETURN r


  'WHILE In->weGo()
    'OP_I_BLCO("1", &b0)
    'read2(";={}#", 1)
    ''IF Op->I.BLCO THEN r &= In->readCCom(BlCo + &b10)
    'SELECT CASE AS CONST In->LaCh()
    'CASE ASC("#")
      ''OP_I_BLCO(NL, 0)
      'r &= NL & PreCo() & Er->show()
    'CASE ASC(";"), ASC("=")
      'IF In->LaCh() = ASC("=") THEN In->Tex &= "=" : read2(";") ' !!! #-PreCo Zeilen
      'IF LEN(In->Tex) = 0 THEN CONTINUE WHILE
      'IF Op->I.BLCO THEN
        'VAR c = In->readCCom(BlCo) : IF LEN(c) THEN r &= NL & c
      'ELSE
        'IF Er->FLE ANDALSO Op->I.ER THEN r &= NL & genKom(In->Tex)
      'END IF : ModI = &b0000011 : Tex = In->Tex : translate()
      'r &= NL & genDefLine(Tabz) & Er->show() : BlAZ += 1
    'CASE ASC("{")
      'IF Op->I.BLCO THEN r &= NL & genKom(In->Tex) & "{"
      'VAR neu = Block()
      'IF Op->I.BLCO THEN IF LEN(In->Tex) THEN r &= "} " & In->Tex & ";" ELSE r &= "};"
      'r &= NL
      'VAR p = INSTR(neu, "AS "), l = LEN(r) ' remember position of nested block names
      'WHILE p
        'BlRp = MKI(l + p + 3) & BlRp : p = INSTR(p + 1, neu, "AS ")
      'WEND : r &= neu & Er->show() : BlAZ += 1
    'CASE ELSE
      'IF In->LaCh() <> ASC("}") THEN r &= NL & "' " & In->Tex & " unknown termination ???"
      'OP_I_BLCO(NL, 0)
      'EXIT WHILE
    'END SELECT
  'WEND : RETURN r
END FUNCTION

' checks names of blocks
' prueft Namen eines Blockes, liefert ggf auch TYPE-Zeile in Nam
SUB H_2_Bi.BlockName(BYVAL Mo AS INTEGER)
  IF LEN(Typ) THEN '                                         block Typ {
    IF LCASE(Typ) = LCASE(Nam) THEN Nam = ""
    IF Mo < 2 THEN IF Op->T.KW THEN IF checkFbKw(Typ) THEN Typ &= TYKENN
    IF LEN(Nam) = 0 THEN EXIT SUB '                     block Typ {...};
  ELSEIF LEN(Nam) = 0 THEN '                                block {...};
    IF Mo THEN IF Op->T.UV THEN Typ = TYKENN
    EXIT SUB
  END IF '                       block {...} Nam; | block Typ {...} Nam;
  ModI = IIF(Mo, IIF(Mo > 1, &b0000011, &b0001011), &b0001001) : checkNaTy()
  SELECT CASE AS CONST ModO
  CASE 0 : IF LEN(Typ) = 0 THEN Typ = Nam : Nam = "" : EXIT SUB
  CASE 2 : IF LEN(Typ) = 0 THEN Typ = nextWord(Nam) & TYKENN
  CASE ELSE
    IF LEN(Typ) = 0 THEN
      VAR p = INSTR(Nam, ANY !"\t,")
      Typ = LEFT(Nam, p - 1) : Nam = MID(Nam, p + 2)
    ELSE
      VAR p = INSTR(UCASE(Nam), UCASE(Typ))
      IF p THEN
        Nam = LEFT(Nam, p - 1) & MID(Nam, p + LEN(Typ))
        Kompri(Nam, 1) : STRreplace(Nam, ",,", ",")
      END IF
    END IF
  END SELECT : Nam = genDefLine(Tabz)
END SUB

' generates one (or more) block(s)
' erzeugt einen (bei Verschachtelung mehrere) Blo(e)ck(e)
FUNCTION H_2_Bi.Block(BYVAL A AS INTEGER = 0) AS STRING
  DIM AS STRING neu, blna, ei = Einr, rp = BlRp, art
  VAR fl = 0, i = A, rr = ""
  'BlCo = Op->Art_Co
  Typ = nextWord(In->Tex, i)
  SELECT CASE Typ
  CASE "enum"   : art = "ENUM"  : fl = 0 : Op->I.CODE = Op->I.BE
  CASE "union"  : art = "UNION" : fl = 1 : Op->I.CODE = Op->I.BU
  CASE "struct" : art = "TYPE"  : fl = 1 : Op->I.CODE = Op->I.BT
  CASE ELSE
    SELECT CASE Typ
    CASE "extern", "namespace" : Nam = "line"
    CASE ELSE : Nam = "block"
      WHILE In->LaCh() <> ASC("}") : In->readTo("}") : WEND
    END SELECT : Op->I.CODE = Op->I.UT : IF Op->O.MB = 0 THEN RETURN ""
    IF LEN(Typ) THEN BlTy &= CHR(1) & Typ : RETURN "' removed """ & Typ & """ " & Nam
    VAR p = INSTRREV(BlTy, CHR(1))
    IF p THEN Typ = MID(BlTy, p + 1) : BlTy = LEFT(BlTy, p - 1) ELSE Typ = "???"
    RETURN "' } form removed """ & Typ & """ " & Nam
  END SELECT '                                       enum, struct, union
  blna = nextWord(In->Tex, i)
  IF BlNr = 0 THEN
    BlVo = "" : BlXx = "" : Einr = Tabz : In->newBlock()
    Op->I.COMM = Op->I.BLCO
  END IF
  'IF Op->I.COMM THEN rr = In->readCCom(BlCo) : IF LEN(rr) THEN rr &= NL
  BlNr += 1
  IF fl THEN BlRp = "" : neu = BlockTyUn() ELSE neu = BlockENUM()
  BlNr -= 1
  read2(";", 1) : Nam = In->Tex : Typ = blna
  BlockName(BlNr + fl) : Einr = ei
  BlVo &= rr
  IF LEN(Typ) THEN IF Op->T.UT THEN IF STACK_FIN(Ou->TyNa, Typ) THEN Typ &= TYKENN

  IF fl THEN '                 remember positions for names (TYPE/UNION)
    i = LEN(BlVo) : fl = LEN(BlRp) - 3
    IF fl > 0 THEN BlRp &= MKI(LEN(art) + LEN(Typ) + 1) : fl += 4
    IF fl < 5 THEN
      BlXx &= MKI(i + LEN(art) + 2)
    ELSE
      VAR o = CVI(MID(BlRp, fl, 4)) + i
      FOR j AS INTEGER = 1 TO fl - 4 STEP 4
        BlXx &= MKI(o + CVI(MID(BlRp, j, 4)))
      NEXT : BlXx &= MKI(i + LEN(art) + 2)
    END IF : BlRp = rp
  END IF

  IF BlAZ THEN
    BlVo &= art & " " & Typ & neu & NL & "END " & art
  ELSE
    IF LEN(Typ) = 0 THEN RETURN ""
    art = "t" : BlVo &= "TYPE " & Typ & " AS ANY PTR"
  END IF

  IF BlNr THEN '                                            nested block
    BlVo &= NL & NL : IF LEN(Nam) THEN RETURN Nam
    RETURN Tabz & "AS " & Typ & " " & Typ '           gets mangled later
  END IF
  IF LEN(Nam) THEN STRReplace(Nam, Tabz & "AS", "TYPE AS") : Nam = NL & NL & Nam
  SELECT CASE AS CONST art[0]
  CASE ASC("T") : SET_CODE(BT)
  CASE ASC("E") : SET_CODE(BE)
  CASE ASC("U") : SET_CODE(BU)
  CASE ASC("t") : SET_CODE(TY)
  END SELECT : fl = LEN(BlXx) - 4
  IF fl > 0 THEN '                                    mangle block names
    VAR po = 0, x = LEN(BlVo)
    DO
      i = 0
      FOR j AS INTEGER = 1 TO fl STEP 4
        po = CVI(MID(BlXx, j, 4))
        IF po < x THEN IF po > i THEN i = po
      NEXT : IF i = 0 THEN EXIT DO
      x = i : BlVo = LEFT(BlVo, i - 1) & Typ & "_" & MID(BlVo, i)
    LOOP
  END IF : Op->I.COMM = IIF(Op->I.BLCO, 0, Op->I.SHCC)
  Ou->LaWo = CHR(1) : RETURN BlVo & Nam
END FUNCTION