{$X+}
unit compiler;
{$IFDEF FPC}
  {$MODE DELPHI} {$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2016, SHIRAISHI Kazuo *)
(***************************************)



interface
uses  SysUtils, Classes, Types, Forms, Dialogs, ComCtrls, Controls, Graphics, StdCtrls, FileUtil,
     struct;


procedure RunNormal;
procedure RunStep;
procedure ExecuteOnThread;

var
   changedir:procedure;
   setIndentOption:procedure;
   setOperation:procedure;
   setRunOption:procedure;
   setRunOption2:procedure;
   setDebug:procedure;
   setLineEndMarker:procedure;
   setRefferingPath:procedure;
var
   ProgramOnRunning:string='';

implementation

uses
     MainFrm,paintfrm,textfrm,tracefrm, graphopt, base,arithmet,
     myutils,rational,texthand,textfile,express,statemen,graphsys,graphic,
     debugdg,helpctex,math2sub,charinp,sconsts,vstack,memman,merge,mesdlg,
     MyThread;

type
  TBackUp=class(TThread)
       text1:ansistring;
       fName:ansistring;
    constructor create(const s,f:AnsiString);
    procedure execute;override;
  end;

constructor TBackUp.create(const s,f:AnsiString);
begin
   inherited create(false);
   text1:=s;
   FName:=f;
end;

procedure TBackUp.execute;
var
  t:Text;
begin
  assignFile(t,fname);
  try
    rewrite(t);
    write(t,text1);
    close(t)
  except
  end;
end;


var
    ReCompile:boolean=false;

function compile:boolean;
begin
 Screen.cursor:=crHourGlass;
 compile:=true;
 recompile:=false;

 try
      struct.compile;
  except
  on E:Exception do
      begin
          compile:=false;
          currentprogram.deletestatements; //2011.3.9 追加
          currentprogram.freeall;
          if E is EReCompile then
             recompile:=true
          else if not (E is SyntaxError) then
             ShowMessage(s_internalErrorCompiling+EOL+E.message +EOL+Contact);
      end;
 end;
 Screen.cursor:=crDefault;
end;

function CompilePrg:boolean;
var
   ErrorMes:string;
   svUseTranscendentalFunction:boolean;
begin
   svUseTranscendentalFunction := UseTranscendentalFunction;

   FrameForm.Memo1.lines.BeginUpdate;

   extype:=0;
   InitSeed;

   GraphMode:=false;
   textMode:=false;
   UseCharInput:=false;

   ReCompile:=false;
   repeat

       SetPrecisionMode(InitialPrecisionMode,true);

       indent:=-1;
       USEnest:=0;

       DoStack:=TList.Create;
       ForStack:=TList.create;
       WhenStack:=TList.create;
       WhenStack.add(nil);
       WhenUseStack:=TList.create;
       WhenUseStack.add(nil);

       result:=false;
       pass:=1;

      try
         if compile then
            begin
               pass:=2;
               currentprogram.deletestatements;
               currentprogram.VarTablesRebuild;
               currentprogram.ShareVarTableGetVar;
               result:=compile;
            end;
       finally
         DoStack.Free;
         ForStack.free;
         WhenStack.free;
         WhenUseStack.free;
         KeyWordTablesFreeAll;
         Pass:=0;
       end;
   until recompile=false;

   FrameForm.Memo1.lines.EndUpdate;
   //  エラーを表示する
   if result=false then
       begin
         SelectLine(FrameForm.memo1,exline);
         //MyMessageDlg(statusmes.murgeWithOR, mtWarning, [mbOK,mbHelp]
         //                                  ,HelpContext,s_SyntaxError);

         ErrorMes:= s_SyntaxError+' at line ' + IntToStr(exline+1)+ EOL +
                     statusmes.murgeWithOR ;
         if HelpContext=0 then
              MessageDlg( ErrorMes, mtWarning, [mbOK],HelpContext)
         else
              //MessageDlg( ErrorMes, mtWarning, [mbOK,mbHelp],HelpContext);
              ShowMessageDialog(ErrorMes, HelpContext);
         //with FrameForm.memo1 do
           // SelStart:=SendMessage(Handle,EM_LINEINDEX,
           //                       exline,0)+expos+exinsertcount-1;
         with FrameForm do
           Memo1.SelStart:=LineIndex(FrameForm.Memo1,exline)+expos+exinsertcount-1;
         end;

   UseTranscendentalFunction := svUseTranscendentalFunction
