unit base0;
 {$IFDEF FPC}
  {$MODE DELPHI} {$H+}
{$ENDIF}

(***************************************)
(* Copyright (C) 2014, SHIRAISHI Kazuo *)
(***************************************)

interface

uses
  Classes, SysUtils,StdCtrls,ComCtrls,Graphics, SynEdit,
  Types, Forms, Controls, FileUtil, Math,
      {$IFDEF windows}Windows,{$ENDIF}
      {$IFDEF LINUX} Linux,{$ENDIF}
  base,sconsts;

type
   tpPrecision=(PrecisionNormal,PrecisionNative,PrecisionComplex);
const
   PrecisionText:array[tpPrecision]of String=(s_decimal,s_Binary,s_complex);
   PrecisionLiteral:array[tpPrecision]of String=('DECIMAL','NATIVE','COMPLEX');
const
   RecordSetterCode:array[tpRecordSetter] of String=
                                 ('rsNone','rsBEGIN','rsEND','rsNEXT','rsSAME');
const
   IOOptionCode:array[IOOption] of String=
    ('ioReadWrite','ioCharacterByte','ioSkipRest','ioWhenInside','ioClear','ioNoWait');
function IoOptionsCode(option:IOoptions):Ansistring;

const
   DrawTimeIntervalLiteral:array[0..4] of string= ('0','1','5','10','20');
var
   DrawTimeIntervalIndex:byte={$IFDEF Windows}0{$ELSE}0{$ENDIF};
   DrawTimeIntervalAheadIndex:byte={$IFDEF Windows}1{$ELSE}1{$ENDIF};

type
   TUrgency=1..7;
const
   TThreadpriorityLiteral:array[TUrgency] of string=
      ('tpTimeCritical','tpHighest','tpHigher','tpNormal','tpLower','tpLowest','tpIdle');
Var
   AllowUrgency1:boolean=false;


function TruthLiteral(s:boolean):String;

type
   Array4 = array[1..4] of Integer;



var
  paramIndex:integer;      //コマンドパラメータのindex；実行中はプログラムファイル名の位置をさす。


var
   pass     :integer    =0;
   exline   :integer    =0;
   expos    :integer    =0;
   exinsertcount:integer=0;
   helpContext:integer  =0;



const
    bkCancel=0;
    bkStep=1;
    bkContinue=2;
var
    bkDirective:integer=bkCancel;
var
   ForceFunctionDeclare:boolean=false;
   ForceSubPictDeclare:boolean=false;
   InsertDIMst:boolean=false;
   OptionExplicit:boolean=false;
   AutoIndent:boolean=true;
   GreekIdf:boolean=false;
   KanjiIdf:boolean=false;

const
   ac_let=0;
   ac_input=1;
   ac_using=2;
   ac_next=3;
   ac_string=4;
   ac_remark=5;
   ac_exp=6;
   ac_while=7;
   ac_multi=8;
   ac_end=9;
var
   AutoCorrect:array[0..ac_end]of boolean=(true,true,true,true,true,true,false,false,false,false);
var
   shift_F5:string='LET ';
   shift_F6:string='PRINT ';
   shift_F7:string='OPTION ANGLE DEGREES';
   shift_F8:string='';
var
  TranslatingNow:boolean=false;
var
  NoRun:boolean=false;
  OpenAndRun:boolean=false;
  NoBackUp:boolean=true;


procedure SelectLine(memo:TSynEdit;i:integer);

var
   HideSyntaxMenu:boolean=false;

procedure  upper(var s:string);
procedure  lower(var s:string);

procedure InitializeEnv;
const
   VirtualStackSizeHeapArrays=$10000;

