systems.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867
  1. {
  2. Copyright (c) 1998-2008 by Florian Klaempfl
  3. This unit contains information about the target systems supported
  4. (these are not processor specific)
  5. This program is free software; you can redistribute it and/or modify
  6. iu under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge- MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit systems;
  19. {$i fpcdefs.inc}
  20. interface
  21. {$i systems.inc}
  22. {*****************************************************************************
  23. Structures
  24. *****************************************************************************}
  25. type
  26. { Abstract linker class which is implemented in link module }
  27. TAbstractLinker = class
  28. end;
  29. TAbstractLinkerClass = class of TAbstractLinker;
  30. { Abstract assembler class which is implemented in assemble module }
  31. TAbstractAssembler = class
  32. end;
  33. TAbstractAssemblerClass = class of TAbstractAssembler;
  34. TAbstractResourceFile = class
  35. constructor create(const fn : ansistring);virtual;abstract;
  36. end;
  37. TAbstractResourceFileClass = class of TAbstractResourceFile;
  38. palignmentinfo = ^talignmentinfo;
  39. { this is written to ppus during token recording for generics so it must be packed }
  40. talignmentinfo = packed record
  41. procalign,
  42. loopalign,
  43. jumpalign,
  44. constalignmin,
  45. constalignmax,
  46. varalignmin,
  47. varalignmax,
  48. localalignmin,
  49. localalignmax,
  50. recordalignmin,
  51. recordalignmax,
  52. maxCrecordalign : longint;
  53. end;
  54. tasmflags = (af_none,
  55. af_outputbinary,af_allowdirect,
  56. af_needar,af_smartlink_sections,
  57. af_labelprefix_only_inside_procedure,
  58. af_supports_dwarf,
  59. af_no_debug,
  60. af_stabs_use_function_absolute_addresses
  61. );
  62. pasminfo = ^tasminfo;
  63. tasminfo = record
  64. id : tasm;
  65. idtxt : string[12];
  66. asmbin : string[8];
  67. asmcmd : string[50];
  68. supported_targets : set of tsystem;
  69. flags : set of tasmflags;
  70. labelprefix : string[3];
  71. comment : string[3];
  72. end;
  73. parinfo = ^tarinfo;
  74. tarinfo = record
  75. id : tar;
  76. arcmd : string[50];
  77. arfinishcmd : string[10];
  78. end;
  79. presinfo = ^tresinfo;
  80. tresinfo = record
  81. id : tres;
  82. { Compiler for resource (.rc or .res) to obj }
  83. resbin : string[10];
  84. rescmd : string[50];
  85. { Optional compiler for resource script (.rc) to binary resource (.res). }
  86. { If it is not provided resbin and rescmd will be used. }
  87. rcbin : string[10];
  88. rccmd : string[50];
  89. resourcefileclass : TAbstractResourceFileClass;
  90. resflags : set of tresinfoflags;
  91. end;
  92. pdbginfo = ^tdbginfo;
  93. tdbginfo = record
  94. id : tdbg;
  95. idtxt : string[12];
  96. end;
  97. tsystemflags = (tf_none,
  98. tf_under_development,
  99. tf_need_export,
  100. tf_needs_isconsole,
  101. tf_code_small,
  102. tf_static_reg_based,
  103. tf_needs_symbol_size,
  104. tf_smartlink_sections,
  105. tf_smartlink_library,
  106. tf_needs_dwarf_cfi,
  107. tf_use_8_3,
  108. tf_pic_uses_got,
  109. tf_library_needs_pic,
  110. tf_needs_symbol_type,
  111. tf_section_threadvars,
  112. tf_files_case_sensitive,
  113. tf_files_case_aware,
  114. tf_p_ext_support,
  115. tf_has_dllscanner,
  116. tf_use_function_relative_addresses,
  117. tf_winlikewidestring,
  118. tf_dwarf_relative_addresses, // use offsets where the Dwarf spec requires this instead of absolute addresses (the latter is needed by Linux binutils)
  119. tf_dwarf_only_local_labels, // only use local labels inside the Dwarf debug_info section (needed for e.g. Darwin)
  120. tf_requires_proper_alignment,
  121. tf_no_pic_supported,
  122. tf_pic_default,
  123. { the os does some kind of stack checking and it can be converted into a rte 202 }
  124. tf_no_generic_stackcheck,
  125. tf_has_winlike_resources,
  126. tf_safecall_clearstack, // With this flag set, after safecall calls the caller cleans up the stack
  127. tf_safecall_exceptions // Exceptions in safecall calls are not raised, but passed to the caller as an ordinal (hresult) in the function result.
  128. // The original result (if it exists) is passed as an extra parameter
  129. );
  130. psysteminfo = ^tsysteminfo;
  131. { using packed causes bus errors on processors which require alignment }
  132. tsysteminfo = record
  133. system : tsystem;
  134. name : string[34];
  135. shortname : string[9];
  136. flags : set of tsystemflags;
  137. cpu : tsystemcpu;
  138. unit_env : string[16];
  139. extradefines : string[40];
  140. exeext,
  141. defext,
  142. scriptext,
  143. smartext,
  144. unitext,
  145. unitlibext,
  146. asmext,
  147. objext,
  148. resext : string[4];
  149. resobjext : string[7];
  150. sharedlibext : string[10];
  151. staticlibext,
  152. staticlibprefix : string[4];
  153. sharedlibprefix : string[4];
  154. sharedClibext : string[10];
  155. staticClibext,
  156. staticClibprefix : string[4];
  157. sharedClibprefix : string[4];
  158. importlibprefix : string[10];
  159. importlibext : string[4];
  160. Cprefix : string[2];
  161. newline : string[2];
  162. dirsep : char;
  163. assem : tasm;
  164. assemextern : tasm; { external assembler, used by -a }
  165. link : tabstractlinkerclass;
  166. linkextern : tabstractlinkerclass; { external linker, used by -s }
  167. ar : tar;
  168. res : tres;
  169. dbg : tdbg;
  170. script : tscripttype;
  171. endian : tendian;
  172. alignment : talignmentinfo;
  173. {
  174. Offset from the argument pointer register to the first
  175. argument's address. On some machines it may depend on
  176. the data type of the function.
  177. (see also FIRST_PARM_OFFSET in GCC source)
  178. }
  179. first_parm_offset : longint;
  180. stacksize : longint;
  181. abi : tabi;
  182. end;
  183. const
  184. { alias for supported_target field in tasminfo }
  185. system_any = system_none;
  186. systems_wince = [system_arm_wince,system_i386_wince];
  187. systems_linux = [system_i386_linux,system_x86_64_linux,system_powerpc_linux,system_powerpc64_linux,
  188. system_arm_linux,system_sparc_linux,system_alpha_linux,system_m68k_linux,
  189. system_x86_6432_linux,system_mips_linux,system_mipsel_linux];
  190. systems_freebsd = [system_i386_freebsd,
  191. system_x86_64_freebsd];
  192. systems_netbsd = [system_i386_netbsd,
  193. system_m68k_netbsd,
  194. system_powerpc_netbsd];
  195. systems_openbsd = [system_i386_openbsd];
  196. systems_bsd = systems_freebsd + systems_netbsd + systems_openbsd;
  197. { all real windows systems, no cripple ones like wince, wdosx et. al. }
  198. systems_windows = [system_i386_win32,system_x86_64_win64,system_ia64_win64];
  199. { all windows systems }
  200. systems_all_windows = [system_i386_win32,system_x86_64_win64,system_ia64_win64,
  201. system_arm_wince,system_i386_wince];
  202. { all darwin systems }
  203. systems_darwin = [system_powerpc_darwin,system_i386_darwin,
  204. system_powerpc64_darwin,system_x86_64_darwin,
  205. system_arm_darwin,system_i386_iphonesim];
  206. {all solaris systems }
  207. systems_solaris = [system_sparc_solaris, system_i386_solaris,
  208. system_x86_64_solaris];
  209. { all embedded systems }
  210. systems_embedded = [system_i386_embedded,system_m68k_embedded,
  211. system_alpha_embedded,system_powerpc_embedded,
  212. system_sparc_embedded,system_vm_embedded,
  213. system_iA64_embedded,system_x86_64_embedded,
  214. system_mips_embedded,system_arm_embedded,
  215. system_powerpc64_embedded,system_avr_embedded];
  216. { all systems that allow section directive }
  217. systems_allow_section = systems_embedded;
  218. systems_allow_section_no_semicolon = systems_allow_section
  219. {$ifndef DISABLE_TLS_DIRECTORY}
  220. + systems_windows
  221. {$endif not DISABLE_TLS_DIRECTORY}
  222. ;
  223. { all symbian systems }
  224. systems_symbian = [system_i386_symbian,system_arm_symbian];
  225. { all classic Mac OS targets }
  226. systems_macos = [system_m68k_Mac,system_powerpc_Macos];
  227. { all OS/2 targets }
  228. systems_os2 = [system_i386_OS2,system_i386_emx];
  229. { all native nt systems }
  230. systems_nativent = [system_i386_nativent];
  231. { systems supporting Objective-C }
  232. systems_objc_supported = systems_darwin;
  233. { systems using the non-fragile Objective-C ABI }
  234. systems_objc_nfabi = [system_powerpc64_darwin,system_x86_64_darwin,system_arm_darwin,system_i386_iphonesim];
  235. { all systems supporting exports from programs or units }
  236. systems_unit_program_exports = [system_i386_win32,
  237. system_i386_wdosx,
  238. system_i386_Netware,
  239. system_i386_netwlibc,
  240. system_arm_wince,
  241. system_x86_64_win64,
  242. system_ia64_win64]+systems_linux;
  243. { all systems for which weak linking has been tested/is supported }
  244. systems_weak_linking = systems_darwin + systems_solaris;
  245. systems_internal_sysinit = [system_i386_linux,system_i386_win32];
  246. {$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE}
  247. { If anyone wants to use interrupt for
  248. a specific target, add a
  249. $define FPC_HAS_SYSTEMS_INTERRUPT_TABLE
  250. to fpcdefs.inc to reactivate
  251. the corresponding code }
  252. systems_interrupt_table = [{system_arm_embedded}];
  253. {$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE}
  254. { all systems for which istack must be at a 16 byte boundary
  255. when calling a function }
  256. systems_need_16_byte_stack_alignment = [
  257. system_i386_darwin,
  258. system_i386_iphonesim,
  259. system_x86_64_darwin,
  260. system_x86_64_win64,
  261. system_x86_64_linux,
  262. system_x86_64_freebsd,
  263. system_x86_64_solaris];
  264. cpu2str : array[TSystemCpu] of string[10] =
  265. ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
  266. 'mips','arm', 'powerpc64', 'avr', 'mipsel');
  267. abi2str : array[tabi] of string[10] =
  268. ('DEFAULT','SYSV','AIX','EABI','ARMEB');
  269. var
  270. targetinfos : array[tsystem] of psysteminfo;
  271. arinfos : array[tar] of parinfo;
  272. resinfos : array[tres] of presinfo;
  273. asminfos : array[tasm] of pasminfo;
  274. dbginfos : array[tdbg] of pdbginfo;
  275. source_info : tsysteminfo;
  276. target_cpu : tsystemcpu;
  277. target_info : tsysteminfo;
  278. target_asm : tasminfo;
  279. target_ar : tarinfo;
  280. target_res : tresinfo;
  281. target_dbg : tdbginfo;
  282. target_cpu_string,
  283. target_os_string : string[12]; { for rtl/<X>/,fcl/<X>/, etc. }
  284. target_full_string : string[24];
  285. function set_target(t:tsystem):boolean;
  286. function set_target_asm(t:tasm):boolean;
  287. function set_target_ar(t:tar):boolean;
  288. function set_target_res(t:tres):boolean;
  289. function set_target_dbg(t:tdbg):boolean;
  290. function find_system_by_string(const s : string) : tsystem;
  291. function find_asm_by_string(const s : string) : tasm;
  292. function find_dbg_by_string(const s : string) : tdbg;
  293. procedure set_source_info(const ti : tsysteminfo);
  294. function UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo) : boolean;
  295. procedure RegisterTarget(const r:tsysteminfo);
  296. procedure RegisterRes(const r:tresinfo; rcf : TAbstractResourceFileClass);
  297. procedure RegisterAr(const r:tarinfo);
  298. { Register the external linker. This routine is called to setup the
  299. class to use for the linker. It returns the tsysteminfo structure
  300. updated with the correct linker class for external linking.
  301. }
  302. procedure RegisterExternalLinker(var system_info: tsysteminfo; c:TAbstractLinkerClass);
  303. { Register the internal linker. This routine is called to setup the
  304. class to use for the linker. It returns the tsysteminfo structure
  305. updated with the correct linker class for internal linking.
  306. If internal linking is not supported, this class can be set
  307. to nil.
  308. }
  309. procedure RegisterInternalLinker(var system_info : tsysteminfo; c:TAbstractLinkerClass);
  310. procedure InitSystems;
  311. {$ifdef FreeBSD}
  312. function GetOSRelDate:Longint;
  313. {$endif}
  314. implementation
  315. uses
  316. cutils{$ifdef FreeBSD},SysCtl,BaseUnix{$endif};
  317. {****************************************************************************
  318. OS runtime version detection utility routine
  319. ****************************************************************************}
  320. {$ifdef FreeBSD}
  321. function GetOSRelDate:Longint;
  322. var
  323. mib : array[0..1] of cint;
  324. rval : cint;
  325. len : size_t;
  326. i : longint;
  327. v : longint;
  328. oerrno : cint;
  329. S : AnsiString;
  330. Begin
  331. s:='ab';
  332. SetLength(S,50);
  333. mib[0] := CTL_KERN;
  334. mib[1] := KERN_OSRELDATE;
  335. len := 4;
  336. oerrno:= fpgeterrno;
  337. if (FPsysctl(pChar(@mib), 2, pchar(@v), @len, NIL, 0) = -1) Then
  338. Begin
  339. if (fpgeterrno = ESysENOMEM) Then
  340. fpseterrno(oerrno);
  341. GetOSRelDate:=0;
  342. End
  343. else
  344. GetOSRelDate:=v;
  345. End;
  346. {$endif}
  347. {****************************************************************************
  348. Target setting
  349. ****************************************************************************}
  350. function set_target(t:tsystem):boolean;
  351. begin
  352. set_target:=false;
  353. if assigned(targetinfos[t]) then
  354. begin
  355. target_info:=targetinfos[t]^;
  356. set_target_asm(target_info.assem);
  357. set_target_ar(target_info.ar);
  358. set_target_res(target_info.res);
  359. set_target_dbg(target_info.dbg);
  360. target_cpu:=target_info.cpu;
  361. target_os_string:=lower(target_info.shortname);
  362. target_cpu_string:=cpu2str[target_cpu];
  363. target_full_string:=target_cpu_string+'-'+target_os_string;
  364. set_target:=true;
  365. exit;
  366. end;
  367. end;
  368. function set_target_asm(t:tasm):boolean;
  369. begin
  370. set_target_asm:=false;
  371. if assigned(asminfos[t]) and
  372. ((target_info.system in asminfos[t]^.supported_targets) or
  373. (system_any in asminfos[t]^.supported_targets)) then
  374. begin
  375. target_asm:=asminfos[t]^;
  376. set_target_asm:=true;
  377. exit;
  378. end;
  379. end;
  380. function set_target_ar(t:tar):boolean;
  381. begin
  382. result:=false;
  383. if assigned(arinfos[t]) then
  384. begin
  385. target_ar:=arinfos[t]^;
  386. result:=true;
  387. exit;
  388. end;
  389. end;
  390. function set_target_res(t:tres):boolean;
  391. begin
  392. result:=false;
  393. if assigned(resinfos[t]) then
  394. begin
  395. target_res:=resinfos[t]^;
  396. result:=true;
  397. exit;
  398. end
  399. else
  400. FillByte(target_res,sizeof(target_res),0);
  401. end;
  402. function set_target_dbg(t:tdbg):boolean;
  403. begin
  404. result:=false;
  405. if assigned(dbginfos[t]) then
  406. begin
  407. target_dbg:=dbginfos[t]^;
  408. result:=true;
  409. exit;
  410. end;
  411. end;
  412. function find_system_by_string(const s : string) : tsystem;
  413. var
  414. hs : string;
  415. t : tsystem;
  416. begin
  417. result:=system_none;
  418. hs:=upper(s);
  419. for t:=low(tsystem) to high(tsystem) do
  420. if assigned(targetinfos[t]) and
  421. (upper(targetinfos[t]^.shortname)=hs) then
  422. begin
  423. result:=t;
  424. exit;
  425. end;
  426. end;
  427. function find_asm_by_string(const s : string) : tasm;
  428. var
  429. hs : string;
  430. t : tasm;
  431. begin
  432. result:=as_none;
  433. hs:=upper(s);
  434. for t:=low(tasm) to high(tasm) do
  435. if assigned(asminfos[t]) and
  436. (asminfos[t]^.idtxt=hs) then
  437. begin
  438. result:=t;
  439. exit;
  440. end;
  441. end;
  442. function find_dbg_by_string(const s : string) : tdbg;
  443. var
  444. hs : string;
  445. t : tdbg;
  446. begin
  447. result:=dbg_none;
  448. hs:=upper(s);
  449. for t:=low(tdbg) to high(tdbg) do
  450. if assigned(dbginfos[t]) and
  451. (dbginfos[t]^.idtxt=hs) then
  452. begin
  453. result:=t;
  454. exit;
  455. end;
  456. end;
  457. function UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo) : boolean;
  458. begin
  459. result:=true;
  460. with d do
  461. begin
  462. if (s.procalign in [1,2,4,8,16,32,64,128]) or (s.procalign=256) then
  463. procalign:=s.procalign
  464. else if s.procalign<>0 then
  465. result:=false;
  466. if (s.loopalign in [1,2,4,8,16,32,64,128]) or (s.loopalign=256) then
  467. loopalign:=s.loopalign
  468. else if s.loopalign<>0 then
  469. result:=false;
  470. if (s.jumpalign in [1,2,4,8,16,32,64,128]) or (s.jumpalign=256) then
  471. jumpalign:=s.jumpalign
  472. else if s.jumpalign<>0 then
  473. result:=false;
  474. { general update rules:
  475. minimum: if higher then update
  476. maximum: if lower then update or if undefined then update }
  477. if s.constalignmin>constalignmin then
  478. constalignmin:=s.constalignmin;
  479. if (constalignmax=0) or
  480. ((s.constalignmax>0) and (s.constalignmax<constalignmax)) then
  481. constalignmax:=s.constalignmax;
  482. if s.varalignmin>varalignmin then
  483. varalignmin:=s.varalignmin;
  484. if (varalignmax=0) or
  485. ((s.varalignmax>0) and (s.varalignmax<varalignmax)) then
  486. varalignmax:=s.varalignmax;
  487. if s.localalignmin>localalignmin then
  488. localalignmin:=s.localalignmin;
  489. if (localalignmax=0) or
  490. ((s.localalignmax>0) and (s.localalignmax<localalignmax)) then
  491. localalignmax:=s.localalignmax;
  492. if s.recordalignmin>recordalignmin then
  493. recordalignmin:=s.recordalignmin;
  494. if (recordalignmax=0) or
  495. ((s.recordalignmax>0) and (s.recordalignmax<recordalignmax)) then
  496. recordalignmax:=s.recordalignmax;
  497. if (maxCrecordalign=0) or
  498. ((s.maxCrecordalign>0) and (s.maxCrecordalign<maxCrecordalign)) then
  499. maxCrecordalign:=s.maxCrecordalign;
  500. end;
  501. end;
  502. {****************************************************************************
  503. Target registration
  504. ****************************************************************************}
  505. procedure RegisterTarget(const r:tsysteminfo);
  506. var
  507. t : tsystem;
  508. begin
  509. t:=r.system;
  510. if assigned(targetinfos[t]) then
  511. writeln('Warning: Target is already registered!')
  512. else
  513. Getmem(targetinfos[t],sizeof(tsysteminfo));
  514. targetinfos[t]^:=r;
  515. end;
  516. procedure RegisterRes(const r:tresinfo; rcf : TAbstractResourceFileClass);
  517. var
  518. t : tres;
  519. begin
  520. t:=r.id;
  521. if not assigned(resinfos[t]) then
  522. Getmem(resinfos[t],sizeof(tresinfo));
  523. resinfos[t]^:=r;
  524. resinfos[t]^.resourcefileclass:=rcf;
  525. end;
  526. procedure RegisterAr(const r:tarinfo);
  527. var
  528. t : tar;
  529. begin
  530. t:=r.id;
  531. if assigned(arinfos[t]) then
  532. writeln('Warning: ar is already registered!')
  533. else
  534. Getmem(arinfos[t],sizeof(tarinfo));
  535. arinfos[t]^:=r;
  536. end;
  537. procedure RegisterExternalLinker(var system_info: tsysteminfo; c:TAbstractLinkerClass);
  538. begin
  539. system_info.linkextern := c;
  540. end;
  541. procedure RegisterInternalLinker(var system_info : tsysteminfo; c:TAbstractLinkerClass);
  542. begin
  543. system_info.link := c;
  544. end;
  545. procedure DeregisterInfos;
  546. var
  547. assem : tasm;
  548. target : tsystem;
  549. ar : tar;
  550. res : tres;
  551. dbg : tdbg;
  552. begin
  553. for target:=low(tsystem) to high(tsystem) do
  554. if assigned(targetinfos[target]) then
  555. begin
  556. freemem(targetinfos[target],sizeof(tsysteminfo));
  557. targetinfos[target]:=nil;
  558. end;
  559. for assem:=low(tasm) to high(tasm) do
  560. if assigned(asminfos[assem]) then
  561. begin
  562. freemem(asminfos[assem],sizeof(tasminfo));
  563. asminfos[assem]:=nil;
  564. end;
  565. for ar:=low(tar) to high(tar) do
  566. if assigned(arinfos[ar]) then
  567. begin
  568. freemem(arinfos[ar],sizeof(tarinfo));
  569. arinfos[ar]:=nil;
  570. end;
  571. for res:=low(tres) to high(tres) do
  572. if assigned(resinfos[res]) then
  573. begin
  574. freemem(resinfos[res],sizeof(tresinfo));
  575. resinfos[res]:=nil;
  576. end;
  577. for dbg:=low(tdbg) to high(tdbg) do
  578. if assigned(dbginfos[dbg]) then
  579. begin
  580. freemem(dbginfos[dbg],sizeof(tdbginfo));
  581. dbginfos[dbg]:=nil;
  582. end;
  583. end;
  584. {****************************************************************************
  585. Initialization of default target
  586. ****************************************************************************}
  587. procedure default_target(t:tsystem);
  588. begin
  589. set_target(t);
  590. if source_info.name='' then
  591. source_info:=target_info;
  592. end;
  593. procedure set_source_info(const ti : tsysteminfo);
  594. begin
  595. { can't use message() here (PFV) }
  596. if source_info.name<>'' then
  597. Writeln('Warning: Source OS Redefined!');
  598. source_info:=ti;
  599. end;
  600. procedure InitSystems;
  601. begin
  602. { Now default target, this is dependent on the target cpu define,
  603. when the define is the same as the source cpu then we use the source
  604. os, else we pick a default }
  605. {$ifdef i386}
  606. {$ifdef cpu86}
  607. default_target(source_info.system);
  608. {$define default_target_set}
  609. {$else cpu86}
  610. {$ifdef linux}
  611. default_target(system_i386_linux);
  612. {$define default_target_set}
  613. {$endif}
  614. {$ifdef freebsd}
  615. default_target(system_i386_freebsd);
  616. {$define default_target_set}
  617. {$endif}
  618. {$ifdef darwin}
  619. default_target(system_i386_darwin);
  620. {$define default_target_set}
  621. {$endif}
  622. {$endif cpu86}
  623. { default is linux }
  624. {$ifndef default_target_set}
  625. default_target(system_i386_linux);
  626. {$endif default_target_set}
  627. {$endif i386}
  628. {$ifdef x86_64}
  629. {$ifdef cpux86_64}
  630. default_target(source_info.system);
  631. {$define default_target_set}
  632. {$else cpux86_64}
  633. {$ifdef MSWindows}
  634. default_target(system_x86_64_win64);
  635. {$define default_target_set}
  636. {$endif}
  637. {$ifdef linux}
  638. default_target(system_x86_64_linux);
  639. {$define default_target_set}
  640. {$endif}
  641. {$ifdef freebsd}
  642. default_target(system_x86_64_freebsd);
  643. {$define default_target_set}
  644. {$endif}
  645. {$ifdef solaris}
  646. default_target(system_x86_64_solaris);
  647. {$define default_target_set}
  648. {$endif}
  649. {$ifdef darwin}
  650. default_target(system_x86_64_darwin);
  651. {$define default_target_set}
  652. {$endif}
  653. {$endif cpux86_64}
  654. { default is linux }
  655. {$ifndef default_target_set}
  656. default_target(system_x86_64_linux);
  657. {$endif default_target_set}
  658. {$endif x86_64}
  659. {$ifdef m68k}
  660. {$ifdef cpu68}
  661. default_target(source_info.target);
  662. {$else cpu68}
  663. default_target(system_m68k_linux);
  664. {$endif cpu68}
  665. {$endif m68k}
  666. {$ifdef alpha}
  667. {$ifdef cpualpha}
  668. default_target(source_info.system);
  669. {$else cpualpha}
  670. default_target(system_alpha_linux);
  671. {$endif cpualpha}
  672. {$endif alpha}
  673. {$ifdef powerpc}
  674. {$ifdef cpupowerpc}
  675. default_target(source_info.system);
  676. {$define default_target_set}
  677. {$else cpupowerpc}
  678. {$ifdef linux}
  679. default_target(system_powerpc_linux);
  680. {$define default_target_set}
  681. {$endif}
  682. {$ifdef darwin}
  683. default_target(system_powerpc_darwin);
  684. {$define default_target_set}
  685. {$endif}
  686. {$endif cpupowerpc}
  687. {$ifndef default_target_set}
  688. default_target(system_powerpc_linux);
  689. {$endif default_target_set}
  690. {$endif powerpc}
  691. {$ifdef POWERPC64}
  692. {$ifdef cpupowerpc64}
  693. default_target(source_info.system);
  694. {$define default_target_set}
  695. {$else cpupowerpc64}
  696. {$ifdef darwin}
  697. default_target(system_powerpc64_darwin);
  698. {$define default_target_set}
  699. {$endif}
  700. {$ifdef linux}
  701. default_target(system_powerpc64_linux);
  702. {$define default_target_set}
  703. {$endif}
  704. {$endif cpupowerpc64}
  705. {$ifndef default_target_set}
  706. default_target(system_powerpc64_linux);
  707. {$define default_target_set}
  708. {$endif}
  709. {$endif POWERPC64}
  710. {$ifdef sparc}
  711. {$ifdef cpusparc}
  712. default_target(source_info.system);
  713. {$else cpusparc}
  714. default_target(system_sparc_linux);
  715. {$endif cpusparc}
  716. {$endif sparc}
  717. {$ifdef arm}
  718. {$ifdef cpuarm}
  719. default_target(source_info.system);
  720. {$else cpuarm}
  721. {$ifdef WINDOWS}
  722. {$define default_target_set}
  723. default_target(system_arm_wince);
  724. {$endif}
  725. {$ifdef linux}
  726. {$define default_target_set}
  727. default_target(system_arm_linux);
  728. {$endif}
  729. {$ifdef darwin}
  730. {$define default_target_set}
  731. default_target(system_arm_darwin);
  732. {$endif}
  733. {$ifndef default_target_set}
  734. default_target(system_arm_linux);
  735. {$define default_target_set}
  736. {$endif}
  737. {$endif cpuarm}
  738. {$endif arm}
  739. {$ifdef avr}
  740. default_target(system_avr_embedded);
  741. {$endif avr}
  742. {$ifdef mips}
  743. {$ifdef mipsel}
  744. default_target(system_mipsel_linux);
  745. {$else mipsel}
  746. default_target(system_mips_linux);
  747. {$endif mipsel}
  748. {$endif mips}
  749. end;
  750. initialization
  751. source_info.name:='';
  752. finalization
  753. DeregisterInfos;
  754. end.