Troll compiler

[eddy]

Compiler this program into TrollCompiler.exe


How to test it

• Preferences > Compiler > add new compiler exe...
• Open a new PB file, type your code
• Select your "Troll" compiler and run your program

Code: Select all

EnableExplicit

CompilerIf #PB_Compiler_Unicode
   CompilerError "Disable UNICODE mode in compiler options"
CompilerEndIf

;{ Log functions
Procedure LogWrite(log.s, clear=#False)
   Protected cmd.s
   Protected file
   If clear
      file=CreateFile(#PB_Any, ReplaceString(ProgramFilename(), ".exe", ".log"))
   Else
      file=OpenFile(#PB_Any, ReplaceString(ProgramFilename(), ".exe", ".log"))
   EndIf   
   FileSeek(file, Lof(file))
   WriteString(file, log + #LF$)
   CloseFile(file)
EndProcedure

Procedure LogCommandLine()
   Protected cmd$=#DQUOTE$ + #PB_Compiler_Home + "/Compilers/pbcompiler" + #DQUOTE$ + " "
   Protected i
   For i=0 To CountProgramParameters()-1
      cmd$ + ProgramParameter(i) + " "
   Next
   LogWrite(cmd$)
EndProcedure
;}

;{ Script functions
#COMPILER_PB="PureBasic"
#COMPILER_DEV="(c) 2014 Tony Stark"
#COMPILER_PLATFORM="(Windows - Troll)" ; (Windows - x64)
#COMPILER_VERSION="5.30"               ; 5.30

#CMD_VERSION=#COMPILER_PB + " " + #COMPILER_VERSION + " " + #COMPILER_PLATFORM + " - " + #COMPILER_DEV
#CMD_STANDBY="STARTING" + #TAB$ + #COMPILER_VERSION + #TAB$ + #COMPILER_PB + " " + #COMPILER_VERSION + " " + #COMPILER_PLATFORM
#CMD_READY="READY"
#CMD_END="END"

Structure Script
   Action$
   Src$
   Target$
   Icon$
   IsUnicode.i
   Map ConstantToReplace$()
   CompileOptions$
   IncPath$
   SrcAlias$
EndStructure

Procedure.i ConfigureScript(*Script.Script)
   With *Script
      Repeat
         Protected line$=Input()
         LogWrite(line$)
         Protected action$=UCase(StringField(line$, 1, #TAB$))
         Protected param$=StringField(line$, 2, #TAB$)
         Select action$
            Case "SOURCE"
               \Src$=param$
            Case "TARGET"
               \Target$=param$
            Case "TARGET"
               \Target$=param$
            Case "INCLUDEPATH"
               \IncPath$=param$
            Case "SOURCEALIAS"
               \SrcAlias$=param$
            Case "ICON"
               \Icon$=param$
            Case "CONSTANT"
               Protected name$=StringField(param$, 1, "=")
               Protected value$=StringField(param$, 2, "=")
               \ConstantToReplace$(name$)=value$
            Case "END"
               ProcedureReturn 0
            Case "COMPILE"
               \CompileOptions$=param$
               ProcedureReturn 1
         EndSelect
      ForEver
   EndWith
   ProcedureReturn 0
EndProcedure

Procedure ExecutionError(message.s="compilation error", line=-1, openIncludeFile$="", outputComplete=1)
   If openIncludeFile$
      ;PrintN("PROGRESS" + #TAB$ + "INCLUDES" + #TAB$ + openIncludeFile$)
      PrintN("ERROR" + #TAB$ + "SYNTAX" + #TAB$ + -1)
      PrintN("MESSAGE" + #TAB$ + message)
      PrintN("INCLUDEFILE" + #TAB$ + openIncludeFile$ + #TAB$ + line)
   Else
      PrintN("ERROR" + #TAB$ + "SYNTAX" + #TAB$ + line)
      PrintN("MESSAGE" + #TAB$ + message)      
   EndIf   
   If outputComplete
      PrintN("OUTPUT" + #TAB$ + "COMPLETE")
   EndIf
EndProcedure

Procedure.i ExecuteScript(*Script.Script)
   With *Script
      RandomSeed(Date())
      CreateRegularExpression(20, "^\s*X?IncludeFile\s*" + #DQUOTE$ + "(?<incfile>[^" + #DQUOTE$ + "]*)" + #DQUOTE$, #PB_RegularExpression_NoCase)
      OpenFile(10, \Src$)
      Protected lineCount=0      
      Repeat         
         Protected SrcLine$=ReadString(10)
         lineCount + 1         
         If ExamineRegularExpression(20, SrcLine$)
            While NextRegularExpressionMatch(20)
               Protected incfile$=RegularExpressionNamedGroup(20, "incfile")
               If FileSize(\IncPath$+incfile$)=-1
                  CloseFile(10)
                  ProcedureReturn ExecutionError("You don't need to include this : <" + incfile$ + ">", lineCount)
               Else
                  CloseFile(10)
                  ProcedureReturn ExecutionError("I'm sick of your code! You need to rewrite this line.", 1, incfile$)
               EndIf
            Wend
         EndIf
      Until Eof(10)
      CloseFile(10)
      
      Protected i
      For i=0 To 100
         PrintN("PROGRESS" + #TAB$ + "LINES" + #TAB$ + i)
         If i=20
            ProcedureReturn ExecutionError("It's my day off, I cannot compile more than 20 lines", i)
         EndIf         
      Next
      PrintN("PROGRESS" + #TAB$ + "ASSEMBLING")
      
      If \Icon$ 
         ProcedureReturn ExecutionError("Sorry, your icon is ugly!")
      EndIf
      
      PrintN("PROGRESS" + #TAB$ + "LINKING")
      PrintN("SUCCESS")      
   EndWith
   
   ProcedureReturn #True
EndProcedure
;}

Procedure Run()
   OpenConsole()
   
   Protected i
   Protected Script.Script
   Protected action.s
   For i=0 To CountProgramParameters()-1
      Protected param.s=UCase(ProgramParameter(i))
      Select param
         Case "/VERSION" : Script\Action$=param
         Case "/STANDBY" : Script\Action$=param
         Case "/UNICODE" : Script\IsUnicode=1
      EndSelect      
   Next
   
   LogWrite("----------------------------------------")
   LogCommandLine()
   
   Select Script\Action$
      Case "/VERSION"
         PrintN(#CMD_VERSION)         
      Case "/STANDBY"
         PrintN(#CMD_STANDBY)
         PrintN(#CMD_READY)
         While ConfigureScript(@Script)
            ExecuteScript(@Script)
         Wend         
   EndSelect
   
   CloseConsole()
   End 0
EndProcedure

Run()

[Bisonte]

nice