var
   SystemStackSize32:Cardinal= $ff0000{15.9375Mb};       //Stack Check可能な限界
   SystemStackSize64: Int64=  $3FC0000{63.75MB};
   VirtualStackSize32:Cardinal={$IFDEF Windows} $1000000{16Mb}{$ELSE} $1000000{16Mb}{$ENDIF};
   VirtualStackSize64:Int64=   {$IFDEF Windows}$40000000{1GB} {$ELSE}$40000000{1GB}{$ENDIF};
   UseHeapForArrays32:boolean=true;
   UseHeapForArrays64:boolean={$IFDEF Windows}false{$ELSE}true{$ENDIF};
    //ShowInfo:boolean=false;
   UseSmartLink:boolean={$IFDEF Darwin}false{$ELSE}true{$ENDIF};
   OptimizeLevel32:byte= 3;
   OptimizeLevel64:byte= 1;
   OldDialog32:boolean=false;
   OldDialog64:boolean=false;
   OoFastMath32:boolean=True;
   OoFastMath64:boolean=True;
   CfAVX:boolean=false;
   CfAVX2:boolean=false;
   AdditionalOptions32:string='';
   AdditionalOptions64:string='';
   OptimizeDouble:boolean=false;
   OptimizeInteger:boolean=false;
   OmitIndexCheck:boolean=false;

   //OptimizeCautious:boolean=false;
   //OptimizeOnlyWhenSubscripts:boolean=true;


var
   GraphMode:boolean=false;
   TextMode:boolean=false;
   TextPhysicalCoordinate:boolean = false;
   TextProblemCoordinate:boolean = false;
   UseCharInput:boolean=false;
   InitialPrecisionMode0:tpPrecision=PrecisionNative;
   InitialPrecisionMode:tpPrecision=PrecisionNative;
   PrecisionMode :tpPrecision=PrecisionNative;
   initialOptionBase:byte=1;
   initialAngleDegrees:boolean=false;
   initialCharacterByte0:boolean=false;
   initialCharacterByte:boolean=false;
   initialUseEXTYPE:boolean=false;
   JISFormat:boolean=false;
   JISSetWindow:boolean=true;
   JISDim:boolean=false;
   JISDef:boolean=true;
   ForNextBroadOwn:boolean=false;
   DisableAbbreviatedPLOT:boolean=false;

   MinimalBasic:boolean=false;
   PermitMicrosoft:boolean=false;
   TargetCPU64: Boolean={$IFDEF CPU64}true{$ELSE}false{$ENDIF};
   UseAltLongIntRound:boolean={$IFDEF CPU64}true{$ELSE}false{$ENDIF};
var
   PaintFont:TFont;

var availSSE41:boolean;
var availAVX:boolean;
var availAVX2:boolean;

type
   TStatusMes=class(TStringList)
       function add(const s:string):integer;override;
       function murge:string;
       function murgeWithOR:string;
       procedure insert(const s:string);
   end;
var
   statusmes:TStatusmes;

implementation

uses
      myutils;

procedure  upper(var s:string);
var
     i:integer;
begin
     i:=0;
     while i<length(s) do
        begin
            inc(i);
            if s[i] in ['a'..'z'] then
                   s[i]:=chr(ord(s[i])-32)
            else
                   ReadMBC(i,s); //if IsDBCSLeadByte(byte(s[i])) then inc(i);
        end;
end;

procedure  lower(var s:string);
var
     i:integer;
begin
     i:=0;
     while i<length(s) do
        begin
            inc(i);
            if s[i] in ['A'..'Z'] then
                   s[i]:=chr(ord(s[i])+32)
            else
                   ReadMBC(i,s); //if IsDBCSLeadByte(byte(s[i])) then inc(i);
        end;
end;




{************}
{Editor Utils}
{************}

procedure SelectLine(memo:TSynEdit;i:integer);
var
  p,q:integer;
begin
    with memo do
      begin
         (memo.owner as TForm).BringToFront;
         //SelStart:=SendMessage(Handle,EM_LINEINDEX,i,0);
         p:=LineIndex(memo, i);
         q:=LineIndex(memo, i+1);
         SelStart:=p;
         SelectLine;   //SelLength:=q-p -Length(EOL);
      end;
 end;





{*************}
{generate code}
{*************}
function IoOptionsCode(option:IOoptions):Ansistring;
var
  op:IoOption;
begin
  result:='';
  for op:=Low(IOOption){ioReadWrite} to High(IOOption) {ioNoWait} do
      if op in option then
         result:=result+IoOptionCode[op]+',';
  if (result<>'') and (result[length(result)]=',') then
     delete(result,length(result),1);
  result:='['+result+']';
