Fix 20170321 x64call

Samples/console_rops/cfg_dcc.cmd

@@ -0,0 +1,57 @@
+@echo off
+
+rem Common options
+
+  set UsePack=0
+  set EurekaLog=0
+  set DEBUG=0
+  set MAPFILE=0
+  set JDBG=0
+  set CleanDcc32Log=1
+  set DEBUG_BATCH=0
+  set TRACE_STACK_SOURCE=0
+
+  set UserLib=.
+
+  rem . RemObjects Pascal Components path:
+  set rps_lib=..\..
+  rem .
+  set UserLib=%UserLib%;%rps_lib%\Source;%rps_lib%\Source\ThirdParty
+
+:L_LIB_DONE
+  set UserLibI=%UserLib%
+  set UserLibR=%UserLib%
+
+  @rem dcc analyze result options:
+  @rem @set IGNOREERRORLEVEL=1
+
+  @rem MakeJclDbg
+  @rem   J - Create .JDBG files
+  @rem   E - Insert debug data into executable files
+  @rem   M - Delete MAP file after conversion
+  @if "%plfm%"=="w32" set MakeJclDbgO=-E
+
+  @rem path to MakeJclDbg.exe
+  @set MakeJclDbgP=%cd%\thirdparty\jcl\
+
+:L_DCU
+  if "%plfm%"=="" set plfm=w32
+
+:L_EXE
+  @rem @if "%plfm%"=="w64" set UserCOpt=%UserCOpt% -E.\..\bin\x64
+  @rem @if "%plfm%"=="w32" @set UserCOpt=%UserCOpt% -E.\..\bin
+
+:L_DCU_A
+@goto L_DCU_L
+  @rem "A:" - it is RAMDisk (ImDisk: http://www.ltr-data.se/opencode.html/#ImDisk)
+  @if not exist "A:\" goto L_DCU_L
+  @if not exist "A:\$dx\%plfm%__dcu\" md "A:\$dx\%plfm%__dcu"
+  @if not exist "A:\$dx\%plfm%__dcu\" goto L_DCU_L
+  @set UserCOpt=%UserCOpt% -N0A:\$dx\%plfm%__dcu
+  @goto :eof
+
+:L_DCU_L
+  @if not exist ".\_dcu\" md ".\_dcu"
+  @if not exist ".\_dcu\" goto :eof
+  @set UserCOpt=%UserCOpt% -N0.\_dcu
+  @goto :eof

Samples/console_rops/clean.cmd

@@ -0,0 +1,8 @@
+@del /S *.dcu;*.drc;*.dex;*.rsm;*.~*>nul 2>nul
+@del dcc32.log>nul 2>nul
+
+@if exist _dcu (
+ pushd _dcu
+ del /Q *.*>nul 2>nul
+ popd
+)

Samples/console_rops/console_rops.dpr

@@ -0,0 +1,105 @@
+program console_rops;
+// Delphi project
+{$apptype console}
+{$R console_rops.res}
+//
+// make:
+//   D2007
+//     make_prj.cmd 11 console_rops.dpr
+//   XE3
+//     make_prj.cmd 17 console_rops.dpr
+//     make_prj.cmd 17w64 console_rops.dpr
+//   DX 10.1 Berlin
+//     make_prj.cmd 24w32 console_rops.dpr
+//     make_prj.cmd 24w64 console_rops.dpr
+//
+// sample run:
+//
+//> console_rops.exe sample_hello.rops
+//
+uses
+  SysUtils, Classes, Windows,
+  uPSDebugger, uPSComponent, uPSUtils,
+  uPSCompiler, uPSRuntime;
+
+{$i console_rops.inc}
+
+const
+  Script : string = 'var s: string; begin s := ''Hello script :)''; writeln(S); end.';
+var
+  ScriptFile: string;
+  ErrorLevel: integer;
+begin
+  //
+  // parse params
+  //
+  if (ParamCount>0) then begin
+    if SameText(ExtractFileExt(ParamStr(1)),'.rops') then begin
+      ScriptFile := ParamStr(1);
+    end else begin
+      DoStrWriteLn('');
+      DoStrWriteLn('Usage as: console_rops.exe *.rops');
+      DoStrWriteLn('');
+      if (ScriptFile = '/?') or (ScriptFile = '/?help') or (ScriptFile = '-help') or (ScriptFile = '/?') then
+        Exit
+      else
+        Halt(2);
+    end;
+  end else begin
+    ScriptFile := ExtractFilePath(ParamStr(0)) + PathDelim + 'sample_default.rops';
+    if not FileExists(ScriptFile) then
+      ScriptFile := '';
+  end;
+  if ScriptFile <> '' then begin
+    ScriptsFolder := ExtractFilePath(ScriptFile);
+    if ScriptsFolder = '' then
+      ScriptsFolder := GetCurrentDir();
+  end else begin
+    //--ScriptsFolder := ExtractFilePath(ParamStr(0));
+    ScriptsFolder := GetCurrentDir();
+  end;
+  //
+  // go: ...
+  //
+  ErrorLevel := 1;
+  DoStrWriteLn;
+
+  {$IFDEF CPUX64}
+  DoStrWriteLn('# CPUX64');
+  {$ELSE}
+  {$IFDEF CPU64}
+  DoStrWriteLn('# CPU64');
+  {$ELSE}
+  {$IFDEF 32BIT}
+  DoStrWriteLn('# 32BIT');
+  {$ELSE}
+  {.$IFNDEF UNICODE}{$IFNDEF FPC}
+  DoStrWriteLn('# X86');
+  {$ENDIF}{.$ENDIF}
+  {$ENDIF}
+  {$ENDIF}
+  {$ENDIF}
+
+  DoStrWriteLn('Demo start: file: "' + ExtractFileName(ScriptFile) + '"');
+  DoStrWriteLn('-----------');
+  try
+
+    ErrorLevel := ExecuteScript(Script, ScriptFile);
+
+    DoStrWriteLn('-----------');
+
+    if ErrorLevel <> 0
+    then DoStrWriteLn('Demo failed.')
+    else DoStrWriteLn('Demo finish.');
+  except
+    on e: Exception do
+    begin
+      DoStrWriteLn;
+      DoStrWriteLn('Exception: '+Format('Class: %s; Message: %s',[e.ClassName,e.Message]));
+    end;
+  end;
+  DoStrWriteLn;
+  writeln('# errorlevel == '+inttostr(ErrorLevel));
+  if ErrorLevel <> 0 then
+    Halt(ErrorLevel);
+end.