systems.pas 27 KB

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