end;

function TruthLiteral(s:boolean):String;
begin
   if s then result:=' true ' else result :=' false '
end;



{$IFDEF WINDOWS}
function GetPhysicalMemory98:Cardinal;
var
  GlobalMemoryInfo:TMemoryStatus;
begin
  GlobalMemoryInfo.dwLength:=sizeOf(GlobalMemoryInfo);
  GlobalMemoryStatus( GlobalMemoryInfo);
  GetPhysicalMemory98:=GlobalMemoryInfo.dwAvailPhys ;
end;

type
  TMemoryStatusEx = record
    dwLength: DWORD;
    dwMemoryLoad: DWORD;
    ullTotalPhys: Int64;
    ullAvailPhys: Int64;
    ullTotalPageFile: Int64;
    ullAvailPageFile: Int64;
    ullTotalVirtual: Int64;
    ullAvailVirtual: Int64;
    ullAvailExtendedVirtual: Int64;
  end;

function GetGlobalMemoryRecord: TMemoryStatusEx;

type
  TGlobalMemoryStatusEx = procedure(var lpBuffer: TMemoryStatusEx); stdcall;
var
  h : THandle;
  gms : TGlobalMemoryStatusEx;
begin
    Result.dwLength := SizeOf(Result);
    h := LoadLibrary(kernel32);
    try
      if h <> 0 then
      begin
        @gms := GetProcAddress(h, 'GlobalMemoryStatusEx');
        if @gms <> nil then
          gms(Result);
      end;
    finally
      FreeLibrary(h);
    end;
end;

function GetPhysicalMemory:QWord;
begin
   if longint(Windows.GetVersion)<0  then
      result:=GetPhysicalMemory98
   else
      Result := GetGlobalMemoryRecord.ullTotalPhys;
end;

{$ELSE}
{$IFDEF LINUX}
function GetPhysicalMemory:QWord;
var
  info:TSysInfo;
begin
  SysInfo(@info);
  result:=info.totalram;
end;
{$ELSE}
function GetPhysicalMemory:QWord;
begin
  result:=$40000000 {1024MB};  //dummy
end;
{$ENDIF}
{$ENDIF}

function min(a,b:QWord):QWord;
begin
  if a>b then
     min:=b
  else
     min:=a
end;

{$IFDEF CPU32}
function LongIntRound(x:double):LongInt;assembler;
asm
    PUSH EAX
    FLD x
    FISTP DWORD PTR [ESP]
    WAIT
    POP EAX
end;
{$ENDIF}

{**********}
{Initialize}
{**********}
procedure WriteIniFile;
var
   IniFile:TMyIniFile;
begin
      IniFile:=TMyIniFile.create('Frame');
      with IniFile do
       begin
          WriteBool('AutoIndent',AutoIndent);
          WriteBool('OptionExplicit',OptionExplicit);
          WriteBool('UseHeapForArrays32',UseHeapForArrays32);
          WriteBool('UseHeapForArrays64',UseHeapForArrays64);
          WriteInteger('SystemStackSize',SystemStackSize32);
          WriteInteger('VirtualStackSize',VirtualStackSize32);
          WriteInteger('SystemStackSize2',SystemStackSize64 div 1024);
          WriteInteger('VirtualStackSize2',VirtualStackSize64 div 1024);
          //WriteBool('OptimizeDouble',OptimizeDouble);
          //WriteInteger('DrawTimeIntervalIndexNew',  DrawTimeIntervalIndex);
          //WriteInteger('DrawTimeIntervalAheadIndexNew',  DrawTimeIntervalAheadIndex);
          WriteBool('SmartLink',UseSmartLink);
          WriteInteger('OptimizeLevel32',OptimizeLevel32);
          WriteInteger('OptimizeLevel64',OptimizeLevel64);
          WriteBool('CfAVX',CfAVX);
          WriteBool('CfAVX2',CfAVX);
          WriteBool('OoFastMath32',OoFastMath32);
          WriteBool('OoFastMath64',OoFastMath64);
          WriteString('AdditionalOptions32',AdditionalOptions32);
          WriteString('AdditionalOptions64',AdditionalOptions64);
          WriteBool('OldDialog32',OldDialog32);
          WriteBool('OldDialog64',OldDialog64);
          WriteString('Shift_F5',Shift_F5);
          WriteString('Shift_F6',Shift_F6);
          WriteString('Shift_F7',Shift_F7);
          WriteString('Shift_F8',Shift_F8);
       end;
      IniFile.free;

      IniFile:=TMyIniFile.create('PaintFont');
      with IniFile do
          storeFont(PaintFont);
      IniFile.free;
