');
+ writeln(' Normally fpc is searched in PATH and used as compiler.');
+ writeln;
+ writeln('Normal usage is to add as first line ("shebang") "#!/usr/bin/instantfpc"');
+ writeln('to a program source file. Then you can execute the source like a script.');
+ Halt(0);
+end;
+
+Procedure DisplayCache;
+
+begin
+ write(GetCacheDir);
+ Halt(0);
+end ;
+
+var
+ i,j: Integer;
+ p: String;
+ Filename: String;
+ Src: TStringList;
+ CacheDir: String;
+ CacheFilename: String;
+ OutputFilename: String;
+ ExeExt: String;
+ E : String;
+
+// Return true if filename found.
+
+Function InterpretParam(p : String) : boolean;
+
+begin
+ Result:=False;
+ if (P='') then exit;
+ if p='-v' then
+ begin
+ writeln('instantfpc '+Version);
+ Halt(1);
+ end
+ else if p='-h' then
+ usage
+ else if p='--get-cache' then
+ DisplayCache
+ else if copy(p,1,11)='--compiler=' then
+ begin
+ delete(P,1,11);
+ SetCompiler(p);
+ end
+ else if copy(p,1,12)='--set-cache=' then
+ begin
+ delete(P,1,12);
+ SetCacheDir(p);
+ end
+ else if (P<>'') and (p[1]<>'-') then
+ begin
+ Filename:=p;
+ Result:=True;
+ end;
+end;
+
+begin
+ Filename:='';
+ { For example:
+ /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1
+ }
+ for i:=1 to Paramcount do
+ begin
+ p:=ParamStr(i);
+ if p='' then
+ continue
+ else
+ begin
+ if (I<>1) then
+ begin
+ if InterpretParam(p) then
+ Break;
+ end
+ else
+ begin
+ // The linux kernel passes the whole shebang line as 1 argument.
+ // We must parse and split it ourselves.
+ Repeat
+ J:=Pos(' ',P);
+ if (J=0) then
+ J:=Length(P)+1;
+ if InterpretParam(Copy(P,1,J-1)) then
+ Break;
+ Delete(P,1,J);
+ Until (P='');
+ if (FileName<>'') then
+ Break;
+ end;
+ end;
+ end;
+ if (Filename='') then
+ begin
+ writeln('missing source file');
+ Halt(1);
+ end;
+ CheckSourceName(Filename);
+
+ Src:=TStringList.Create;
+ try
+ Src.LoadFromFile(Filename);
+ CommentShebang(Src);
+ CacheDir:=GetCacheDir;
+
+ // check cache
+ CacheFilename:=CacheDir+ExtractFileName(Filename);
+ E:=LowerCase(ExtractFileExt(CacheFileName));
+ if (E<>'.pp') and (E<>'.pas') and (E<>'.lpr') then
+ CacheFileName:=CacheFileName+'.pas';
+ ExeExt:='';
+ OutputFilename:=CacheDir+ChangeFileExt(ExtractFileName(Filename),ExeExt);
+ if not IsCacheValid(Src,CacheFilename,OutputFilename) then begin
+ // save source in cache to find out next time if something changed
+ Src.SaveToFile(CacheFilename);
+ Compile(CacheFilename,OutputFilename);
+ end;
+ // run
+ Run(OutputFilename);
+ finally
+ // memory is freed by OS, but for debugging puposes you can do it manually
+ {$IFDEF IFFreeMem}
+ Proc.Free;
+ Src.Free;
+ {$ENDIF}
+ end;
+end.
+
diff --git a/applications/instantfpc/instantfptools.pas b/applications/instantfpc/instantfptools.pas
new file mode 100644
index 000000000..397078487
--- /dev/null
+++ b/applications/instantfpc/instantfptools.pas
@@ -0,0 +1,271 @@
+unit InstantFPTools;
+
+{$mode objfpc}{$H+}
+
+{$define UseFpExecV}
+
+{$ifdef WINDOWS}
+ {$undef UseFpExecV}
+ {$define HASEXEEXT}
+{$endif WINDOWS}
+{$ifdef go32v2}
+ {$undef UseFpExecV}
+ {$define HASEXEEXT}
+{$endif go32v2}
+
+interface
+
+uses
+ {$IFDEF UseFpExecV}
+ Unix,
+ {$ENDIF}
+ Classes, SysUtils, Process;
+
+procedure CheckSourceName(const Filename: string);
+procedure CommentShebang(Src: TStringList);
+function GetCacheDir: string;
+procedure SetCacheDir(AValue : string);
+function IsCacheValid(Src: TStringList;
+ const CachedSrcFile, CachedExeFile: string): boolean;
+procedure Compile(const CacheFilename, OutputFilename: string);
+function GetCompiler: string;
+procedure SetCompiler(AValue : string);
+function GetCompilerParameters(const SrcFilename, OutputFilename: string): string;
+procedure Run(const Filename: string);
+
+implementation
+
+Var
+ CmdCacheDir : String;
+ CmdCompiler : String;
+
+procedure AddParam(p: string; var Line: string);
+begin
+ if p='' then exit;
+ if Line<>'' then Line:=Line+' ';
+ if (p[1]<>'"') and (System.Pos(' ',p)>0) then
+ p:='"'+p+'"';
+ Line:=Line+p;
+end;
+
+procedure CheckSourceName(const Filename: string);
+var
+ Ext: String;
+begin
+ // avoid name clashes
+ Ext:=lowercase(ExtractFileExt(Filename));
+ if (Ext<>'') and (Ext<>'.pas') and (Ext<>'.pp') and (Ext<>'.p')
+ and (Ext<>'.lpr') and (Ext<>'.txt') and (Ext<>'.sh') and (Ext<>'.cgi')
+ then begin
+ writeln('invalid source extension ',Ext);
+ Halt(1);
+ end;
+end;
+
+procedure CommentShebang(Src: TStringList);
+var
+ Line: string;
+ i: Integer;
+begin
+ // comment shebang #!
+ if (Src.Count=0) then exit;
+ Line:=Src[0];
+ i:=1;
+ if copy(Line,1,3)=#$EF#$BB#$BF then
+ inc(i,3);// UTF8 BOM
+ if (i>length(Line)) or (Line[i]<>'#') then exit;
+ Src[0]:=copy(Line,1,i-1)+'//'+copy(Line,i,length(Line));
+end;
+
+
+procedure SetCacheDir(AValue : string);
+
+begin
+ CmdCacheDir:=AValue;
+end;
+
+function GetCacheDir: string;
+begin
+ Result:=CmdCacheDir;
+ if (Result='') then
+ begin
+ Result:=GetEnvironmentVariable('INSTANTFPCCACHE');
+ if Result='' then
+ begin
+ Result:=GetEnvironmentVariable('HOME');
+ if Result<>'' then
+ Result:=IncludeTrailingPathDelimiter(Result)+'.cache'+PathDelim+'instantfpc';
+ end;
+ end;
+ if Result='' then begin
+ writeln('missing environment variable: HOME or INSTANTFPCCACHE');
+ Halt(1);
+ end;
+ Result:=IncludeTrailingPathDelimiter(ExpandFileName(Result));
+ if not ForceDirectories(Result) then begin
+ writeln('unable to create cache directory "'+Result+'"');
+ Halt(1);
+ end;
+end;
+
+function IsCacheValid(Src: TStringList; const CachedSrcFile,
+ CachedExeFile: string): boolean;
+var
+ OldSrc: TStringList;
+ i: Integer;
+ p: String;
+begin
+ Result:=false;
+ for i:=1 to Paramcount do begin
+ p:=ParamStr(i);
+ if (p='') or (p[1]<>'-') then break;
+ if p='-B' then exit; // always compile
+ end;
+ if not FileExists(CachedSrcFile) then exit;
+ if not FileExists(CachedExeFile) then exit;
+ OldSrc:=TStringList.Create;
+ OldSrc.LoadFromFile(CachedSrcFile);
+ Result:=Src.Equals(OldSrc);
+ {$IFDEF IFFreeMem}
+ OldSrc.Free;
+ {$ENDIF}
+end;
+
+procedure SetCompiler(AValue : string);
+
+begin
+ CmdCompiler:=AValue;
+end;
+
+function GetCompiler: string;
+
+var
+ Path: String;
+ p: Integer;
+ StartPos: LongInt;
+ Dir: String;
+ CompFile: String;
+
+begin
+ Result:=CmdCompiler;
+ if (Result<>'') then
+ begin
+ Result:=ExpandFileName(Result);
+ if not FileExists(Result) then
+ begin
+ writeln('Error: '+Result+' not found, check the --compiler parameter.');
+ Halt(1);
+ end;
+ exit;
+ end;
+
+ {$IFDEF Windows}
+ CompFile:='fpc.exe';
+ {$ELSE}
+ CompFile:='fpc';
+ {$ENDIF}
+ Path:=GetEnvironmentVariable('PATH');
+ {$IFDEF VER2_4}
+ if PATH<>'' then begin
+ p:=1;
+ while p<=length(Path) do begin
+ StartPos:=p;
+ while (p<=length(Path)) and (Path[p]<>':') do inc(p);
+ if StartPos0 then
+ ss.write(buf,count);
+ until Count=0;
+ if (not Proc.WaitOnExit) or (Proc.ExitStatus<>0) then begin
+ write(ss.DataString);
+ Halt(1);
+ end;
+ ss.Free;
+ Proc.Free;
+end;
+
+function GetCompilerParameters(const SrcFilename, OutputFilename: string): string;
+{ For example:
+ /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1
+ The shebang compile parameters: -MObjFpc -Sh
+}
+var
+ p: String;
+ i : integer;
+begin
+ Result:='';
+ I:=1;
+ While (I<=ParamCount) and (Copy(ParamStr(i),1,1)='-') do
+ begin
+ p:=ParamStr(i);
+ if (Copy(p,1,1)='-') and (copy(p,1,2)<>'--') then
+ AddParam(P,Result);
+ inc(I);
+ end;
+ AddParam('-o'+OutputFilename {$IFDEF HASEXEEXT} + '.exe' {$ENDIF},Result);
+ AddParam(SrcFilename,Result);
+end;
+
+procedure Run(const Filename: string);
+var
+ p: PPChar;
+begin
+ p:=argv;
+ inc(p);
+ while (p<>nil) do begin
+ if (p^<>nil) and (p^^<>'-') then begin
+ break;
+ end;
+ inc(p);
+ end;
+ {$IFNDEF UseFpExecV}
+ Inc(p); //lose the first command-line argument with the the script filename
+ Halt(ExecuteProcess(Filename,[p^]));
+ {$ELSE}
+ Halt(FpExecV(Filename,p));
+ {$ENDIF}
+end;
+
+end.
+