1{ 2 This file is part of the Free Pascal run time library. 3 Copyright (c) 2007 by Pierre Muller 4 member of the Free Pascal development team. 5 6 Dummy assembler program to be able to easily test 7 all FPC targets even without cross tools. 8 9 See the file COPYING.FPC, included in this distribution, 10 for details about the copyright. 11 12 This program is distributed in the hope that it will be useful, 13 but WITHOUT ANY WARRANTY; without even the implied warranty of 14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 15 16 **********************************************************************} 17 18program dummyas; 19 20var 21 assembler_name : string; 22 object_name : string; 23 ofile : text; 24 25function RemoveSuffix(const st : string) : string; 26var 27 i,last : longint; 28begin 29 last:=length(st); 30 for i:=length(st) downto 1 do 31 begin 32 if st[i]='.' then 33 begin 34 last:=i-1; 35 break; 36 end; 37 end; 38 RemoveSuffix:=Copy(st,1,last); 39end; 40 41var 42 i : longint; 43 param : string; 44 skipnext : boolean; 45begin 46 object_name:=''; 47 skipnext:=false; 48 for i:=1 to ParamCount do 49 begin 50 param:=Paramstr(i); 51 if skipnext or (length(Param)=0) then 52 begin 53 skipnext:=false; 54 continue; 55 end; 56 if Param='-o' then 57 begin 58 skipnext:=true; 59 object_name:=ParamStr(i+1); 60 end 61 else if (Param[1]='-') then 62 begin 63 { option Param not handled } 64 { Shouldn't be a real problem } 65 end 66 else 67 begin 68 if assembler_name='' then 69 assembler_name:=ParamStr(i) 70 else 71 begin 72 Writeln(stderr,'two non option param found!'); 73 Writeln(stderr,'first non option param =',assembler_name); 74 Writeln(stderr,'second non option param =',Param); 75 Writeln(stderr,'Don''t know how to handle this!'); 76 halt(1); 77 end; 78 end; 79 end; 80 81 if assembler_name='' then 82 begin 83 Writeln(stderr,'Dummyas, no source file specified'); 84 halt(1); 85 end; 86 Assign(ofile,assembler_name); 87{$push}{$I-} 88 Reset(ofile); 89 if IOResult<>0 then 90 begin 91 Writeln(stderr,'Dummyas, source file not found ',assembler_name); 92 halt(1); 93 end; 94 Close(ofile); 95 if object_name='' then 96 object_name:=RemoveSuffix(assembler_name)+'.o'; 97 Assign(ofile,object_name); 98 Rewrite(ofile); 99 if IOResult<>0 then 100 begin 101 Writeln(stderr,'Dummyas, object file not writable ',object_name); 102 halt(1); 103 end; 104 Writeln(ofile,'Dummy as called'); 105 for i:=0 to Paramcount do 106 Write(ofile,ParamStr(i),' '); 107 Writeln(ofile); 108 Writeln(ofile,'assembler file=',assembler_name); 109 Writeln(ofile,'object file=',object_name); 110 Close(ofile); 111{$pop} 112end. 113