end;

procedure ReadIniFile;
var
   IniFile:TMyIniFile;
begin
    IniFile:=TMyIniFile.create('Frame');
    with IniFile do
       begin
         AutoIndent:=ReadBool('AutoIndent',AutoIndent);
         OptionExplicit:=ReadBool('OptionExplicit',OptionExplicit);
         UseHeapForArrays32:=ReadBool('UseHeapForArrays32',UseHeapForArrays32);
         UseHeapForArrays64:=ReadBool('UseHeapForArrays64',UseHeapForArrays64);
         SystemStackSize32:=ReadInteger('SystemStackSize',SystemStackSize32);
         VirtualStackSize32:=ReadInteger('VirtualStackSize',VirtualStackSize32);
         SystemStackSize64:=Int64(ReadInteger('SystemStackSize2',SystemStackSize64 div 1024))*1024;
         VirtualStackSize64:=Int64(ReadInteger('VirtualStackSize2',VirtualStackSize64 div 1024))*1024;
         //OptimizeDouble:=ReadBool('OptimizeDouble',OptimizeDouble);
         //DrawTimeIntervalIndex:=ReadInteger('DrawTimeIntervalIndexNew',  DrawTimeIntervalIndex);
         //DrawTimeIntervalAheadIndex:=ReadInteger('DrawTimeIntervalAheadIndexNew',  DrawTimeIntervalAheadIndex);
         UseSmartLink:=ReadBool('SmartLink',UseSmartLink);
         OptimizeLevel32:=ReadInteger('OptimizeLevel32',OptimizeLevel32);
         OptimizeLevel64:=ReadInteger('OptimizeLevel64',OptimizeLevel64);
         CfAVX:=ReadBool('CfAVX',CfAVX);
         CfAVX2:=ReadBool('CfAVX2',CfAVX2);
         OoFastMath32:=ReadBool('OoFastMath32',ooFastMath32);
         OoFastMath64:=ReadBool('OoFastMath64',ooFastMath64);
         AdditionalOptions32:=ReadString('AdditionalOptions32',AdditionalOptions32);
         AdditionalOptions64:=ReadString('AdditionalOptions64',AdditionalOptions64);
         OldDialog32:=readBool('OldDialog32',OldDialog32);
         OldDialog64:=readBool('OldDialog64',OldDialog64);
         shift_F5:=ReadString('Shift_F5',Shift_F5);
         shift_F6:=ReadString('Shift_F6',Shift_F6);
         shift_F7:=ReadString('Shift_F7',Shift_F7);
         shift_F8:=ReadString('Shift_F8',Shift_F8);
         //以下，終了時に書き込まれない項目
           InsertDIMst:=ReadBool('InsertDIM',InsertDIMst);
           InitialOptionBase:=ReadInteger('OptionBase',InitialOptionbase);
           //PermitMicrosoft:=ReadBool('Microsoft',PermitMicrosoft);
           MinimalBasic:=ReadBool('MinimalBasic',MinimalBasic);
           NoRun:=ReadBool('NoRun',NoRun);
           IniFileReadOnly:=ReadBool('IniFileReadOnly',IniFileReadOnly);
      end;
     IniFile.free;

     IniFile:=TMyInifile.create('PaintFont');
     with inifile do
          RestoreFont(PaintFont);
     IniFile.free;
end;


