systems.pas 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825
  1. {
  2. Copyright (c) 1998-2002 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 3 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. type
  22. tendian = (endian_little,endian_big);
  23. (*
  24. IMPORTANT NOTE:
  25. The value of this enumeration is stored in PPU files.
  26. Therefore adding new CPU targets should not change the
  27. values of the pre-existing targets. (CEC)
  28. FURTHERMORE : Make sure that this branch values, are
  29. consistant with the main branch version always.
  30. *)
  31. tsystemcpu=
  32. (
  33. cpu_no, { 0 }
  34. cpu_i386, { 1 }
  35. cpu_m68k, { 2 }
  36. cpu_alpha, { 3 }
  37. cpu_powerpc, { 4 }
  38. cpu_sparc, { 5 }
  39. cpu_vm, { 6 }
  40. cpu_iA64, { 7 }
  41. cpu_x86_64, { 8 }
  42. cpu_mips, { 9 }
  43. cpu_arm, { 10 }
  44. cpu_powerpc64 { 11 }
  45. );
  46. tasmmode= (asmmode_none
  47. { standard assembler (cpu dependant) with full parsing }
  48. ,asmmode_standard
  49. ,asmmode_i386_att
  50. ,asmmode_i386_intel
  51. ,asmmode_ppc_gas
  52. ,asmmode_ppc_motorola
  53. ,asmmode_arm_gas
  54. ,asmmode_sparc_gas
  55. ,asmmode_x86_64_gas
  56. ,asmmode_m68k_mot
  57. ,asmmode_x86_64_intel
  58. );
  59. (* IMPORTANT NOTE:
  60. the integer value of this enum is stored in PPU
  61. files to recognize the target, so if you add new targets
  62. allways add them at end PM
  63. FURTHERMORE : Make sure that this branch values are
  64. consistant with the main branch version always. (CEC)
  65. *)
  66. type
  67. tsystem =
  68. (
  69. system_none, { 0 }
  70. obsolete_system_i386_GO32V1,{ 1 }
  71. system_i386_GO32V2, { 2 }
  72. system_i386_linux, { 3 }
  73. system_i386_OS2, { 4 }
  74. system_i386_Win32, { 5 }
  75. system_i386_freebsd, { 6 }
  76. system_m68k_Amiga, { 7 }
  77. system_m68k_Atari, { 8 }
  78. system_m68k_Mac, { 9 }
  79. system_m68k_linux, { 10 }
  80. system_m68k_PalmOS, { 11 }
  81. system_alpha_linux, { 12 }
  82. system_powerpc_linux, { 13 }
  83. system_powerpc_macos, { 14 }
  84. system_i386_solaris, { 15 }
  85. system_i386_beos, { 16 }
  86. system_i386_netbsd, { 17 }
  87. system_m68k_netbsd, { 18 }
  88. system_i386_Netware, { 19 }
  89. system_i386_qnx, { 20 }
  90. system_i386_wdosx, { 21 }
  91. system_sparc_solaris, { 22 }
  92. system_sparc_linux, { 23 }
  93. system_i386_openbsd, { 24 }
  94. system_m68k_openbsd, { 25 }
  95. system_x86_64_linux, { 26 }
  96. system_powerpc_darwin, { 27 }
  97. system_i386_EMX, { 28 }
  98. system_powerpc_netbsd, { 29 }
  99. system_powerpc_openbsd, { 30 }
  100. system_arm_linux, { 31 }
  101. system_i386_watcom, { 32 }
  102. system_powerpc_MorphOS, { 33 }
  103. system_x86_64_freebsd, { 34 }
  104. system_i386_netwlibc, { 35 }
  105. system_powerpc_Amiga, { 36 }
  106. system_x86_64_win64, { 37 }
  107. system_arm_wince, { 38 }
  108. system_ia64_win64, { 39 }
  109. system_i386_wince, { 40 }
  110. system_x86_6432_linux, { 41 }
  111. system_arm_gba, { 42 }
  112. system_powerpc64_linux, { 43 }
  113. system_i386_darwin, { 44 }
  114. system_arm_palmos { 45 }
  115. );
  116. tasm = (as_none
  117. ,as_gas { standard gnu assembler }
  118. ,as_i386_as_aout
  119. ,as_i386_nasmcoff
  120. ,as_i386_nasmwin32
  121. ,as_i386_nasmwdosx
  122. ,as_i386_nasmelf
  123. ,as_i386_nasmobj
  124. ,as_i386_nasmbeos
  125. ,as_i386_tasm
  126. ,as_i386_masm
  127. ,as_i386_wasm
  128. ,as_i386_coff
  129. ,as_i386_pecoff
  130. ,as_i386_elf32
  131. ,as_i386_pecoffwdosx
  132. ,as_m68k_mit
  133. ,as_powerpc_mpw
  134. ,as_darwin
  135. ,as_x86_64_masm
  136. ,as_x86_64_pecoff
  137. ,as_i386_pecoffwince
  138. ,as_arm_pecoffwince
  139. ,as_x86_64_elf64
  140. ,as_sparc_elf32
  141. );
  142. tar = (ar_none
  143. ,ar_gnu_ar
  144. ,ar_mpw_ar
  145. ,ar_gnu_ar_scripted
  146. ,ar_gnu_gar
  147. );
  148. tres = (res_none
  149. ,res_gnu_windres,res_emxbind
  150. ,res_m68k_palmos,res_m68k_mpw
  151. ,res_powerpc_mpw,res_elf
  152. ,res_gnu_wince_windres
  153. );
  154. tdbg = (dbg_none
  155. ,dbg_stabs,dbg_dwarf
  156. );
  157. tscripttype = (script_none
  158. ,script_dos,script_unix,script_amiga,
  159. script_mpw
  160. );
  161. tabi = (abi_default
  162. ,abi_powerpc_sysv,abi_powerpc_aix
  163. );
  164. {*****************************************************************************
  165. Structures
  166. *****************************************************************************}
  167. type
  168. { Abstract linker class which is implemented in link module }
  169. TAbstractLinker = class
  170. end;
  171. TAbstractLinkerClass = class of TAbstractLinker;
  172. { Abstract assembler class which is implemented in assemble module }
  173. TAbstractAssembler = class
  174. end;
  175. TAbstractAssemblerClass = class of TAbstractAssembler;
  176. palignmentinfo = ^talignmentinfo;
  177. talignmentinfo = record
  178. procalign,
  179. loopalign,
  180. jumpalign,
  181. constalignmin,
  182. constalignmax,
  183. varalignmin,
  184. varalignmax,
  185. localalignmin,
  186. localalignmax,
  187. recordalignmin,
  188. recordalignmax,
  189. maxCrecordalign : longint;
  190. end;
  191. tasmflags = (af_none,
  192. af_outputbinary,af_allowdirect,
  193. af_needar,af_smartlink_sections,
  194. af_labelprefix_only_inside_procedure,
  195. af_supports_dwarf
  196. );
  197. pasminfo = ^tasminfo;
  198. tasminfo = record
  199. id : tasm;
  200. idtxt : string[12];
  201. asmbin : string[8];
  202. asmcmd : string[50];
  203. supported_target : tsystem;
  204. flags : set of tasmflags;
  205. labelprefix : string[3];
  206. comment : string[3];
  207. end;
  208. parinfo = ^tarinfo;
  209. tarinfo = record
  210. id : tar;
  211. arcmd : string[50];
  212. arfinishcmd : string[10];
  213. end;
  214. presinfo = ^tresinfo;
  215. tresinfo = record
  216. id : tres;
  217. resbin : string[8];
  218. rescmd : string[50];
  219. end;
  220. pdbginfo = ^tdbginfo;
  221. tdbginfo = record
  222. id : tdbg;
  223. idtxt : string[12];
  224. end;
  225. tsystemflags = (tf_none,
  226. tf_under_development,
  227. tf_need_export,
  228. tf_needs_isconsole,
  229. tf_code_small,
  230. tf_static_reg_based,
  231. tf_needs_symbol_size,
  232. tf_smartlink_sections,
  233. tf_needs_dwarf_cfi,
  234. tf_use_8_3,
  235. tf_pic_uses_got,
  236. tf_library_needs_pic,
  237. tf_needs_symbol_type,
  238. tf_section_threadvars,
  239. tf_files_case_sensitive,
  240. tf_files_case_aware,
  241. tf_p_ext_support,
  242. tf_has_dllscanner,
  243. tf_use_function_relative_addresses,
  244. tf_winlikewidestring
  245. );
  246. psysteminfo = ^tsysteminfo;
  247. { using packed causes bus errors on processors which require alignment }
  248. tsysteminfo = record
  249. system : tsystem;
  250. name : string[34];
  251. shortname : string[9];
  252. flags : set of tsystemflags;
  253. cpu : tsystemcpu;
  254. unit_env : string[16];
  255. extradefines : string[40];
  256. exeext,
  257. defext,
  258. scriptext,
  259. smartext,
  260. unitext,
  261. unitlibext,
  262. asmext,
  263. objext,
  264. resext,
  265. resobjext : string[4];
  266. sharedlibext : string[10];
  267. staticlibext,
  268. staticlibprefix : string[4];
  269. sharedlibprefix : string[4];
  270. sharedClibext : string[10];
  271. staticClibext,
  272. staticClibprefix : string[4];
  273. sharedClibprefix : string[4];
  274. Cprefix : string[2];
  275. newline : string[2];
  276. dirsep : char;
  277. assem : tasm;
  278. assemextern : tasm; { external assembler, used by -a }
  279. link : tabstractlinkerclass;
  280. linkextern : tabstractlinkerclass; { external linker, used by -s }
  281. ar : tar;
  282. res : tres;
  283. dbg : tdbg;
  284. script : tscripttype;
  285. endian : tendian;
  286. alignment : talignmentinfo;
  287. {
  288. Offset from the argument pointer register to the first
  289. argument's address. On some machines it may depend on
  290. the data type of the function.
  291. (see also FIRST_PARM_OFFSET in GCC source)
  292. }
  293. first_parm_offset : longint;
  294. stacksize : longint;
  295. abi : tabi;
  296. end;
  297. const
  298. { alias for supported_target field in tasminfo }
  299. system_any = system_none;
  300. system_wince : set of tsystem = [system_arm_wince,system_i386_wince];
  301. system_linux = [system_i386_linux,system_x86_64_linux,system_powerpc_linux,
  302. system_arm_linux,system_sparc_linux,system_alpha_linux,system_m68k_linux,
  303. system_x86_6432_linux];
  304. { all real windows systems, no cripple ones like wince, wdosx et. al. }
  305. system_windows : set of tsystem = [system_i386_win32,system_x86_64_win64,system_ia64_win64];
  306. { all windows systems }
  307. system_all_windows : set of tsystem = [system_i386_win32,system_x86_64_win64,system_ia64_win64,
  308. system_arm_wince,system_i386_wince];
  309. { all systems supporting exports from programs or units }
  310. system_unit_program_exports : set of tsystem = [system_i386_win32,
  311. system_i386_wdosx,
  312. system_i386_Netware,
  313. system_i386_netwlibc,
  314. system_arm_wince,
  315. system_x86_64_win64,
  316. system_ia64_win64]+system_linux;
  317. cpu2str : array[TSystemCpu] of string =
  318. ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
  319. 'mips','arm', 'powerpc64');
  320. var
  321. targetinfos : array[tsystem] of psysteminfo;
  322. arinfos : array[tar] of parinfo;
  323. resinfos : array[tres] of presinfo;
  324. asminfos : array[tasm] of pasminfo;
  325. dbginfos : array[tdbg] of pdbginfo;
  326. source_info : tsysteminfo;
  327. target_cpu : tsystemcpu;
  328. target_info : tsysteminfo;
  329. target_asm : tasminfo;
  330. target_ar : tarinfo;
  331. target_res : tresinfo;
  332. target_dbg : tdbginfo;
  333. target_cpu_string,
  334. target_os_string : string[12]; { for rtl/<X>/,fcl/<X>/, etc. }
  335. target_full_string : string[24];
  336. function set_target(t:tsystem):boolean;
  337. function set_target_asm(t:tasm):boolean;
  338. function set_target_ar(t:tar):boolean;
  339. function set_target_res(t:tres):boolean;
  340. function set_target_dbg(t:tdbg):boolean;
  341. function find_system_by_string(const s : string) : tsystem;
  342. function find_asm_by_string(const s : string) : tasm;
  343. function find_dbg_by_string(const s : string) : tdbg;
  344. procedure set_source_info(const ti : tsysteminfo);
  345. procedure UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo);
  346. procedure RegisterTarget(const r:tsysteminfo);
  347. procedure RegisterRes(const r:tresinfo);
  348. procedure RegisterAr(const r:tarinfo);
  349. { Register the external linker. This routine is called to setup the
  350. class to use for the linker. It returns the tsysteminfo structure
  351. updated with the correct linker class for external linking.
  352. }
  353. procedure RegisterExternalLinker(var system_info: tsysteminfo; c:TAbstractLinkerClass);
  354. { Register the internal linker. This routine is called to setup the
  355. class to use for the linker. It returns the tsysteminfo structure
  356. updated with the correct linker class for internal linking.
  357. If internal linking is not supported, this class can be set
  358. to nil.
  359. }
  360. procedure RegisterInternalLinker(var system_info : tsysteminfo; c:TAbstractLinkerClass);
  361. procedure InitSystems;
  362. {$ifdef FreeBSD}
  363. function GetOSRelDate:Longint;
  364. {$endif}
  365. implementation
  366. uses
  367. cutils{$ifdef FreeBSD},SysCtl,BaseUnix{$endif};
  368. {****************************************************************************
  369. OS runtime version detection utility routine
  370. ****************************************************************************}
  371. {$ifdef FreeBSD}
  372. function GetOSRelDate:Longint;
  373. var
  374. mib : array[0..1] of cint;
  375. rval : cint;
  376. len : size_t;
  377. i : longint;
  378. v : longint;
  379. oerrno : cint;
  380. S : AnsiString;
  381. Begin
  382. s:='ab';
  383. SetLength(S,50);
  384. mib[0] := CTL_KERN;
  385. mib[1] := KERN_OSRELDATE;
  386. len := 4;
  387. oerrno:= fpgeterrno;
  388. if (FPsysctl(@mib, 2, pchar(@v), @len, NIL, 0) = -1) Then
  389. Begin
  390. if (fpgeterrno = ESysENOMEM) Then
  391. fpseterrno(oerrno);
  392. GetOSRelDate:=0;
  393. End
  394. else
  395. GetOSRelDate:=v;
  396. End;
  397. {$endif}
  398. {****************************************************************************
  399. Target setting
  400. ****************************************************************************}
  401. function set_target(t:tsystem):boolean;
  402. begin
  403. set_target:=false;
  404. if assigned(targetinfos[t]) then
  405. begin
  406. target_info:=targetinfos[t]^;
  407. set_target_asm(target_info.assem);
  408. set_target_ar(target_info.ar);
  409. set_target_res(target_info.res);
  410. set_target_dbg(target_info.dbg);
  411. target_cpu:=target_info.cpu;
  412. target_os_string:=lower(target_info.shortname);
  413. target_cpu_string:=cpu2str[target_cpu];
  414. target_full_string:=target_cpu_string+'-'+target_os_string;
  415. set_target:=true;
  416. exit;
  417. end;
  418. end;
  419. function set_target_asm(t:tasm):boolean;
  420. begin
  421. set_target_asm:=false;
  422. if assigned(asminfos[t]) and
  423. ((asminfos[t]^.supported_target=target_info.system) or
  424. (asminfos[t]^.supported_target=system_any)) then
  425. begin
  426. target_asm:=asminfos[t]^;
  427. set_target_asm:=true;
  428. exit;
  429. end;
  430. end;
  431. function set_target_ar(t:tar):boolean;
  432. begin
  433. result:=false;
  434. if assigned(arinfos[t]) then
  435. begin
  436. target_ar:=arinfos[t]^;
  437. result:=true;
  438. exit;
  439. end;
  440. end;
  441. function set_target_res(t:tres):boolean;
  442. begin
  443. result:=false;
  444. if assigned(resinfos[t]) then
  445. begin
  446. target_res:=resinfos[t]^;
  447. result:=true;
  448. exit;
  449. end;
  450. end;
  451. function set_target_dbg(t:tdbg):boolean;
  452. begin
  453. result:=false;
  454. if assigned(dbginfos[t]) then
  455. begin
  456. target_dbg:=dbginfos[t]^;
  457. result:=true;
  458. exit;
  459. end;
  460. end;
  461. function find_system_by_string(const s : string) : tsystem;
  462. var
  463. hs : string;
  464. t : tsystem;
  465. begin
  466. result:=system_none;
  467. hs:=upper(s);
  468. for t:=low(tsystem) to high(tsystem) do
  469. if assigned(targetinfos[t]) and
  470. (upper(targetinfos[t]^.shortname)=hs) then
  471. begin
  472. result:=t;
  473. exit;
  474. end;
  475. end;
  476. function find_asm_by_string(const s : string) : tasm;
  477. var
  478. hs : string;
  479. t : tasm;
  480. begin
  481. result:=as_none;
  482. hs:=upper(s);
  483. for t:=low(tasm) to high(tasm) do
  484. if assigned(asminfos[t]) and
  485. (asminfos[t]^.idtxt=hs) then
  486. begin
  487. result:=t;
  488. exit;
  489. end;
  490. end;
  491. function find_dbg_by_string(const s : string) : tdbg;
  492. var
  493. hs : string;
  494. t : tdbg;
  495. begin
  496. result:=dbg_none;
  497. hs:=upper(s);
  498. for t:=low(tdbg) to high(tdbg) do
  499. if assigned(dbginfos[t]) and
  500. (dbginfos[t]^.idtxt=hs) then
  501. begin
  502. result:=t;
  503. exit;
  504. end;
  505. end;
  506. procedure UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo);
  507. begin
  508. with d do
  509. begin
  510. { general update rules:
  511. minimum: if higher then update
  512. maximum: if lower then update or if undefined then update }
  513. if s.procalign>procalign then
  514. procalign:=s.procalign;
  515. if s.loopalign>loopalign then
  516. loopalign:=s.loopalign;
  517. if s.jumpalign>jumpalign then
  518. jumpalign:=s.jumpalign;
  519. if s.constalignmin>constalignmin then
  520. constalignmin:=s.constalignmin;
  521. if (constalignmax=0) or
  522. ((s.constalignmax>0) and (s.constalignmax<constalignmax)) then
  523. constalignmax:=s.constalignmax;
  524. if s.varalignmin>varalignmin then
  525. varalignmin:=s.varalignmin;
  526. if (varalignmax=0) or
  527. ((s.varalignmax>0) and (s.varalignmax<varalignmax)) then
  528. varalignmax:=s.varalignmax;
  529. if s.localalignmin>localalignmin then
  530. localalignmin:=s.localalignmin;
  531. if (localalignmax=0) or
  532. ((s.localalignmax>0) and (s.localalignmax<localalignmax)) then
  533. localalignmax:=s.localalignmax;
  534. if s.recordalignmin>recordalignmin then
  535. recordalignmin:=s.recordalignmin;
  536. if (recordalignmax=0) or
  537. ((s.recordalignmax>0) and (s.recordalignmax<recordalignmax)) then
  538. recordalignmax:=s.recordalignmax;
  539. if (maxCrecordalign=0) or
  540. ((s.maxCrecordalign>0) and (s.maxCrecordalign<maxCrecordalign)) then
  541. maxCrecordalign:=s.maxCrecordalign;
  542. end;
  543. end;
  544. {****************************************************************************
  545. Target registration
  546. ****************************************************************************}
  547. procedure RegisterTarget(const r:tsysteminfo);
  548. var
  549. t : tsystem;
  550. begin
  551. t:=r.system;
  552. if assigned(targetinfos[t]) then
  553. writeln('Warning: Target is already registered!')
  554. else
  555. Getmem(targetinfos[t],sizeof(tsysteminfo));
  556. targetinfos[t]^:=r;
  557. end;
  558. procedure RegisterRes(const r:tresinfo);
  559. var
  560. t : tres;
  561. begin
  562. t:=r.id;
  563. if assigned(resinfos[t]) then
  564. writeln('Warning: resourcecompiler is already registered!')
  565. else
  566. Getmem(resinfos[t],sizeof(tresinfo));
  567. resinfos[t]^:=r;
  568. end;
  569. procedure RegisterAr(const r:tarinfo);
  570. var
  571. t : tar;
  572. begin
  573. t:=r.id;
  574. if assigned(arinfos[t]) then
  575. writeln('Warning: ar is already registered!')
  576. else
  577. Getmem(arinfos[t],sizeof(tarinfo));
  578. arinfos[t]^:=r;
  579. end;
  580. procedure RegisterExternalLinker(var system_info: tsysteminfo; c:TAbstractLinkerClass);
  581. begin
  582. system_info.linkextern := c;
  583. end;
  584. procedure RegisterInternalLinker(var system_info : tsysteminfo; c:TAbstractLinkerClass);
  585. begin
  586. system_info.link := c;
  587. end;
  588. procedure DeregisterInfos;
  589. var
  590. assem : tasm;
  591. target : tsystem;
  592. ar : tar;
  593. res : tres;
  594. dbg : tdbg;
  595. begin
  596. for target:=low(tsystem) to high(tsystem) do
  597. if assigned(targetinfos[target]) then
  598. begin
  599. freemem(targetinfos[target],sizeof(tsysteminfo));
  600. targetinfos[target]:=nil;
  601. end;
  602. for assem:=low(tasm) to high(tasm) do
  603. if assigned(asminfos[assem]) then
  604. begin
  605. freemem(asminfos[assem],sizeof(tasminfo));
  606. asminfos[assem]:=nil;
  607. end;
  608. for ar:=low(tar) to high(tar) do
  609. if assigned(arinfos[ar]) then
  610. begin
  611. freemem(arinfos[ar],sizeof(tarinfo));
  612. arinfos[ar]:=nil;
  613. end;
  614. for res:=low(tres) to high(tres) do
  615. if assigned(resinfos[res]) then
  616. begin
  617. freemem(resinfos[res],sizeof(tresinfo));
  618. resinfos[res]:=nil;
  619. end;
  620. for dbg:=low(tdbg) to high(tdbg) do
  621. if assigned(dbginfos[dbg]) then
  622. begin
  623. freemem(dbginfos[dbg],sizeof(tdbginfo));
  624. dbginfos[dbg]:=nil;
  625. end;
  626. end;
  627. {****************************************************************************
  628. Initialization of default target
  629. ****************************************************************************}
  630. procedure default_target(t:tsystem);
  631. begin
  632. set_target(t);
  633. if source_info.name='' then
  634. source_info:=target_info;
  635. end;
  636. procedure set_source_info(const ti : tsysteminfo);
  637. begin
  638. { can't use message() here (PFV) }
  639. if source_info.name<>'' then
  640. Writeln('Warning: Source OS Redefined!');
  641. source_info:=ti;
  642. end;
  643. procedure InitSystems;
  644. begin
  645. { Now default target, this is dependent on the target cpu define,
  646. when the define is the same as the source cpu then we use the source
  647. os, else we pick a default }
  648. {$ifdef i386}
  649. {$ifdef cpu86}
  650. default_target(source_info.system);
  651. {$else cpu86}
  652. {$ifdef linux}
  653. default_target(system_i386_linux);
  654. {$endif}
  655. {$ifdef freebsd}
  656. default_target(system_i386_freebsd);
  657. {$endif}
  658. {$endif cpu86}
  659. {$endif i386}
  660. {$ifdef x86_64}
  661. {$ifdef cpux86_64}
  662. default_target(source_info.system);
  663. {$define source_system_set}
  664. {$else cpux86_64}
  665. {$ifdef MSWindows}
  666. default_target(system_x86_64_win64);
  667. {$define source_system_set}
  668. {$endif}
  669. {$ifdef linux}
  670. default_target(system_x86_64_linux);
  671. {$define source_system_set}
  672. {$endif}
  673. {$ifdef freebsd}
  674. default_target(system_x86_64_freebsd);
  675. {$define source_system_set}
  676. {$endif}
  677. { default is linux }
  678. {$ifndef source_system_set}
  679. default_target(system_x86_64_linux);
  680. {$endif source_system_set}
  681. {$endif cpux86_64}
  682. {$endif x86_64}
  683. {$ifdef m68k}
  684. {$ifdef cpu68}
  685. default_target(source_info.target);
  686. {$else cpu68}
  687. default_target(system_m68k_linux);
  688. {$endif cpu68}
  689. {$endif m68k}
  690. {$ifdef alpha}
  691. {$ifdef cpualpha}
  692. default_target(source_info.system);
  693. {$else cpualpha}
  694. default_target(system_alpha_linux);
  695. {$endif cpualpha}
  696. {$endif alpha}
  697. {$ifdef powerpc}
  698. {$ifdef cpupowerpc}
  699. default_target(source_info.system);
  700. {$else cpupowerpc}
  701. default_target(system_powerpc_linux);
  702. {$endif cpupowerpc}
  703. {$endif powerpc}
  704. {$ifdef POWERPC64}
  705. {$ifdef cpupowerpc64}
  706. default_target(source_info.system);
  707. {$else cpupowerpc64}
  708. default_target(system_powerpc64_linux);
  709. {$endif cpupowerpc64}
  710. {$endif POWERPC64}
  711. {$ifdef sparc}
  712. {$ifdef cpusparc}
  713. default_target(source_info.system);
  714. {$else cpusparc}
  715. default_target(system_sparc_linux);
  716. {$endif cpusparc}
  717. {$endif sparc}
  718. {$ifdef arm}
  719. {$ifdef cpuarm}
  720. default_target(source_info.system);
  721. {$else cpuarm}
  722. default_target(system_arm_linux);
  723. {$endif cpuarm}
  724. {$endif arm}
  725. end;
  726. initialization
  727. source_info.name:='';
  728. finalization
  729. DeregisterInfos;
  730. end.