paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 11:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* palmos support from v10 merged

Browse Source
This commit is contained in:
peter 2001-08-19 11:22:22 +00:00
parent 7b45b6a4a9
commit fd8e5fa78c
13 changed files with 568 additions and 317 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/globals.pas
View File

@ -231,6 +231,12 @@ interface
{ for error info in pp.pas }
parser_current_file : string = '';
{$ifdef m68k}
{ PalmOS resources }
palmos_applicationname : string = 'FPC Application';
palmos_applicationid : string[4] = 'FPCA';
{$endif m68k}
procedure abstract;
@ -1327,7 +1333,10 @@ begin
end.
{
$Log$
Revision 1.40 2001-08-04 10:23:54 peter
Revision 1.41 2001-08-19 11:22:22 peter
* palmos support from v10 merged
Revision 1.40 2001/08/04 10:23:54 peter
* updates so it works with the ide
Revision 1.39 2001/07/01 20:16:15 peter

8
compiler/link.pas
View File

@ -27,7 +27,8 @@ unit link;
{ Needed for LFN support in path to the executable }
{$ifdef GO32V2}
{$define ALWAYSSHELL}
{ define ALWAYSSHELL, obsolete as go32v2 Dos.Exec
now handles LFN names and converts them to SFN PM }
{$endif}
interface
@ -482,7 +483,10 @@ initialization
end.
{
$Log$
Revision 1.20 2001-08-13 19:26:03 peter
Revision 1.21 2001-08-19 11:22:22 peter
* palmos support from v10 merged
Revision 1.20 2001/08/13 19:26:03 peter
* fixed ordering of object and libraries
Revision 1.19 2001/08/07 18:47:12 peter

7
compiler/msg/errore.msg
View File

@ -261,7 +261,7 @@ scan_w_unsupported_app_type=02044_W_Unsupported application type: "$1"
% with the directive \var{\{\$APPTYPE\}}
scan_w_app_type_not_support=02045_W_APPTYPE isn't support by the target OS
% The \var{\{\$APPTYPE\}} directive is supported by win32 applications only.
scan_w_decription_not_support=02046_W_DESCRIPTION is only supported for OS2 and Win32
scan_w_description_not_support=02046_W_DESCRIPTION is only supported for OS2 and Win32
% The \var{\{\$DESCRIPTION\}} directive is only supported for OS2 and Win32 targets.
scan_n_version_not_support=02047_N_VERSION is not supported by target OS.
% The \var{\{\$VERSION\}} directive is only supported by win32 target.
@ -296,6 +296,11 @@ scan_w_macro_support_turned_off=02057_W_Macro support has been turned off
% so the declaration will be ignored. To turn macro support on compile with
% -Sm on the commandline or add {$MACRO ON} in the source
scan_e_invalid_interface_type=02058_E_Illegal interface type specified. Valids are COM, CORBA or DEFAULT.
% The interface type that was specified is not supported
scan_w_appid_not_support=02059_W_APPID is only supported for PalmOS
% The \var{\{\$APPID\}} directive is only supported for the PalmOS target.
scan_w_appname_not_support=02060_W_APPNAME is only supported for PalmOS
% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target.
% \end{description}
#
# Parser

8
compiler/msgidx.inc
View File

@ -62,7 +62,7 @@ const
scan_t_back_in=02043;
scan_w_unsupported_app_type=02044;
scan_w_app_type_not_support=02045;
scan_w_decription_not_support=02046;
scan_w_description_not_support=02046;
scan_n_version_not_support=02047;
scan_n_only_exe_version=02048;
scan_w_wrong_version_ignored=02049;
@ -75,6 +75,8 @@ const
scan_w_only_one_resourcefile_supported=02056;
scan_w_macro_support_turned_off=02057;
scan_e_invalid_interface_type=02058;
scan_w_appid_not_support=02059;
scan_w_appname_not_support=02060;
parser_e_syntax_error=03000;
parser_w_proc_far_ignored=03001;
parser_w_proc_near_ignored=03002;
@ -592,9 +594,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 33103;
MsgTxtSize = 33191;
MsgIdxMax : array[1..20] of longint=(
17,59,179,37,41,41,98,14,35,42,
17,61,179,37,41,41,98,14,35,42,
30,1,1,1,1,1,1,1,1,1
);

550
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

48
compiler/options.pas
View File

@ -55,6 +55,7 @@ type
procedure Interpret_file(const filename : string);
procedure Read_Parameters;
procedure parsecmd(cmd:string);
procedure TargetDefines(def:boolean);
end;
TOptionClass=class of toption;
@ -729,7 +730,7 @@ begin
if not target_is_set then
begin
{ remove old target define }
undef_symbol(upper(target_info.shortname));
TargetDefines(false);
{ Save assembler if set }
if asm_is_set then
forceasm:=target_asm.id;
@ -740,7 +741,7 @@ begin
if asm_is_set then
set_target_asm(forceasm);
{ set new define }
def_symbol(upper(target_info.shortname));
TargetDefines(true);
target_is_set:=true;
end
else
@ -1241,6 +1242,30 @@ begin
end;
procedure TOption.TargetDefines(def:boolean);
var
s : string;
i : integer;
begin
if def then
def_symbol(upper(target_info.shortname))
else
undef_symbol(upper(target_info.shortname));
s:=target_info.extradefines;
while (s<>'') do
begin
i:=pos(';',s);
if i=0 then
i:=length(s)+1;
if def then
def_symbol(Copy(s,1,i-1))
else
def_symbol(Copy(s,1,i-1));
delete(s,1,i);
end;
end;
constructor TOption.create;
begin
DoWriteLogo:=false;
@ -1437,15 +1462,7 @@ begin
StopOptions;
{ Non-core target defines }
s:=target_info.extradefines;
while (s<>'') do
begin
i:=pos(';',s);
if i=0 then
i:=length(s)+1;
def_symbol(Copy(s,1,i-1));
delete(s,1,i);
end;
Option.TargetDefines(true);
{ endian define }
case target_info.endian of
@ -1567,10 +1584,6 @@ begin
end;
UpdateAlignment(initalignment,option.paraalignment);
{ Set defines depending on the target }
if (target_info.target in [target_i386_GO32V1,target_i386_GO32V2]) then
def_symbol('DPMI'); { MSDOS is not defined in BP when target is DPMI }
option.free;
Option:=nil;
end;
@ -1584,7 +1597,10 @@ finalization
end.
{
$Log$
Revision 1.54 2001-08-12 17:57:06 peter
Revision 1.55 2001-08-19 11:22:23 peter
* palmos support from v10 merged
Revision 1.54 2001/08/12 17:57:06 peter
* under development flag for targets
Revision 1.53 2001/08/07 18:42:46 peter

9
compiler/pdecsub.pas
View File

@ -1386,9 +1386,9 @@ const
mutexclpo : [po_external]
),(
idtok:_SYSCALL;
pd_flags : pd_interface+pd_notobjintf;
pd_flags : pd_interface+pd_implemen+pd_notobjintf;
handler : {$ifdef FPCPROCVAR}@{$endif}pd_syscall;
pocall : [pocall_palmossyscall];
pocall : [pocall_palmossyscall,pocall_cdecl,pocall_clearstack];
pooption : [];
mutexclpocall : [pocall_cdecl,pocall_cppdecl,pocall_inline,
pocall_internproc,pocall_leftright];
@ -1910,7 +1910,10 @@ const
end.
{
$Log$
Revision 1.31 2001-08-05 13:18:50 peter
Revision 1.32 2001-08-19 11:22:23 peter
* palmos support from v10 merged
Revision 1.31 2001/08/05 13:18:50 peter
* turn pocall_inline off when inline is not supported
Revision 1.30 2001/08/01 15:07:29 jonas

9
compiler/pmodules.pas
View File

@ -1208,10 +1208,6 @@ implementation
aktprocsym.definition.aliasnames.insert('program_init');
aktprocsym.definition.aliasnames.insert('PASCALMAIN');
aktprocsym.definition.aliasnames.insert(target_info.cprefix+'main');
{$ifdef m68k}
if target_info.target=target_m68k_PalmOS then
aktprocsym.definition.aliasnames.insert('PilotMain');
{$endif m68k}
end;
compile_proc_body(true,false);
@ -1339,7 +1335,10 @@ implementation
end.
{
$Log$
Revision 1.43 2001-08-12 19:59:49 peter
Revision 1.44 2001-08-19 11:22:23 peter
* palmos support from v10 merged
Revision 1.43 2001/08/12 19:59:49 peter
* typo in extdebug msg
Revision 1.42 2001/08/06 21:40:47 peter

33
compiler/scandir.pas
View File

@ -156,6 +156,28 @@ implementation
Message1(scan_w_unsupported_asmmode_specifier,s);
end;
{$ifdef m68k}
procedure dir_appid;
begin
if target_info.target<>target_m68k_palmos then
Message(scan_w_appid_not_support);
{ change description global var in all cases }
{ it not used but in win32 and os2 }
current_scanner^.skipspace;
palmos_applicationid:=current_scanner^.readcomment;
end;
procedure dir_appname;
begin
if target_info.target<>target_m68k_palmos then
Message(scan_w_appname_not_support);
{ change description global var in all cases }
{ it not used but in win32 and os2 }
current_scanner^.skipspace;
palmos_applicationname:=current_scanner^.readcomment;
end;
{$endif m68k}
procedure dir_apptype;
var
hs : string;
@ -198,7 +220,7 @@ implementation
procedure dir_description;
begin
if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then
Message(scan_w_decription_not_support);
Message(scan_w_description_not_support);
{ change description global var in all cases }
{ it not used but in win32, os2 and netware }
current_scanner.skipspace;
@ -810,6 +832,10 @@ implementation
procedure InitScannerDirectives;
begin
AddDirective('ALIGN',{$ifdef FPCPROCVAR}@{$endif}dir_align);
{$ifdef m68k}
AddDirective('APPID',{$ifdef FPCPROCVAR}@{$endif}dir_appid);
AddDirective('APPNAME',{$ifdef FPCPROCVAR}@{$endif}dir_appname);
{$endif m68k}
AddDirective('APPTYPE',{$ifdef FPCPROCVAR}@{$endif}dir_apptype);
AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
@ -887,7 +913,10 @@ implementation
end.
{
$Log$
Revision 1.6 2001-08-07 18:47:13 peter
Revision 1.7 2001-08-19 11:22:24 peter
* palmos support from v10 merged
Revision 1.6 2001/08/07 18:47:13 peter
* merged netbsd start
* profile for win32

11
compiler/systems.pas
View File

@ -69,7 +69,8 @@ interface
as_i386_nasmelf,as_i386_nasmobj,
as_i386_tasm,as_i386_masm,
as_i386_dbg,as_i386_coff,as_i386_pecoff,as_i386_elf32
,as_m68k_as,as_m68k_gas,as_m68k_mit,as_m68k_mot,as_m68k_mpw
,as_m68k_as,as_m68k_gas,as_m68k_mit,as_m68k_mot,
as_m68k_mpw,as_m68k_palm
,as_alpha_as
,as_powerpc_as,as_powerpc_mpw
);
@ -152,6 +153,9 @@ interface
ttargetflags = (tf_none,
tf_under_development,tf_supports_stack_checking,
tf_need_export,tf_needs_isconsole
{$ifdef m68k}
,tf_code_small,tf_static_a5_based
{$endif m68k}
);
ptargetinfo = ^ttargetinfo;
@ -637,7 +641,10 @@ finalization
end.
{
$Log$
Revision 1.23 2001-08-12 17:57:07 peter
Revision 1.24 2001-08-19 11:22:24 peter
* palmos support from v10 merged
Revision 1.23 2001/08/12 17:57:07 peter
* under development flag for targets
Revision 1.22 2001/08/07 18:47:13 peter

7
compiler/targets/t_go32v1.pas
View File

@ -200,7 +200,7 @@ end;
flags : [];
cpu : i386;
unit_env : 'GO32V1UNITS';
extradefines : '';
extradefines : 'DPMI';
sharedlibext : '.dll';
staticlibext : '.a';
sourceext : '.pp';
@ -260,7 +260,10 @@ initialization
end.
{
$Log$
Revision 1.8 2001-08-07 18:47:15 peter
Revision 1.9 2001-08-19 11:22:24 peter
* palmos support from v10 merged
Revision 1.8 2001/08/07 18:47:15 peter
* merged netbsd start
* profile for win32

7
compiler/targets/t_go32v2.pas
View File

@ -422,7 +422,7 @@ end;
flags : [];
cpu : i386;
unit_env : 'GO32V2UNITS';
extradefines : '';
extradefines : 'DPMI';
sharedlibext : '.dll';
staticlibext : '.a';
sourceext : '.pp';
@ -482,7 +482,10 @@ initialization
end.
{
$Log$
Revision 1.10 2001-08-07 18:47:15 peter
Revision 1.11 2001-08-19 11:22:24 peter
* palmos support from v10 merged
Revision 1.10 2001/08/07 18:47:15 peter
* merged netbsd start
* profile for win32

177
compiler/targets/t_palmos.pas
View File

@ -27,14 +27,180 @@ unit t_palmos;
interface
uses
link;
type
tlinkerPalmOS=class(tlinker)
private
Function WriteResponseFile : Boolean;
public
constructor Create;override;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
implementation
uses
link,
cutils,cclasses,
globtype,globals,systems,verbose,script,fmodule;
{****************************************************************************
TLinkerPalmOS
****************************************************************************}
Constructor TLinkerPalmOS.Create;
begin
Inherited Create;
{ allow duplicated libs (PM) }
SharedLibFiles.doubles:=true;
StaticLibFiles.doubles:=true;
end;
procedure TLinkerPalmOS.SetDefaultInfo;
begin
with Info do
begin
ExeCmd[1]:='ldpalm $OPT $STRIP -N -dy -T $SCRIPT -o $EXE @$RES';
ExeCmd[2]:='build-prc $EXE.prc "$APPNAME" $APPID $EXE *.bin';
end;
end;
Function TLinkerPalmOS.WriteResponseFile : Boolean;
Var
linkres : TLinkRes;
i : longint;
HPath : PStringQueueItem;
s : string;
linklibc : boolean;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
{ Write path to search libraries }
HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+HPath.Str);
HPath:=TStringListItem(HPath.Next);
end;
HPath:=TStringListItem(LibrarySearchPath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+HPath.Str);
HPath:=TStringListItem(HPath.Next);
end;
{ add objectfiles, start with crt0 always }
{ using crt0, we should stick C compatible }
LinkRes.AddFileName(FindObjectFile('crt0',''));
{ main objectfiles }
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
LinkRes.AddFileName(s);
end;
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
LinkRes.Add('-(');
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
LinkRes.AddFileName(s)
end;
LinkRes.Add('-)');
end;
{ currently the PalmOS target must be linked always against the C lib }
LinkRes.Add('-lcrt');
{ Write sharedlibraries like -l<lib>, also add the needed dynamic linker
here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
linklibc:=false;
While not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.GetFirst;
if s<>'c' then
begin
i:=Pos(target_info.sharedlibext,S);
if i>0 then
Delete(S,i,255);
LinkRes.Add('-l'+s);
end
else
linklibc:=true;
end;
{ be sure that libc is the last lib }
if linklibc then
begin
LinkRes.Add('-lc');
LinkRes.Add('-lgcc');
end;
{ Write and Close response }
linkres.writetodisk;
linkres.Free;
WriteResponseFile:=True;
end;
function TLinkerPalmOS.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
StripStr : string[40];
i : longint;
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module^.exefilename^);
{ Create some replacements }
StripStr:='';
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
{ Write used files and libraries }
WriteResponseFile;
{ Call linker }
success:=false;
for i:=1 to 2 do
begin
SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
if binstr<>'' then
begin
Replace(cmdstr,'$EXE',MaybeQuote(current_module.exefilename^));
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',outputexedir+Info.ResName);
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$SCRIPT',FindUtil('palm.ld'));
Replace(cmdstr,'$APPNAME',palmos_applicationname);
Replace(cmdstr,'$APPID',palmos_applicationid);
success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
if not success then
break;
end;
end;
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(outputexedir+Info.ResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
{*****************************************************************************
Initialize
*****************************************************************************}
@ -46,7 +212,7 @@ implementation
target : target_m68k_PalmOS;
name : 'PalmOS';
shortname : 'palmos';
flags : [];
flags : [tf_code_small,tf_static_a5_based];
cpu : m68k;
short_name : 'PALMOS';
unit_env : 'PALMUNITS';
@ -78,7 +244,7 @@ implementation
script : script_unix;
endian : endian_big;
stackalignment : 2;
maxCrecordalignment : 32;
maxCrecordalignment : 4;
size_of_pointer : 4;
size_of_longint : 4;
heapsize : 128*1024;
@ -97,7 +263,10 @@ initialization
end.
{
$Log$
Revision 1.4 2001-08-07 18:47:15 peter
Revision 1.5 2001-08-19 11:22:24 peter
* palmos support from v10 merged
Revision 1.4 2001/08/07 18:47:15 peter
* merged netbsd start
* profile for win32