procedure InitializeEnv;
begin
  if Application.MessageBox(PChar(s_InitEnv),AppTitle,mb_OKCANCEL)=IDOk then
  begin
    IniFileReadOnly:=true;
    DeleteFile(pchar(IniFileName));
    {$IFDEF Windows}
    DeleteFile('output\NoName.ini');
    {$ELSE}
    DeleteFile(GetEnvironmentVariable('HOME') +'/.NoName.ini');
    {$ENDIF}
  end;
end;

{$IFDEF CPU32}
function asm_availSSE41:boolean;assembler;
asm
    push ebx
    mov eax,1
    cpuid
    mov eax, ecx
    shr eax, 19
    and eax,1
    pop ebx
end;

function asm_availAVX:boolean;assembler;
asm
    push ebx
    mov eax,1
    cpuid
    mov eax, ecx
    shr eax, 28
    and eax,1
    pop ebx
end;

function asm_availAVX2:boolean;assembler;
asm
    push ebx
    mov eax,7
    mov ecx,0
    cpuid
    mov eax, ebx
    shr eax, 5
    and eax,1
    pop ebx
end;
{$ENDIF}
{$IFDEF CPU64}
 function asm_availSSE41:boolean;assembler;
asm
    push rbx
    push rcx
    push rdx
    mov eax,1
    cpuid
    mov eax, ecx
    shr eax, 19
    and eax,1
    pop rdx
    pop rcx
    pop rbx
end;

function asm_availAVX:boolean;assembler;
asm
    push rbx
    push rcx
    push rdx
    mov eax,1
    cpuid
    mov eax, ecx
    shr eax, 28
    and eax,1
    pop rdx
    pop rcx
    pop rbx
end;

function asm_availAVX2:boolean;assembler;
asm
    push rbx
    push rcx
    push rdx
    mov eax,7
    mov ecx,0
    cpuid
    mov eax, ebx
    shr eax, 5
    and eax,1
    pop rdx
    pop rcx
    pop rbx
end;
{$ENDIF}

{**********}
{TStatusMes}
{**********}

function TStatusMes.add(const s:string):integer;
begin
   if indexof(s)<0 then
      result := inherited add(s)
   else
      result:=-1    ;
end;


function TStatusMes.murge:string;
var
   i:integer;
begin
   if count=0 then
      result:=''
   else
   begin
     result:=strings[0];
     for i:=1 to count-1 do
      result:=result +EOL+ strings[i];
   end;
end;

function TStatusMes.murgeWithOR:string;
var
   i:integer;
begin
   if count=0 then
      result:='Syntax Error'
   else
   begin
     result:=strings[0];
     for i:=1 to count-1 do
      result:=result +s_or + strings[i];
   end;
end;


procedure TStatusMes.insert(const s:string);
begin
   if count=0 then
      add(s)
   else
      strings[0]:=s +EOL + strings[0]
end;

procedure memSizeInit;
var  PhysicalMemory, t:Int64;
begin
  PhysicalMemory:=GetPhysicalMemory;
  SystemStackSize32:= min(PhysicalMemory-$2000000{32MB},SystemStackSize32);
  {$IFDEF Windows}
   t:=PhysicalMemory-$100000000{4GB};
   if t>VirtualStackSize64 then VirtualStackSize64:=t;
  {$ENDIF}
end;

initialization
  paramIndex:=1;
  while (ParamIndex<=ParamCount) and (copy(ParamStr(paramIndex),1,1)='-')  do
       begin
          if ParamStr(paramIndex)='-NI' then NoInitialize:=true;
          if ParamStr(paramIndex)='-OR' then OpenAndRun:=true;
          if ParamStr(paramIndex)='-NR' then NoRun:=true;
          inc(paramIndex);
       end;
  MemSizeInit;
  PaintFont:=TFont.Create;
  readIniFile;
  statusmes:=TStatusMes.create;

{$IFDEF CPU32}
try
   LongIntRound(123.4)
except
   UseAltLongIntRound:=true   // Ubuntu 12.10
end;
{$ENDIF}

availSSE41:=asm_availSSE41;
availAVX:=asm_availAVX;
availAVX2:=asm_availAVX2;




finalization
  WriteIniFile;
  PaintFont.Free;
  statusmes.free;

end.

