fbdoc_emit_csource.bas

Go to the documentation of this file.

#INCLUDE ONCE "fbdoc_options.bi"



DIM SHARED AS STRING LOFN



SUB c_CTOR CDECL(BYVAL O AS Options PTR)
  WITH *O
    IF 0 = LEN(.LfnPnN) THEN .LfnPnN = .OutPath & LFN_FILE
    MSG_LINE(.LfnPnN)
    VAR fnr = FREEFILE
    IF OPEN(.LfnPnN FOR INPUT AS #fnr) THEN
      MSG_CONT("not present (List fo Function Names)")
    ELSE
      LOFN = STRING(LOF(fnr), 0)
      GET #fnr, , LOFN
      CLOSE #fnr
      MSG_CONT("loaded")
    END IF
  END WITH
END SUB



SUB c_Init CDECL(BYVAL P AS Parser PTR)
  P->SrcBgn = 0
END SUB



SUB c_exit CDECL(BYVAL P AS Parser PTR)
  emit_comments(P, P->Fin)
END SUB



SUB c_include CDECL(BYVAL P AS Parser PTR)
  WITH *P '&Parser* P;
    emit_comments(P, .Tk1[1])
    VAR fnam = .SubStr(.NamTok)
    IF OPT->Types = OPT->C_STYLE THEN
      VAR i = INSTRREV(fnam, ".")
      Code("#include " & LEFT(fnam, i))
      IF LCASE(RIGHT(fnam, 4)) = ".bi""" THEN Code("h""") ELSE Code("c""")
    ELSE
      Code("#include " & fnam)
    END IF
    IF OPT->InTree THEN .Include(TRIM(fnam, """"))
  END WITH
END SUB



SUB c_defi_ CDECL(BYVAL P AS Parser PTR)
  WITH *P '&Parser* P;
    emit_comments(P, .Tk1[1])

    Code("#define ")
    VAR e = .EndTok[1]
    IF *.StaTok = .TOK_MACR THEN
      VAR a = .NamTok[1], l = .CurTok[1] - a
      Code(MID(.Buf, a + 1, l) & "  /* (multi line FreeBASIC #MACRO) ")
      a += l
      Code(MID(.Buf, a + 1, e - a) & " */ ")
    ELSE
      VAR a = .NamTok[1], l = .DivTok[-2] + .DivTok[-1] - a
      Code(MID(.Buf, a + 1, l))
      a += l
      l = e - a
      IF l > 0 THEN Code(" /* " & MID(.Buf, a + 1, e - a) & " */")
    END IF
    .SrcBgn = e
  END WITH
END SUB



SUB c_func_ CDECL(BYVAL P AS Parser PTR) ' ToDo: internal function calls for diagrams
  WITH *P '&Parser* P;
    var futo = .FunTok, nato = .NamTok
    emit_comments(P, .Tk1[1])

    OPT->CreateFunction(P)
    Code(" {")

    IF LEN(LOFN) THEN
      'VAR cfl = .TOK_CTOR = *futo ORELSE _
                '.TOK_DTOR = *futo ORELSE _
                '.TOK_DOT  = nato[3]
      VAR cna = UCASE(.SubStr(nato)) _
      , wtype = "" _
          , t = .CurTok _
          , e = .EndTok - 6
      WHILE t < e
        SELECT CASE AS CONST *t
        CASE .TOK_END
          t += 3
          IF *t = .TOK_WITH THEN wtype = ""
        CASE .TOK_WITH
          VAR p = t[1] + t[2]
          t += 3
          WHILE t < e
            IF *t > .TOK_EOS andalso *t < .TOK_COMSL THEN t += 3 ELSE EXIT WHILE
          WEND
          wtype = TRIM(MID(.Buf, p + 2, *(t-2) + *(t-1) - p - 1))
          IF wtype[0] = ASC("*") THEN wtype = MID(wtype, 2) & "->" ELSE wtype &= "."
        CASE .TOK_BROPN
          VAR a = *(t - 2) _
            , l = *(t - 1) _
            , g = 0
          FOR i AS INTEGER = LEN(LOFN) - 2 TO 0 STEP -1
            VAR x = a + l - 1
            WHILE (.Buf[x] AND &b11011111) = (LOFN[i] AND &b11011111)
              i -= 1
              x -= 1
              IF x < a THEN ' end of source word
                VAR tt = t - 6
                SELECT CASE AS CONST LOFN[i]
                CASE ASC(LFN_SEP) : g = 0 : x += 2 ' global function `symbol()`
                CASE ASC(".") '                      member function `udtname.symbol()`
                  IF .Buf[x] = ASC(".") ORELSE .Buf[x] = ASC(">") THEN ' chain of one or more member functions
                    WHILE tt > .Tk1
                      IF *tt = .TOK_MEOP ORELSE *tt = .TOK_DOT _
                                         THEN tt -= 3 ELSE tt += 3 : x = tt[1] + 1 : g = 0 : EXIT WHILE ' `symbol.symbol()`, `symbol->symbol()`
                      IF .Buf[tt[4] - 1] < ASC("A")   THEN tt += 3 : x = tt[1] + 2 : g = 1 : EXIT WHILE ' .symbol()
                      IF *tt = .TOK_WORD THEN tt -= 3 ELSE tt += 6 : x = tt[1] + 1 : g = 1 : EXIT WHILE ' .symbol()
                    WEND
                    l += a - x + 1
                  ELSE ' no chain, just a single name
                     'IF 0 = cfl                            THEN EXIT WHILE
                     VAR z = i : i = INSTRREV(LOFN, LFN_SEP, z)
                     IF cna <> UCASE(MID(LOFN, i + 1, z - i)) THEN
'MSG_LINE(cna & " / " & MID(LOFN, i + 1, z - i) & " / " & MID(LOFN, z + 2, l))
                       if MID(LOFN, i + 1, z - i) <> MID(LOFN, z + 2, l) then EXIT WHILE
                       g = 1 : x += 2 : wtype = MID(.Buf, z, l) & "." ' CTOR
                     else
                       g = 0 : x += 2
                     END IF
                  END IF
                CASE ELSE : EXIT WHILE '             no match
                END SELECT
                emit_comments(P, a)
                IF g THEN Code(" " & wtype & MID(.Buf, x, l) & "();") _
                     ELSE Code(" " &         MID(.Buf, x, l) & "();")
                EXIT FOR
              END IF
            WEND

            WHILE i > 0 ANDALSO LOFN[i] <> ASC(LFN_SEP) : i -= 1 : WEND
          NEXT
        END SELECT : t += 3
      WEND
    END IF

    emit_comments(P, .EndTok[1] - 1)
    Code("};")
  END WITH
END SUB



SUB c_decl_ CDECL(BYVAL P AS Parser PTR)
  WITH *P '&Parser* P;
    emit_comments(P, .Tk1[1])

    IF 0 = .ListCount THEN
      SELECT CASE AS CONST *.StaTok
      CASE .TOK_CONS : Code("const ")
      CASE .TOK_STAT : Code("static ")
      CASE .TOK_COMM : Code("common ")
      CASE .TOK_EXRN : Code("extern ")
      CASE .TOK_TYPE : Code("typedef ")
        IF 0 = .FunTok ANDALSO .TypTok > .NamTok THEN Code("struct ")
      END SELECT
    END IF

    IF     .FunTok THEN : OPT->CreateFunction(P)
    ELSEIF .TypTok THEN : OPT->CreateVariable(P)
    ELSE
      IF 0 = .ListCount ANDALSO *.StaTok = .TOK_VAR THEN Code("VAR ")
                             Code(.SubStr(.NamTok))
      IF .BitTok THEN        Code(.BitIni)
      IF .IniTok THEN        CreateIni(P)
    END IF
    IF *.CurTok <= .TOK_EOS THEN Code(";") : EXIT SUB
    IF .NamTok > .TypTok    THEN Code(", ") _
                            ELSE Code("; ")
  END WITH
END SUB


DECLARE SUB c_Block CDECL(BYVAL AS Parser PTR)


SUB cEntryBlockENUM CDECL(BYVAL P AS Parser PTR)
  WITH *P '&Parser* P;
    emit_comments(P, .Tk1[1])

    IF 0 = .ListCount THEN Code(STRING(.LevelCount * 2, " "))
    Code(.SubStr(.NamTok))
    IF .IniTok THEN CreateIni(P)
    IF *.CurTok <> .TOK_END THEN Code(", ")
  END WITH
END SUB



SUB cEntryBlockTypeUnion CDECL(BYVAL P AS Parser PTR)
  WITH *P '&Parser* P;
    emit_comments(P, .Tk1[1])

    SELECT CASE AS CONST *.Tk1
    CASE .TOK_PRIV : Code("private:")
    CASE .TOK_PROT : Code("protected:")
    CASE .TOK_PUBL : Code("public:")
    CASE .TOK_ENUM, .TOK_UNIO, .TOK_TYPE, .TOK_CLAS : c_Block(P)
    CASE ELSE
      IF 0 = .ListCount    THEN Code(STRING(.LevelCount * 2, " "))
      IF *.Tk1 = .TOK_DECL THEN OPT->CreateFunction(P) : Code(";") : EXIT SUB
      IF .FunTok THEN OPT->CreateFunction(P) _
                 ELSE OPT->CreateVariable(P)
      IF *.CurTok <= .TOK_EOS THEN Code(";") : EXIT SUB
      IF .NamTok  >   .TypTok THEN Code(",") ELSE Code("; ")
    END SELECT
  END WITH
END SUB



SUB c_Block CDECL(BYVAL P AS Parser PTR)
  WITH *P '&Parser* P;
    emit_comments(P, .Tk1[1])

    IF .LevelCount THEN Code(STRING(.LevelCount * 2, " "))
    SELECT CASE AS CONST IIF(.LevelCount, *.Tk1, *.StaTok)
    CASE .TOK_TYPE, .TOK_CLAS
      IF OPT->Types = OPT->FB_STYLE THEN
         Code("class " & .BlockNam)
        VAR t = .Tk1 + 3
        IF *t = .TOK_EXDS THEN Code(" : public " & .SubStr(t + 3)) ' ToDo: parse list of names
        Code("{ public:")
        .parseBlockTyUn(@cEntryBlockTypeUnion())
        .BlockNam = ""
      ELSE
        IF 0 = .LevelCount ANDALSO LEN(.BlockNam) THEN Code("typedef ")
        Code("struct " & .BlockNam & "{")
        .parseBlockTyUn(@cEntryBlockTypeUnion())
      END IF
    CASE .TOK_UNIO
      IF 0 = .LevelCount ANDALSO LEN(.BlockNam) THEN Code("typedef ")
      Code("union " & .BlockNam & "{")
      .parseBlockTyUn(@cEntryBlockTypeUnion())
    CASE .TOK_ENUM
      IF 0 = .LevelCount ANDALSO LEN(.BlockNam) THEN Code("typedef ")
      Code("enum " & .BlockNam & "{")
      .parseBlockEnum(@cEntryBlockENUM())
    CASE ELSE : Code("-???-")
    END SELECT

    VAR fin = "}"
    IF OPT->Types = OPT->C_STYLE ANDALSO LEN(.BlockNam) THEN
      SELECT CASE AS CONST IIF(.LevelCount, *.Tk1, *.StaTok)
      CASE .TOK_TYPE, .TOK_CLAS, .TOK_ENUM, .TOK_UNIO
        fin &= " " & .BlockNam
      END SELECT
    END IF

    emit_comments(P, .Tk1[1])
    IF .LevelCount THEN Code(STRING(.LevelCount * 2, " "))
    Code(fin & ";")
  END WITH
END SUB



SUB init_csource(byval Emi as EmitterIF PTR)
  WITH *Emi
    .Error_ = @emit_error()

     .Defi_ = @c_defi_()
     .Incl_ = @c_include()
     .Func_ = @c_func_()
     .Decl_ = @c_decl_()
     .Enum_ = @c_Block()
     .Unio_ = @c_Block()
     .Clas_ = @c_Block()

     .Init_ = @c_Init()
     .Exit_ = @c_exit()
     .CTOR_ = @c_CTOR()
  END WITH
END SUB