systems.pas 25 KB

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