diff options
Diffstat (limited to 'closures/compiler/utils/dummyas.pp')
-rw-r--r-- | closures/compiler/utils/dummyas.pp | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/closures/compiler/utils/dummyas.pp b/closures/compiler/utils/dummyas.pp new file mode 100644 index 0000000000..922acc3091 --- /dev/null +++ b/closures/compiler/utils/dummyas.pp @@ -0,0 +1,112 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by Pierre Muller + member of the Free Pascal development team. + + Dummy assembler program to be able to easily test + all FPC targets even without cross tools. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +program dummyas; + +var + assembler_name : string; + object_name : string; + ofile : text; + +function RemoveSuffix(const st : string) : string; +var + i,last : longint; +begin + last:=length(st); + for i:=length(st) downto 1 do + begin + if st[i]='.' then + begin + last:=i-1; + break; + end; + end; + RemoveSuffix:=Copy(st,1,last); +end; + +var + i : longint; + param : string; + skipnext : boolean; +begin + object_name:=''; + skipnext:=false; + for i:=1 to ParamCount do + begin + param:=Paramstr(i); + if skipnext or (length(Param)=0) then + begin + skipnext:=false; + continue; + end; + if Param='-o' then + begin + skipnext:=true; + object_name:=ParamStr(i+1); + end + else if (Param[1]='-') then + begin + { option Param not handled } + { Shouldn't be a real problem } + end + else + begin + if assembler_name='' then + assembler_name:=ParamStr(i) + else + begin + Writeln(stderr,'two non option param found!'); + Writeln(stderr,'first non option param =',assembler_name); + Writeln(stderr,'second non option param =',Param); + Writeln(stderr,'Don''t know how to handle this!'); + halt(1); + end; + end; + end; + + if assembler_name='' then + begin + Writeln(stderr,'Dummyas, no source file specified'); + halt(1); + end; + Assign(ofile,assembler_name); +{$push}{$I-} + Reset(ofile); + if IOResult<>0 then + begin + Writeln(stderr,'Dummyas, source file not found ',assembler_name); + halt(1); + end; + Close(ofile); + if object_name='' then + object_name:=RemoveSuffix(assembler_name)+'.o'; + Assign(ofile,object_name); + Rewrite(ofile); + if IOResult<>0 then + begin + Writeln(stderr,'Dummyas, object file not writable ',object_name); + halt(1); + end; + Writeln(ofile,'Dummy as called'); + for i:=0 to Paramcount do + Write(ofile,ParamStr(i),' '); + Writeln(ofile); + Writeln(ofile,'assembler file=',assembler_name); + Writeln(ofile,'object file=',object_name); + Close(ofile); +{$pop} +end. |