end;


 var  mes:string;
 var  hc:integer;

 procedure ExecuteOnThread;
  begin
   hc:=0;
   try

   asm
      fclex
   end;
   controlword:= NormalCW;           //2014.1.12
   SetFPUMask(controlword);          //2014.1.9
   {$IFDEF CPU32}
   asm
      mov initialESP,esp
   end;
   {$ENDIF}
   {$IFDEF CPU64}
    asm
       mov [initialRSP+rip],rsp
    end;
   {$ENDIF}

    CurrentProgram.RunModules ;
  except
    on EExtype do
    begin
      hc:=0;
      case extype mod 100000 of
           0      : mes:='' ;
        1001      : mes:=s_Extype1001;
        1002      : mes:=s_Extype1002;
        1003      : mes:=s_Extype1003;
        1006      : mes:=s_Extype1006;
        1007      : mes:=s_Extype1007;
        1008      : mes:=s_Extype1008;
        1050..1106: mes:=s_Extype1050;
        1004..1005,
        1009..1049,
        1107..1999: mes:=s_Extype1000;

        2001      : begin mes:=s_Extype2001; hc:=IDH_ARRAY end;
        3000      : mes:=s_Extype3000;
        3001      : mes:=s_Extype3001;
        3002      : mes:=s_Extype3002;
        3003      : mes:=s_Extype3003;
        3004..3008: mes:=s_Extype3004;
        3009      : MES:=s_Extype3009;
        4000..4299:
               begin
                    mes:=s_Extype3004;
                    case extype mod 100000 of
                         4004: mes:=mes + '(SIZE)';
                         4005: mes:=mes + '(TAB)';
                         4008: mes:=mes + '(LBOUND)';
                         4009: mes:=mes + '(UBOUND)';
                         4010: mes:=mes + '(REPEAT$)';
                       else
                    end;
               end;
        5001,5002 : begin mes:=s_Extype5001; hc:=IDH_MAT  end;
        6001..6402: mes:=s_Extype6001;
        7001      : mes:=s_Extype7001;
        7003      : mes:=s_Extype7003;
        7004      : mes:=s_Extype7004;
        7101      : mes:=s_Extype7101;
        7102      : mes:=s_Extype7102;
        7103      : mes:=s_Extype7103;
        7301      : begin mes:=s_EXtype7301; hc:=IDH_ERASE end;
        7302      : mes:=s_EXtype7302;
        7303      : mes:=s_EXtype7303;
        7305      : mes:=s_Extype7305;
        7308      : mes:=s_Extype7308;
        7317      : mes:=s_Extype7317;
        7318      : mes:=s_Extype7318;

        7005..7100,7104..7300,7311..7316,7320..7402
                  : mes:=s_Extype7000;
        8001      : mes:=s_Extype8001;
        8011      : mes:=s_Extype8011;
        8012      : mes:=s_Extype8012;
        8013      : mes:=s_Extype8013;
        8101      : mes:=s_Extype8101;
        8002,8003,8102,8103: mes:=s_Extype8002;
        8105      : mes:=s_Extype8105;
        8120      : mes:=s_Extype8120;
        8201      : begin mes:=s_Extype8201; hc:=IDH_PRINT_USING end;
        8202      : begin mes:=s_Extype8202; hc:=IDH_PRINT_USING end;
        8401      : mes:=s_Extype8401;
        8402      : mes:=s_Extype8402;
        9000      : mes:=s_Extype9000;
        9002      : mes:=s_Extype9002;
        9003      : mes:=s_Extype9003;
        9004      : mes:=s_Extype9004;
        9102      : mes:=s_Extype9102;
        10002     : mes:=s_Extype10002;
        10004     : mes:=s_Extype10004;
        11004     : begin mes:=s_Extype11004; hc:=IDH_SELECT end;
        11051     : begin mes:=s_Extype11051; hc:=IDH_WINDOW end;
        12004     : mes:=s_Extype12004;
        outofmemory : mes:=s_OutoOfMemory;
        virtualStackOverflow:begin mes:=s_VStackOverflow; hc:=IDH_STACK_LIMIT end;
        stackoverflow:begin mes:=s_StackOverflow; hc:=IDH_STACK_LIMIT; end;
        ArraySizeOverflow: begin mes:=s_ArraySizeOverflow; hc:=IDH_LIMIT end;
        TextOverFlow: mes:=s_OutputOverflow;
        RToNOverflow:begin mes:=S_RToNOverflow; hc:=IDH_RATIONAL end;
        systemErr   : mes:='system error';
        TooBigRational: mes:='Too big rational';
        else          mes:=''   ;
      end;
    end;
    on E:EStackOverflow do ShowMessage(E.Message);
    on E:EOutOfMemory do ShowMessage(E.Message);
    on E:Exception do
           ShowMessage(s_InternalErrorRunning+EOL+E.message +EOL+Contact);

  end;
 end;



