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