procedure RunPrg;
var
   CurDir:String;
   svSelStart:integer;
   svCapture:TControl;
begin
   extype:=0;
   CurrentOperation:=nil;
   statusmes.clear;
   DebugDlg.init;

   //svCapture:=Mouse.Capture;
   //Mouse.Capture:=FrameForm;

  if not GraphMode  then
          PaintForm.Visible:=false;


  CurDir:=ExtractFilePath(FrameForm.OpenDialog1.FileName);
  if (CurDir<>'') and (Curdir<>GetCurrentDir) then
     SetCurrentDir(CurDir);

  console:=TConsole.create;
  PConsole.ttext:=console;           //2008.11.3
  LocalPrinter:=TLocalPrinter.create;
  TextForm.Caption:=ChangeFileExt(FrameForm.OpenDialog1.FileName,'.txt');

  TraceForm.Memo1.lines.text:='';
  TraceForm.Caption:=ChangeFileExt(FrameForm.OpenDialog1.FileName,'.log');
  TraceForm.setReadOnly(true);

  if BreakFlags.TraceMode then
     begin
         TraceForm.Visible:=true;
         TraceForm.WindowState:=wsNormal;
         TraceForm.BringToFront;
     end
  else
     TraceForm.Visible:=false;  //WindowState:=wsMinimized;


  //InitGraphics;         //2013.12.21 追加  //2020.2 ver. 2.1.0.0 削除
  PaintForm.initial;
  InitGraphics;

  if graphmode and  (nextGraphmode=ScreenBitmapMode) then
       begin
          PaintForm.Caption:=ChangeFileExt(FrameForm.OpenDialog1.FileName,'.bmp');
          {$IFDEF Windows}
          PaintForm.WindowState:=wsMaximized;  //下記対策。理由は不明。
          {$ENDIF}
          PaintForm.Visible:=true;
          PaintForm.WindowState:=wsNormal;   //なぜか最小化後に実行すると最小化のまま
          PaintForm.BringToFront;
          if  textmode
            and (paintform.left<textform.left) and (paintform.top<textform.top)
            and (textform.Left+textform.Width<paintform.Left+paintform.Width)
            and (textform.Top+textform.Height<paintform.Top+paintform.Height) then
              begin
              textform.left:=base.max(0,paintform.left -80);
              textform.top:=base.max(0,paintform.top -40);
            end
       end
  else
     PaintForm.visible:=false;

  if UseCharInput then
    begin
       charinput.init;
       CharInput.Show
    end;

   RunThread:=TMyThread.Create;
   sleep(10);
   repeat
      MainTask;
   until RunThread.Finished;
   controlword:=OriginalCW;     //2014.1.12
   SetFPUMask(OriginalCW);       //2014.1.9
   MainTask;
   MyGraphSys.Finish;
   RunThread.Free;

   currentprogram.ShareVarTableFreeVar;
   currentprogram.deletestatements;
   currentprogram.freeall;
   console.free;
   PConsole.ttext:=nil;        //2008.11.3
   LocalPrinter.free;
    //FrameForm.memo1.SelLength:=0;
   charinput.hide;


  statusmes.add(mes);
  With FrameForm.memo1 do
     begin
        //LockWindowUpdate(Handle);
        svSelStart:=selStart;
        SelectAll;
        //SelAttributes:=DefAttributes;
        SelStart:=svSelstart;
        //SelLength:=0;
        //LockWindowUpdate(0);
     end;

  //FrameForm.memo1.HideSelection:=false;
  if extype<>0 then
       begin
          SelectLine(FrameForm.memo1,exline);
          FrameForm.Show;
          FrameForm.BringToFront;
          mes:='EXTYPE '+strint(extype mod 100000) +EOL+ statusmes.murge ;
          if hc=0 then
             MessageDlg(mes, mtError, [mbOK], 0)
          else
             MessageDlg(mes, mtError, [mbOK,mbHelp], hc) ;

          if extype>0 then
          with DebugDlg do
             begin
               RadioGroup1.visible:=false;
               Execute;
             end;

          statusmes.clear ;
       end;


  if extype=0 then
      begin
        if textmode then
          with TextForm do
             begin
               Visible:=true;
               WindowState:=wsNormal;
               BringToFront;
             end;
        if graphMode and  (nextGraphmode=ScreenBitmapMode) then
          with PaintForm do
             begin
               Visible:=true;
               WindowState:=wsNormal;
               BringToFront;
             end;
      end;

    //Mouse.Capture:=svCapture;
end;



function CompileAndRun:boolean; //compileが成功するとTrue;
begin
   HelpContext:=0;
   StatusMes.clear;
   FrameForm.StatusBar1.Panels[1].text:=s_OnCompiling;
   //FrameForm.StatusBar1.Panels[1].Bevel:=pbLowered;
   FrameForm.StatusBar1.update;

   InitMemory;
   MemoryManInit;
   InitRational;

  result:=false;
  if CompilePrg then
      begin
           result:=true;
            if MixedArithmetic then
                FrameForm.StatusBar1.Panels[1].text:=''
           else
                FrameForm.StatusBar1.Panels[1].text:=
                                       precisionText[MainProgram.arithmetic];
           ProgramOnRunning:= ChangeFileExt(FrameForm.OpenDialog1.FileName,'')+s_OnRuunnig;
           FrameForm.StatusBar1.Panels[3].text:=s_OnRuunnig;
           //FrameForm.Caption:=AppTitle + ;
           FrameForm.StatusBar1.update;
           FrameForm.Memo1.Modified:=false;
           //FrameForm.Timer1.Enabled:=true;

           try
              RunPrg;
           except
            on E:Exception do
               ShowMessage(E.message );
           end;
           //FrameForm.Timer1.Enabled:=false;
           PaintForm.Repaint;
           TextForm.TextOutExec;

           //FrameForm.Caption:=AppTitle;
     end;

   //FrameForm.StatusBar1.Panels[1].Bevel:=pbNone;
   FrameForm.StatusBar1.Panels[1].text:='';
   FrameForm.StatusBar1.Panels[3].text:=statusBarMems3;
end;

procedure SetExecutingNow(s:boolean);
var
   i:integer;
begin
   ExecutingNow:=s;
   with FrameForm do
      begin
        TBRun.enabled:=not s;
        TBStep.enabled:=not s;
        TBBreak.enabled:=s;
        TBCut.enabled:=not s;
        TBPaste.enabled:=not s;
        TBUndo.enabled:=not s;
        if not permitMicrosoft then
           begin
              TBDecimal.enabled:=not s;
              TBHighPrecision.enabled:=not s;
              TBBinary.enabled:=not s;
              TBComplex.enabled:=not s;
              TBRational.enabled:=not s;
              TBDeg.enabled:=not s;
           end;
        Option1.enabled:=not s;
      end;
   with FrameForm do begin
       Run2.enabled:=not s;
       Break1.enabled:=s;
       Step1.enabled:=not s;
       Exit1.enabled:=not s;
       PopUpRun1.enabled:=not s;
       PopUpBreak1.enabled:=s;
       PopUpStep1.enabled:=not s;
       //Close1.enabled:=not s;
       merge1.enabled:=not s;
       Cut1.enabled:=not s;
       Paste1.enabled:=not s;
       Delete1.enabled:=not s;
       Undo1.enabled:=not s;
       Repalce1.enabled:=not s;
       deleteLabelNumber1.enabled:=not s;
       addLabelNumber1.enabled:=not s;
       CaseChange1.enabled:=not s;
       ToolBox1.enabled:=not s;
       Memo1.ReadOnly:=s;
   end;
   with TextForm  do begin
       Break1.enabled:=s;
       File1.enabled:=not s;
       Edit1.enabled:=not s;
       option1.enabled:=not s;
       PopupMenu1.AutoPopup:=not s;  //LCLでは機能しない
       cut2.enabled:=not s;
       paste2.enabled:=not s;
       delete2.enabled:=not s;
   end;
   with TraceForm  do begin
       Break1.enabled:=s;
       File1.enabled:=not s;
       Edit1.enabled:=not s;
       option1.enabled:=not s;
       PopupMenu1.AutoPopup:=not s;  //LCLでは機能しない
       cut2.enabled:=not s;
       paste2.enabled:=not s;
       delete2.enabled:=not s;
   end;
   with PaintForm do begin
       break1.enabled:=s;
       File1.enabled:=not s;
       Edit1.enabled:=not s;
       option1.enabled:=not s;
   end;
end;

function appRun:boolean;
var
   svModified:boolean;
   BackUp1:TBackUp;
   BkFile:ansistring;
   svKeepText,svKeepGraphic:boolean;
   dummy:boolean;
begin
   with FrameForm do
      memo1.HighLighter:=BreakHighlighter;
   if TextHand.memo<>nil then exit;   {再入防止}
   TextHand.memo:=FrameForm.memo1;

   ChainFile:='';


   BkFile:=changefileext(application.exename,'.BAK');
   if NoBackUp or not FrameForm.memo1.Modified then
      BackUp1:=nil
   else
      BackUp1:=TBackUp.create(FrameForm.memo1.lines.text,bkFile);

   MergedLineNumber:=-1;

   SetExecutingNow(True);
   svModified:=FrameForm.Memo1.Modified;

   if permitMicrosoft then
      InitialPrecisionMode:=PrecisionNative
   else
      InitialPrecisionMode:=InitialPrecisionMode0;
   initialCharacterByte:=initialCharacterByte0;

   byte(nextGraphMode):=GraphOptDlg.RadioGroup1.ItemIndex;

   //IdleImmediately;
   Application.ProcessMessages;
   try
       result:=CompileAndRun;
   except
       on E:Exception do
          ShowMessage(s_InternalErrorCompiling+EOL+E.message +EOL+Contact);
   end;

   BackUp1.free;
   SetExecutingNow(False);

   if MergedLineNumber>0 then RemoveMergedText;
   
   FrameForm.memo1.Modified:=svModified;
   TextHand.memo:=nil;
   with FrameForm do
      memo1.HighLighter:=SynAnySyn1;

   if not NoBackUp then
      SysUtils.DeleteFile(BkFile);

   if ChainFile<>'' then
      begin
        svKeepText:=KeepText;
        svkeepGraphic:=KeepGraphic;
        KeepText:=true;
        KeepGraphic:=true;
        
        if FrameForm.OpenTextFile(ChainFile)then
           dummy:=AppRun;

        KeepText:=svKeepText;
        KeepGraphic:=svKeepGraphic;
      end;


end;

procedure RunNormal;
begin
    BreakFlags.LongFlag:=false;
    bkDirective:=bkStep;
    appRun;
    asm finit end;
    SetFPUMask(OriginalCW);
end;

procedure RunStep;
begin
    BreakFlags.TraceChannelPlus1:=0;
    BreakFlags.TraceMode:=true;
    CtrlBreakHit:=true;
    bkDirective:=bkstep;
    appRun;
    asm finit end;
    SetFPUMask(OriginalCW);
end;



procedure noefect;
begin
end;

function dummy:TStatement;
begin
   dummy:=nil
end;


begin
  setIndentOption:=noefect;
   setoperation:=noefect;
   setRunOption:=noefect;
   setRunOption2:=noefect;
   setDebug:=noefect;
   changedir:=noefect;
   setLineEndMarker:=noefect;
   setRefferingPath:=noefect;

end.
