| blob | ffb2ae73af8fe0ade58b2e100f2bd64e83d80f40 |
1 {
2 $Id$
3 Copyright (c) 1998-2000 by Florian Klaempfl
5 Helper routines for the i386 code generator
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 ****************************************************************************}
25 interface
27 uses
32 {$define TESTGETTEMP to store const that
33 are written into temps for later release PM }
82 { pushes qword location to the stack }
86 { remove non regvar registers in loc from regs (in the format }
87 { pushusedregisters uses) }
89 { releases the registers of a location }
117 {$ifdef TEMPS_NOT_PUSH}
118 { does the same as restore/\v, but uses temp. space instead of pushing }
121 {$endif TEMPS_NOT_PUSH}
130 procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;destreg:Tregister;delloc:boolean);
133 procedure concatcopy(source,dest : treference;size : longint;delsource : boolean;loadref:boolean);
136 procedure genentrycode(alist : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
143 { if a unit doesn't have a explicit init/final code, }
144 { we've to generate one, if the units has ansistrings }
145 { in the interface or implementation }
148 {$ifdef test_dest_loc}
150 const
151 { used to avoid temporary assignments }
157 var
162 {$endif test_dest_loc}
164 implementation
166 uses
169 {$ifdef GDB}
170 ,gdb
171 {$endif}
172 {$ifndef NOTARGETWIN32}
173 ,t_win32
174 {$endif}
175 ;
178 {*****************************************************************************
179 Helpers
180 *****************************************************************************}
183 begin
188 else
195 var
197 begin
202 { I don't know if we need it (FK) }
204 else
208 begin
213 o1:=S_BW
214 else
218 begin
231 begin
236 else
243 begin
256 begin
269 begin
282 var
284 begin
286 begin
295 end
301 var
304 begin
306 begin
324 end
329 {*****************************************************************************
330 Emit Assembler
331 *****************************************************************************}
334 begin
337 else
341 {$ifdef nojmpfix}
343 var
345 begin
348 else
349 begin
356 {$else nojmpfix}
358 var
360 begin
363 else
364 begin
371 {$endif nojmpfix}
374 var
377 begin
383 begin
386 else
393 begin
398 begin
403 begin
408 begin
413 begin
418 begin
423 begin
428 begin
433 begin
439 begin
444 begin
449 begin
454 begin
459 begin
463 procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;ref : preference);
464 begin
469 begin
473 { only usefull in startup code }
475 begin
480 procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize;freetemp:boolean);
481 var
485 begin
488 LOC_REGISTER,
494 LOC_MEM,
499 else
500 begin
503 { we can't do a getregister in the code generator }
504 { without problems!!! }
507 else
508 begin
517 {$ifndef noAllocEdi}
520 {$endif noAllocEdi}
527 begin
530 else
533 {$ifndef noAllocEdi}
536 {$endif noAllocEdi}
537 { we can release the registers }
538 { but only AFTER the MOV! Important for the optimizer!
539 (JM)}
545 else
552 begin
554 LOC_REGISTER,
559 LOC_MEM,
564 else
565 begin
570 else
576 begin
578 LOC_REGISTER,
583 LOC_MEM,
587 else
588 begin
593 else
600 begin
602 LOC_MEM,
606 else
607 begin
614 else
621 begin
623 LOC_REGISTER,
630 LOC_MEM,
634 else
635 begin
643 else
651 var
654 begin
656 LOC_REGISTER,
657 LOC_CREGISTER:
658 begin
664 LOC_MEM,
665 LOC_REFERENCE:
666 begin
670 hr)));
680 begin
682 LOC_REGISTER:
683 { can't be a regvar, since it would be LOC_CREGISTER then }
686 begin
702 begin
704 LOC_REGISTER,
705 LOC_CREGISTER:
706 begin
709 LOC_MEM,
710 LOC_REFERENCE:
717 begin
719 LOC_REGISTER,
720 LOC_CREGISTER:
721 begin
725 LOC_MEM,
726 LOC_REFERENCE:
734 begin
736 LOC_REGISTER,
741 LOC_MEM,
745 else
750 else
757 var
759 begin
761 LOC_REGISTER,
765 else
769 LOC_MEM,
772 opsize:=S_L
773 else
777 else
782 else
789 begin
791 LOC_MEM,
795 else
796 begin
797 {$ifndef noAllocEdi}
799 {$endif noAllocEdi}
804 {$ifndef noAllocEdi}
806 {$endif noAllocEdi}
808 { release the registers }
813 else
820 begin
822 LOC_MEM,
826 else
827 begin
828 {$ifndef noAllocEdi}
830 {$endif noAllocEdi}
834 {$ifndef noAllocEdi}
836 {$endif noAllocEdi}
841 else
848 var
851 begin
853 begin
857 else
859 end
860 else
862 begin
873 else
876 end
877 else
880 else
887 var
890 begin
896 { This can't be never a l-value! (FK)
897 p^.location.loc:=LOC_REFERENCE; }
899 LOC_REGISTER:
900 begin
902 begin
911 end
912 else
915 LOC_MEM,
916 LOC_REFERENCE : ;
923 { This can't be never a l-value! (FK)
924 p^.location.loc:=LOC_REFERENCE; }
926 else
934 begin
935 { ranges are a little bit bug sensitive ! }
938 begin
942 begin
947 begin
956 begin
957 { ranges are a little bit bug sensitive ! }
960 begin
965 begin
970 begin
979 var
982 begin
983 { if we load a 64 bit reference, we must be careful because }
984 { we could overwrite the registers of the reference by }
985 { accident }
988 begin
990 R_EDI);
992 end
994 begin
996 R_EDI);
1008 {*****************************************************************************
1009 Emit String Functions
1010 *****************************************************************************}
1014 begin
1016 { if it's deleted right before it's used, the optimizer can move }
1017 { the reg deallocations to the right places (JM) }
1022 else
1026 maybe_loadesi;
1030 begin
1034 else
1038 maybe_loadesi;
1044 var
1047 begin
1051 begin
1053 end
1055 begin
1057 end
1065 var
1068 begin
1072 begin
1074 end
1076 begin
1078 end
1084 {
1085 copies an ansistring from p^.right to p^.left, we
1086 assume, that both sides are ansistring, firstassignement have
1087 to take care of that, an ansistring can't be a register variable
1088 }
1089 var
1093 begin
1094 { before pushing any parameter, we have to save all used }
1095 { registers, but before that we have to release the }
1096 { registers of that node to save uneccessary pushed }
1097 { so be careful, if you think you can optimize that code (FK) }
1099 { nevertheless, this has to be changed, because otherwise the }
1100 { register is released before it's contents are pushed -> }
1101 { problems with the optimizer (JM) }
1104 { Find out which registers have to be pushed (JM) }
1107 { And push them (JM) }
1111 begin
1116 begin
1117 { First release the registers because emit_push_mem may }
1118 { load the reference in edi before pushing and then the }
1119 { dealloc is too late (and optimizations are missed (JM) }
1121 { This one doesn't need extra registers (JM) }
1129 maybe_loadesi;
1136 {*****************************************************************************
1137 Emit Push Functions
1138 *****************************************************************************}
1141 var
1143 {hregister : tregister; }
1144 {$ifdef TEMPS_NOT_PUSH}
1146 {$endif TEMPS_NOT_PUSH}
1147 begin
1149 begin
1151 begin
1153 begin
1154 {$ifdef TEMPS_NOT_PUSH}
1160 {$else TEMPS_NOT_PUSH}
1162 {$endif TEMPS_NOT_PUSH}
1164 end
1165 {$ifdef TEMPS_NOT_PUSH}
1166 else
1167 begin
1170 end
1171 {$endif TEMPS_NOT_PUSH}
1172 ;
1174 {$ifdef TEMPS_NOT_PUSH}
1176 {$else TEMPS_NOT_PUSH}
1178 {$endif TEMPS_NOT_PUSH}
1180 end
1185 begin
1187 {$ifndef noAllocEdi}
1189 {$endif noAllocEdi}
1191 R_EDI);
1192 {$ifdef TEMPS_NOT_PUSH}
1196 {$else TEMPS_NOT_PUSH}
1198 {$endif TEMPS_NOT_PUSH}
1199 {$ifndef noAllocEdi}
1201 {$endif noAllocEdi}
1203 end
1205 end
1210 {$ifdef TEMPS_NOT_PUSH}
1213 var
1217 begin
1219 begin
1221 begin
1223 begin
1230 end
1231 else
1232 begin
1239 end
1244 begin
1246 {$ifndef noAllocEdi}
1248 {$endif noAllocEdi}
1250 R_EDI);
1253 {$ifndef noAllocEdi}
1255 {$endif noAllocEdi}
1258 end
1260 end
1264 {$endif TEMPS_NOT_PUSH}
1268 begin
1272 Then
1273 begin
1274 {$ifndef noAllocEdi}
1276 {$endif noAllocEdi}
1279 {$ifndef noAllocEdi}
1281 {$endif noAllocEdi}
1282 end
1283 else
1289 begin
1292 else
1293 begin
1296 then
1297 begin
1298 {$ifndef noAllocEdi}
1300 {$endif noAllocEdi}
1303 {$ifndef noAllocEdi}
1305 {$endif noAllocEdi}
1306 end
1313 var
1315 begin
1316 { this will fail for references to other segments !!! }
1318 { is this right ? }
1319 begin
1320 { push_int(ref.offset)}
1325 end
1326 else
1327 begin
1338 else
1339 begin
1340 {$ifndef noAllocEdi}
1342 {$endif noAllocEdi}
1345 {$ifndef noAllocEdi}
1347 {$endif noAllocEdi}
1354 {
1355 copies p a set element on the stack
1356 }
1357 var
1359 begin
1360 { copy the element on the stack, slightly complicated }
1362 begin
1365 else
1367 end
1368 else
1369 begin
1371 LOC_REGISTER,
1372 LOC_CREGISTER :
1373 begin
1377 begin
1382 begin
1387 begin
1394 else
1398 else
1399 begin
1400 { you can't push more bytes than the size of the element, }
1401 { because this may cross a page boundary and you'll get a }
1402 { sigsegv (JM) }
1412 var
1414 {$ifdef TEMPS_NOT_PUSH}
1416 {$endif TEMPS_NOT_PUSH}
1417 begin
1419 {$ifdef TEMPS_NOT_PUSH}
1424 {$else TEMPS_NOT_PUSH}
1426 {$endif TEMPS_NOT_PUSH}
1428 begin
1431 begin
1433 {$ifdef TEMPS_NOT_PUSH}
1436 { set correctly for release ! }
1438 {$else TEMPS_NOT_PUSH}
1440 {$endif TEMPS_NOT_PUSH}
1442 end
1443 else
1444 begin
1446 { any reasons why this was moved into the index register ? }
1447 { normally usage of base register is much better (FK) }
1449 { Why is this done? We can never be sure about p^.left
1450 because otherwise secondload fails !!!
1451 set_location(p^.left^.location,p^.location);}
1453 {$ifdef TEMPS_NOT_PUSH}
1455 {$endif TEMPS_NOT_PUSH}
1458 {$ifdef TEMPS_NOT_PUSH}
1460 var
1464 begin
1471 begin
1474 begin
1478 { set correctly for release ! }
1481 end
1482 else
1483 begin
1486 { Why is this done? We can never be sure about p^.left
1487 because otherwise secondload fails PM
1488 set_location(p^.left^.location,p^.location);}
1492 {$endif TEMPS_NOT_PUSH}
1496 var
1504 begin
1506 LOC_REGISTER,
1507 LOC_CREGISTER:
1508 begin
1512 begin
1514 begin
1517 begin
1524 end
1525 else
1530 end
1531 else
1532 begin
1535 begin
1539 end
1540 else
1546 begin
1548 begin
1552 end
1553 else
1554 begin
1560 begin
1563 end
1564 else
1569 begin
1571 begin
1575 end
1576 else
1577 begin
1582 { we must push always 16 bit }
1584 begin
1587 end
1588 else
1595 LOC_FPU:
1596 begin
1601 {$ifdef GDB}
1605 {$endif GDB}
1608 { this is the easiest case for inlined !! }
1610 begin
1617 LOC_CFPUREGISTER:
1618 begin
1625 {$ifdef GDB}
1629 {$endif GDB}
1632 { this is the easiest case for inlined !! }
1634 begin
1641 begin
1645 enumdef,
1646 orddef :
1647 begin
1652 begin
1653 {$ifndef noAllocEdi}
1655 {$endif noAllocEdi}
1660 {$ifndef noAllocEdi}
1663 {$endif noAllocEdi}
1669 {$ifndef noAllocEdi}
1671 {$endif noAllocEdi}
1672 end
1673 else
1674 begin
1684 begin
1685 {$ifndef noAllocEdi}
1687 {$endif noAllocEdi}
1692 {$ifndef noAllocEdi}
1694 {$endif noAllocEdi}
1695 end
1696 else
1701 begin
1705 end
1706 else
1707 begin
1713 begin
1714 {$ifndef noAllocEdi}
1716 {$endif noAllocEdi}
1721 {$ifndef noAllocEdi}
1723 {$endif noAllocEdi}
1724 end
1725 else
1728 else
1732 floatdef :
1733 begin
1735 f32bit,
1736 s32real :
1737 begin
1740 begin
1741 {$ifndef noAllocEdi}
1743 {$endif noAllocEdi}
1748 {$ifndef noAllocEdi}
1750 {$endif noAllocEdi}
1751 end
1752 else
1755 s64real,
1756 s64comp :
1757 begin
1761 begin
1762 {$ifndef noAllocEdi}
1764 {$endif noAllocEdi}
1769 {$ifndef noAllocEdi}
1771 {$endif noAllocEdi}
1772 end
1773 else
1778 begin
1779 {$ifndef noAllocEdi}
1781 {$endif noAllocEdi}
1786 {$ifndef noAllocEdi}
1788 {$endif noAllocEdi}
1789 end
1790 else
1793 s80real :
1794 begin
1798 else
1801 begin
1802 {$ifndef noAllocEdi}
1804 {$endif noAllocEdi}
1809 {$ifndef noAllocEdi}
1811 {$endif noAllocEdi}
1812 end
1813 else
1818 begin
1819 {$ifndef noAllocEdi}
1821 {$endif noAllocEdi}
1826 {$ifndef noAllocEdi}
1828 {$endif noAllocEdi}
1829 end
1830 else
1833 begin
1838 end
1839 else
1840 begin
1847 begin
1848 {$ifndef noAllocEdi}
1850 {$endif noAllocEdi}
1855 {$ifndef noAllocEdi}
1857 {$endif noAllocEdi}
1858 end
1859 else
1865 pointerdef,
1866 procvardef,
1867 classrefdef:
1868 begin
1871 begin
1872 {$ifndef noAllocEdi}
1874 {$endif noAllocEdi}
1879 {$ifndef noAllocEdi}
1881 {$endif noAllocEdi}
1882 end
1883 else
1886 arraydef,
1887 recorddef,
1888 stringdef,
1889 setdef,
1890 objectdef :
1891 begin
1892 { even some structured types are 32 bit }
1897 (
1907 begin
1910 begin
1913 begin
1916 end
1917 else
1919 end
1920 else
1921 begin
1923 begin
1926 begin
1929 end
1930 else
1934 end
1935 { call by value open array ? }
1937 begin
1938 { push on stack }
1944 end
1945 else
1948 else
1952 LOC_JUMP:
1953 begin
1956 begin
1959 end
1960 else
1961 begin
1967 begin
1970 end
1971 else
1976 begin
1979 end
1980 else
1984 LOC_FLAGS:
1985 begin
1987 begin
1988 {$ifndef noAllocEdi}
1990 {$endif noAllocEdi}
1996 begin
2000 end
2001 else
2002 begin
2008 begin
2011 end
2012 else
2015 begin
2017 {$ifndef noAllocEdi}
2019 {$endif noAllocEdi}
2022 {$ifdef SUPPORT_MMX}
2023 LOC_MMXREGISTER,
2024 LOC_CMMXREGISTER:
2025 begin
2029 {$ifdef GDB}
2033 {$endif GDB}
2035 begin
2039 end
2040 else
2041 begin
2047 {$endif SUPPORT_MMX}
2053 {*****************************************************************************
2054 Emit Float Functions
2055 *****************************************************************************}
2058 begin
2066 { ???? }
2083 var
2086 begin
2095 begin
2113 else
2120 var
2123 begin
2131 {*****************************************************************************
2132 Emit Functions
2133 *****************************************************************************}
2136 {
2137 produces jumps to true respectively false labels using boolean expressions
2138 }
2139 var
2142 begin
2144 exit;
2148 begin
2150 begin
2153 else
2155 end
2156 else
2157 begin
2180 end
2181 else
2187 { produces if necessary overflowcode }
2189 var
2191 begin
2193 exit;
2200 else
2206 { produces range check code, while one of the operands is a 64 bit
2207 integer }
2210 var
2211 neglabel,
2212 poslabel,
2223 begin
2229 begin
2233 { get the high dword in a register }
2236 else
2237 begin
2245 { check high dword, must be 0 (for positive numbers) }
2249 { It can also be $ffffffff, but only for negative numbers }
2251 begin
2258 { For all other values we have a range check error }
2261 { if the high dword = 0, the low dword can be considered a }
2262 { simple cardinal }
2265 { the real p^.resulttype is already saved in fromdef }
2269 { restore original resulttype }
2273 begin
2276 { if the high dword = $ffffffff, then the low dword (when }
2277 { considered as a longint) must be < 0 }
2281 else
2282 begin
2287 { get a new neglabel (JM) }
2296 { if we get here, the 64bit value lies between }
2297 { longint($80000000) and -1 (JM) }
2307 { restore p's resulttype }
2308 end
2309 else
2310 { todef = 64bit int }
2311 { no 64bit subranges supported, so only a small check is necessary }
2313 { if both are signed or both are unsigned, no problem! }
2315 { also not if the fromdef is unsigned and < 64bit, since that will }
2316 { always fit in a 64bit int (todef is 64bit) }
2319 begin
2320 { in all cases, there is only a problem if the higest bit is set }
2324 else
2326 else
2327 begin
2336 opcode := A_MOVSX
2338 else
2355 { produces if necessary rangecheckcode }
2357 {
2358 generate range checking code for the value at location t. The
2359 type used is the checked against todefs ranges. fromdef (p^.resulttype)
2360 is the original type used at that location, when both defs are
2361 equal the check is also insert (needed for succ,pref,inc,dec)
2362 }
2363 var
2364 neglabel,
2374 doublebound,
2375 is_reg,
2377 begin
2378 { range checking on and range checkable value? }
2381 exit;
2382 { only check when assigning to scalar, subranges are different,
2383 when todef=fromdef then the check is always generated }
2386 begin
2388 exit;
2390 {we also need lto and hto when checking if we need to use doublebound!
2391 (JM)}
2394 begin
2396 { first check for not being u32bit, then if the to is bigger than
2397 from }
2400 exit;
2402 { generate the rangecheck code for the def where we are going to
2403 store the result }
2406 orddef :
2407 begin
2410 doublebound:=
2415 enumdef :
2416 begin
2420 arraydef :
2421 begin
2427 { get op and opsize }
2430 op:=A_MOV
2431 else
2433 op:=A_MOVSX
2434 else
2440 begin
2441 { FPC_BOUNDCHECK needs to be called with
2442 %ecx - value
2443 %edi - pointer to the ranges }
2447 begin
2449 begin
2452 end
2456 else
2460 begin
2466 { insert bound instruction only }
2471 { u32bit needs 2 checks }
2473 begin
2476 { if a cardinal is > $7fffffff, this is an illegal longint }
2477 { value (and vice versa)! (JM) }
2481 { similar for array indexes (JM) }
2486 else
2487 begin
2498 end
2499 else
2500 begin
2503 { load the value in a register }
2505 begin
2506 { be sure that hreg is a 32 bit reg, if not load it in %edi }
2509 else
2510 begin
2515 end
2516 else
2517 begin
2523 begin
2529 { insert bound instruction only }
2531 { u32bit needs 2 checks }
2533 begin
2548 const
2552 var
2560 begin
2562 begin
2565 end
2569 begin
2570 {$IfNDef regallocfix}
2573 {$EndIf regallocfix}
2577 begin
2579 {$ifndef noAllocEdi}
2581 {$endif noAllocEdi}
2583 begin
2585 {$ifdef regallocfix}
2588 {$endif regallocfix}
2595 begin
2597 {$ifdef regallocfix}
2600 {$endif regallocfix}
2606 {$ifndef noAllocEdi}
2608 {$endif noAllocEdi}
2610 begin
2611 { and now look for an 8 bit register }
2617 else
2618 begin
2620 { we need only to check 3 registers, because }
2621 { one is always not index or base }
2623 begin
2626 end
2628 begin
2631 end
2633 begin
2639 { was earlier XCHG, of course nonsense }
2640 begin
2641 {$ifndef noAllocEdi}
2643 {$endif noAllocEdi}
2647 {$ifdef regallocfix}
2650 {$endif regallocfix}
2653 begin
2655 {$ifndef noAllocEdi}
2657 {$endif noAllocEdi}
2658 end
2659 else
2662 end
2663 else
2664 begin
2665 {$ifndef noAllocEdi}
2667 {$endif noAllocEdi}
2669 {$ifdef regallocfix}
2670 {is this ok?? (JM)}
2672 {$endif regallocfix}
2673 {$ifndef noAllocEdi}
2675 {$endif noAllocEdi}
2678 else
2679 begin
2681 {$ifdef regallocfix}
2684 {$endif regallocfix}
2690 begin
2691 maybepushecx;
2695 end
2696 else
2697 begin
2701 begin
2702 maybepushecx;
2709 begin
2716 {$ifndef noAllocEdi}
2719 {$endif noAllocEdi}
2722 else
2725 { loading SELF-reference again }
2726 maybe_loadesi;
2736 {A lot smaller and less bug sensitive than the original unfolded loads.}
2741 begin
2745 begin
2747 u8bit:
2749 s8bit:
2751 u16bit:
2753 s16bit:
2762 LOC_MEM,
2763 LOC_REFERENCE:
2764 begin
2767 else
2768 begin
2771 u8bit:
2773 s8bit:
2775 u16bit:
2777 s16bit:
2779 u32bit:
2781 s32bit:
2787 end
2788 else
2795 { if necessary ESI is reloaded after a call}
2798 var
2803 begin
2805 begin
2806 {$ifndef noAllocEdi}
2808 {$endif noAllocEdi}
2810 begin
2818 begin
2831 end
2832 else
2833 begin
2844 { DO NOT RELY on the fact that the ptree is not yet swaped
2845 because of inlining code PM }
2847 var
2849 begin
2850 { always calculate boolean AND and OR from left to right }
2854 begin
2855 { p^.swaped:=false}
2858 end
2859 else
2861 { the following check is appropriate, because all }
2862 { 4 registers are rarely used and it is thereby }
2863 { achieved that the extra code is being dropped }
2864 { by exchanging not commutative operators }
2866 begin
2872 {else
2873 p^.swaped:=false; do not modify }
2877 {*****************************************************************************
2878 Entry/Exit Code Functions
2879 *****************************************************************************}
2882 var
2884 begin
2886 exit;
2888 target_i386_freebsd,
2889 target_i386_linux:
2890 begin
2902 target_i386_go32v2:
2903 begin
2911 begin
2912 { save the registers of an interrupt procedure }
2920 { .... also the segment registers }
2929 begin
2930 { restore the registers of an interrupt procedure }
2931 { this was all with entrycode instead of exitcode !!}
2939 { .... also the segment registers }
2945 { this restores the flags }
2950 { generates the code for threadvar initialisation }
2953 var
2956 begin
2959 begin
2968 { initilizes data of type t }
2969 { if is_already_ref is true then the routines assumes }
2970 { that r points to the data to initialize }
2973 var
2976 begin
2979 begin
2982 end
2983 else
2984 begin
2991 else
2997 { finalizes data of type t }
2998 { if is_already_ref is true then the routines assumes }
2999 { that r points to the data to finalizes }
3002 var
3005 begin
3008 begin
3010 end
3011 else
3012 begin
3019 else
3026 { generates the code for initialisation of local data }
3029 var
3032 begin
3038 begin
3043 begin
3046 end
3047 else
3048 begin
3055 { generates the code for incrementing the reference count of parameters }
3058 var
3061 begin
3068 (pvarsym(p)^.varspez=vs_const) and
3070 begin
3086 { generates the code for finalisation of local data }
3089 var
3092 begin
3099 begin
3100 { not all kind of parameters need to be finalized }
3105 exit;
3111 begin
3116 begin
3120 else
3128 { generates the code to make local copies of the value parameters }
3130 var
3136 begin
3140 begin
3143 begin
3144 { get stack space }
3149 {$ifndef noAllocEdi}
3151 {$endif noAllocEdi}
3159 begin
3164 else
3169 {$ifndef NOTARGETWIN32}
3170 { windows guards only a few pages for stack growing, }
3171 { so we have to access every page first }
3173 begin
3191 {$ifndef noAllocEdi}
3193 {$endif noAllocEdi}
3194 { now reload EDI }
3199 {$ifndef noAllocEdi}
3201 {$endif noAllocEdi}
3209 begin
3214 else
3219 end
3220 else
3221 {$endif NOTARGETWIN32}
3224 { load destination }
3228 { don't destroy the registers! }
3234 { load count }
3242 { load source }
3250 { scheduled .... }
3254 { calculate size }
3258 begin
3261 end
3262 else
3264 begin
3273 else
3283 {$ifndef noAllocEdi}
3285 {$endif noAllocEdi}
3291 { patch the new address }
3298 end
3299 else
3301 begin
3309 end
3310 else
3311 begin
3325 var
3329 begin
3332 begin
3334 begin
3348 var
3351 begin
3354 begin
3356 begin
3368 var
3373 begin
3381 begin
3382 {$ifdef dummy}
3385 begin
3391 {$endif dummy}
3394 procedure genentrycode(alist : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
3398 {
3399 Generates the entry code for a procedure
3400 }
3401 var
3403 {$ifdef GDB}
3405 {$endif GDB}
3409 oldlist,
3414 begin
3418 begin
3421 begin
3429 else
3438 begin
3447 {$ifdef GDB}
3450 {$endif GDB}
3452 { a constructor needs a help procedure }
3454 begin
3456 begin
3460 end
3461 else
3462 begin
3465 {$ifndef noAllocEdi}
3467 {$endif noAllocEdi}
3472 { don't load ESI, does the caller }
3473 { we must do it for local function }
3474 { that can be called from a foreach }
3475 { of another object than self !! PM }
3479 maybe_loadesi;
3481 { When message method contains self as a parameter,
3482 we must load it into ESI }
3484 begin
3490 {$ifndef noAllocEdi}
3492 {$endif noAllocEdi}
3494 { should we save edi,esi,ebx like C ? }
3496 begin
3503 { for the save all registers we can simply use a pusha,popa which
3504 push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
3506 begin
3510 { omit stack frame ? }
3513 begin
3516 if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
3518 else
3523 end
3524 else
3525 begin
3527 if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
3529 else
3533 begin
3534 {$ifdef unused}
3536 begin
3540 begin
3545 genprofilecode;
3547 { %edi is already saved when pocdecl is used
3548 if ((target_info.target=target_linux) or (target_info.target=target_freebsd)) and
3549 ((aktprocsym^.definition^.options and poexports)<>0) then
3550 exprasmlist^.insert(new(Paicpu,op_reg(A_PUSH,S_L,R_EDI))); }
3551 { ATTENTION:
3552 never use ENTER in linux !!! (or freebsd MvdV)
3553 the stack page fault does not support it PM }
3555 end
3556 else
3557 {$endif unused}
3558 begin
3559 { windows guards only a few pages for stack growing, }
3560 { so we have to access every page first }
3563 begin
3565 begin
3568 begin
3575 end
3576 else
3577 begin
3579 {$ifndef noAllocEdi}
3581 {$endif noAllocEdi}
3592 {$ifndef noAllocEdi}
3594 {$endif noAllocEdi}
3597 end
3598 end
3599 else
3604 begin
3609 genprofilecode;
3614 else
3615 begin
3617 genprofilecode;
3624 generate_interrupt_stackframe_entry;
3626 { initialize return value }
3631 begin
3639 { initialisize local data like ansistrings }
3641 potype_unitinit:
3642 begin
3643 { using current_module^.globalsymtable is hopefully }
3644 { more robust than symtablestack and symtablestack^.next }
3648 { units have seperate code for initilization and finalization }
3649 potype_unitfinalize: ;
3650 else
3654 { generate copies of call by value parameters }
3659 { add a reference to all call by value/const parameters }
3662 { initialisizes temp. ansi/wide string data }
3663 inittempansistrings;
3665 { do we need an exception frame because of ansi/widestrings ? }
3668 { but it's useless in init/final code of units }
3670 begin
3673 { Type of stack-frame must be pushed}
3684 { probably we've to reload self here }
3685 maybe_loadesi;
3689 begin
3697 {$ifdef GDB}
3700 {$EndIf GDB}
3703 begin
3706 else
3709 {$ifdef GDB}
3713 {$endif GDB}
3721 {$ifdef GDB}
3723 begin
3729 {$endif GDB}
3731 { Align, gprof uses 16 byte granularity }
3734 else
3743 var
3747 begin
3751 begin
3752 {if ((procinfo^.flags and pi_operator)<>0) and
3753 assigned(opsym) then
3754 procinfo^.funcret_is_valid:=
3755 procinfo^.funcret_is_valid or (opsym^.refs>0);}
3761 begin
3765 begin
3781 end
3782 else
3784 begin
3787 end
3788 else
3790 begin
3793 end
3794 else
3796 end
3802 var
3803 {$ifdef GDB}
3807 {$endif GDB}
3815 begin
3822 { call the destructor help procedure }
3825 begin
3827 begin
3829 end
3830 else
3831 begin
3833 {$ifndef noAllocEdi}
3835 {$endif noAllocEdi}
3837 { must the object be finalized ? }
3839 begin
3843 {$ifndef noAllocEdi}
3845 {$endif noAllocEdi}
3859 { finalize temporary data }
3860 finalizetempansistrings;
3862 { finalize local data like ansistrings}
3864 potype_unitfinalize:
3865 begin
3866 { using current_module^.globalsymtable is hopefully }
3867 { more robust than symtablestack and symtablestack^.next }
3871 { units have seperate code for initialization and finalization }
3872 potype_unitinit: ;
3873 else
3877 { finalize paras data }
3881 { do we need to handle exceptions because of ansi/widestrings ? }
3884 { but it's useless in init/final code of units }
3886 begin
3887 { the exception helper routines modify all registers }
3898 begin
3900 begin
3903 begin
3909 begin
3912 end
3913 else
3914 begin
3919 begin
3922 end
3923 else
3925 { not necessary because the result is never assigned in the
3926 case of an exception (FK)
3927 emit_const_reg(A_MOV,S_L,0,R_ESI);
3928 emit_const_ref(A_MOV,S_L,0,new_reference(procinfo^.framepointer,8));
3929 }
3932 end
3933 end
3934 else
3935 { must be the return value finalized before reraising the exception? }
3940 begin
3951 { call __EXIT for main program }
3952 if (not DLLsource) and (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
3953 begin
3957 { handle return value }
3964 else
3965 begin
3966 { successful constructor deletes the zero flag }
3967 { and returns self in eax }
3968 { eax must be set to zero if the allocation failed !!! }
3973 begin
3976 end
3977 else
3978 begin
3980 {$ifndef noAllocEdi}
3982 {$endif noAllocEdi}
3985 {$ifndef noAllocEdi}
3987 {$endif noAllocEdi}
3997 { stabs uses the label also ! }
4001 { gives problems for long mangled names }
4002 {list^.concat(new(pai_symbol,init(aktprocsym^.definition^.mangledname+'_end')));}
4004 { should we restore edi ? }
4005 { for all i386 gcc implementations }
4007 begin
4012 { here we could reset R_EBX
4013 but that is risky because it only works
4014 if genexitcode is called after genentrycode
4015 so lets skip this for the moment PM
4016 aktprocsym^.definition^.usedregisters:=
4017 aktprocsym^.definition^.usedregisters or not ($80 shr byte(R_EBX));
4018 }
4021 { for the save all registers we can simply use a pusha,popa which
4022 push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
4024 begin
4034 begin
4037 end
4038 else
4039 begin
4045 { parameters are limited to 65535 bytes because }
4046 { ret allows only imm16 }
4050 { at last, the return is generated }
4054 begin
4061 generate_interrupt_stackframe_exit;
4062 end
4063 else
4064 begin
4065 {Routines with the poclearstack flag set use only a ret.}
4066 { also routines with parasize=0 }
4068 begin
4069 {$ifndef OLD_C_STACK}
4070 { complex return values are removed from stack in C code PM }
4073 else
4074 {$endif not OLD_C_STACK}
4076 end
4079 else
4086 {$ifdef GDB}
4088 begin
4093 begin
4096 begin
4100 end
4101 else
4102 begin
4105 else
4111 end
4112 else
4113 begin
4116 else
4122 { define calling EBP as pseudo local var PM }
4123 { this enables test if the function is a local one !! }
4130 begin
4135 else
4144 else
4154 begin
4159 {list^.concat(new(pai_stabn,init(strpnew('192,0,0,'
4160 +aktprocsym^.definition^.mangledname))));
4161 p[0]:='2';p[1]:='2';p[2]:='4';
4162 strpcopy(strend(p),'_end');}
4165 begin
4172 { strpnew('224,0,0,'
4173 +aktprocsym^.definition^.mangledname+'_end'))));}
4176 {$endif GDB}
4182 begin
4183 { using current_module^.globalsymtable is hopefully }
4184 { more robust than symtablestack and symtablestack^.next }
4187 exprasmlist^.insert(new(pai_symbol,initname_global('FINALIZE$$'+current_module^.modulename^,0)));
4188 exprasmlist^.insert(new(pai_symbol,initname_global(target_os.cprefix+current_module^.modulename^+'_finalize',0)));
4189 {$ifdef GDB}
4192 exprasmlist^.insert(new(pai_stab_function_name,init(strpnew('FINALIZE$$'+current_module^.modulename^))));
4193 {$endif GDB}
4200 begin
4201 { using current_module^.globalsymtable is hopefully }
4202 { more robust than symtablestack and symtablestack^.next }
4206 exprasmlist^.insert(new(pai_symbol,initname_global(target_os.cprefix+current_module^.modulename^+'_init',0)));
4207 {$ifdef GDB}
4210 exprasmlist^.insert(new(pai_stab_function_name,init(strpnew('INIT$$'+current_module^.modulename^))));
4211 {$endif GDB}
4216 {$ifdef test_dest_loc}
4219 begin
4221 begin
4225 end
4226 else
4228 begin
4232 end
4233 else
4237 {$endif test_dest_loc}
4240 {
4241 $Log$
4242 Revision 1.1 2002/02/19 08:21:56 sasu
4243 Initial revision
4245 Revision 1.1.2.19 2000/12/08 17:03:20 jonas
4246 + added full range checking for 64bit types
4247 * fixed web bug 1144
4249 Revision 1.1.2.18 2000/12/07 17:17:25 jonas
4250 * fixed bug where the original resulttype wasn't restored correctly
4251 after doing a 64bit rangecheck
4253 Revision 1.1.2.17 2000/12/06 16:46:30 jonas
4254 * backported range checking fixes from 1.1 (added range checking for
4255 conversion between cardinal and longint and for conversion from
4256 64bit to 32bit types)
4258 Revision 1.1.2.16 2000/11/20 16:21:53 pierre
4259 * class class method parameter is not a oclass but a vmt pointer
4261 Revision 1.1.2.15 2000/11/17 23:17:07 pierre
4262 * fix static object method and class class method
4264 Revision 1.1.2.14 2000/10/24 22:22:22 peter
4265 * emitcall -> emitinsertcall for profiling
4267 Revision 1.1.2.13 2000/10/23 20:07:02 pierre
4268 * fix web bug 1153
4270 Revision 1.1.2.12 2000/10/14 00:40:45 pierre
4271 * fixes for class debugging
4273 Revision 1.1.2.11 2000/10/13 20:12:21 florian
4274 * fixed my previous commit
4276 Revision 1.1.2.10 2000/10/13 19:50:42 florian
4277 * the warning about the unimplemented int64 range check is now displayed only once
4279 Revision 1.1.2.9 2000/10/10 14:52:38 jonas
4280 * added missing regallocs for edi in emit_mov_ref_reg64
4282 Revision 1.1.2.8 2000/09/13 13:57:40 marco
4283 * FreeBSD compiler support
4285 Revision 1.1.2.7 2000/08/24 19:05:29 peter
4286 * don't initialize if localvarsym is set because that varsym will
4287 already be initialized
4288 * first initialize local data before copy of value para's
4290 Revision 1.1.2.6 2000/08/19 20:06:15 peter
4291 * check size after checking openarray in push_value_para
4293 Revision 1.1.2.5 2000/08/10 18:44:43 peter
4294 * fixed for constants in emit_push_mem_size for go32v2
4296 Revision 1.1.2.4 2000/08/07 11:22:11 jonas
4297 + emit_push_mem_size() which pushes a value in memory of a certain size
4298 * pushsetelement() and pushvaluepara() use this new procedure, because
4299 otherwise they could sometimes try to push data past the end of the
4300 heap, causing a crash
4302 Revision 1.1.2.3 2000/08/02 08:01:08 jonas
4303 * fixed web bug1087
4304 * allocate R_ECX explicitely if it's used
4306 Revision 1.1.2.2 2000/08/02 07:54:49 jonas
4307 *** empty log message ***
4309 Revision 1.1.2.1 2000/07/27 09:21:33 jonas
4310 * moved locflags2reg() procedure from cg386add to cgai386
4311 + added locjump2reg() procedure to cgai386
4312 * fixed internalerror(2002) when the result of a case expression has
4313 LOC_JUMP
4315 Revision 1.1 2000/07/13 06:29:47 michael
4316 + Initial import
4318 Revision 1.109 2000/06/27 12:17:29 jonas
4319 * fix for web bug 1011: no exception stack stuff is generated for
4320 inlined procedures, the entry/exitcode of the parent will do that
4322 Revision 1.108 2000/06/10 17:31:42 jonas
4323 * loadord2reg doesn't generate any "movl %reg1,%reg1" anymore
4325 Revision 1.107 2000/06/05 20:39:05 pierre
4326 * fix for inline bug
4328 Revision 1.106 2000/05/26 20:16:00 jonas
4329 * fixed wrong register deallocations in several ansistring related
4330 procedures. The IDE's now function fine when compiled with -OG3p3r
4332 Revision 1.105 2000/05/23 14:20:49 pierre
4333 * Use stacksize param instead of gettempsize
4335 Revision 1.104 2000/05/18 17:05:15 peter
4336 * fixed size of const parameters in asm readers
4338 Revision 1.103 2000/05/17 11:06:11 pierre
4339 add a comment about ENTER and linux
4341 Revision 1.102 2000/05/14 18:49:04 florian
4342 + Int64/QWord stuff for array of const added
4344 Revision 1.101 2000/05/09 14:17:33 pierre
4345 * handle interrupt function correctly
4347 Revision 1.100 2000/05/04 09:29:31 pierre
4348 * saveregisters now does not overwrite registers used as return value for functions
4350 Revision 1.99 2000/04/28 08:53:47 pierre
4351 * fix my last fix for other targets then win32
4353 Revision 1.98 2000/04/26 10:03:45 pierre
4354 * correct bugs for ts010026 and ts010029 in win32 mode
4355 in copyvaluparas
4356 + use SHL instead of IMUL if constant is a power of 2 in copyvalueparas
4358 Revision 1.97 2000/04/24 12:48:37 peter
4359 * removed unused vars
4361 Revision 1.96 2000/04/10 12:23:18 jonas
4362 * modified copyshortstring so it takes an extra paramter which allows it
4363 to delete the sref itself (so the reg deallocations are put in the
4364 right place for the optimizer)
4366 Revision 1.95 2000/04/10 09:01:15 pierre
4367 * fix for bug 922 in copyvalueparas
4369 Revision 1.94 2000/04/03 20:51:22 florian
4370 * initialize/finalize_data checks if procinfo is assigned else
4371 crashes happend at end of compiling if there were ansistrings in the
4372 interface/implementation part of units: it was the result of the fix
4373 of 701 :(
4375 Revision 1.93 2000/04/02 10:18:18 florian
4376 * bug 701 fixed: ansistrings in interface and implementation part of the units
4377 are now finalized correctly even if there are no explicit initialization/
4378 finalization statements
4380 Revision 1.92 2000/04/01 14:18:45 peter
4381 * use arraydef.elesize instead of elementtype.def.size
4383 Revision 1.91 2000/03/31 22:56:46 pierre
4384 * fix the handling of value parameters in cdecl function
4386 Revision 1.90 2000/03/28 22:31:46 pierre
4387 * fix for problem in tbs0299 for 4 byte stack alignment
4389 Revision 1.89 2000/03/21 23:36:46 pierre
4390 fix for bug 312
4392 Revision 1.88 2000/03/19 11:55:08 peter
4393 * fixed temp ansi handling within array constructor
4395 Revision 1.87 2000/03/19 08:17:36 peter
4396 * tp7 fix
4398 Revision 1.86 2000/03/01 15:36:11 florian
4399 * some new stuff for the new cg
4401 Revision 1.85 2000/03/01 12:35:44 pierre
4402 * fix for bug 855
4404 Revision 1.84 2000/03/01 00:03:12 pierre
4405 * fixes for locals in inlined procedures
4406 fix for bug797
4407 + stabs generation for inlined paras and locals
4409 Revision 1.83 2000/02/18 21:25:48 florian
4410 * fixed a bug in int64/qword handling was a quite ugly one
4412 Revision 1.82 2000/02/18 20:53:14 pierre
4413 * fixes a stabs problem for functions
4414 + includes a stabs local var for with statements
4415 the name is with in lowercase followed by an index
4416 for nested with.
4417 + Withdebuglist added because the stabs declarations of local
4418 var are postponed to end of function.
4420 Revision 1.81 2000/02/10 23:44:43 florian
4421 * big update for exception handling code generation: possible mem holes
4422 fixed, break/continue/exit should work always now as expected
4424 Revision 1.80 2000/02/09 17:36:10 jonas
4425 * added missing regalloc for ecx in range check code
4427 Revision 1.79 2000/02/09 13:22:50 peter
4428 * log truncated
4430 Revision 1.78 2000/02/04 21:00:31 florian
4431 * some (small) problems with register saving fixed
4433 Revision 1.77 2000/02/04 20:00:21 florian
4434 * an exception in a construcor calls now the destructor (this applies only
4435 to classes)
4437 Revision 1.76 2000/02/04 14:29:57 pierre
4438 + add pseudo local var parent_ebp for local procs
4440 Revision 1.75 2000/01/25 08:46:03 pierre
4441 * Range check for int64 produces a warning only
4443 Revision 1.74 2000/01/24 12:17:22 florian
4444 * some improvemenst to cmov support
4445 * disabled excpetion frame generation in cosntructors temporarily
4447 Revision 1.73 2000/01/23 21:29:14 florian
4448 * CMOV support in optimizer (in define USECMOV)
4449 + start of support of exceptions in constructors
4451 Revision 1.72 2000/01/23 11:11:36 michael
4452 + Fixes from Jonas.
4454 Revision 1.71 2000/01/22 16:02:37 jonas
4455 * fixed more regalloc bugs (for set adding and unsigned
4456 multiplication)
4458 Revision 1.70 2000/01/16 22:17:11 peter
4459 * renamed call_offset to para_offset
4461 Revision 1.69 2000/01/12 10:38:17 peter
4462 * smartlinking fixes for binary writer
4463 * release alignreg code and moved instruction writing align to cpuasm,
4464 but it doesn't use the specified register yet
4466 Revision 1.68 2000/01/09 12:35:02 jonas
4467 * changed edi allocation to use getexplicitregister32/ungetregister
4468 (adapted tgeni386 a bit for this) and enabled it by default
4469 * fixed very big and stupid bug of mine in cg386mat that broke the
4470 include() code (and make cycle :( ) if you compiled without
4471 -dnewoptimizations
4473 Revision 1.67 2000/01/09 01:44:21 jonas
4474 + (de)allocation info for EDI to fix reported bug on mailinglist.
4475 Also some (de)allocation info for ESI added. Between -dallocEDI
4476 because at this time of the night bugs could easily slip in ;)
4478 Revision 1.66 2000/01/07 01:14:22 peter
4479 * updated copyright to 2000
4481 Revision 1.65 1999/12/22 01:01:47 peter
4482 - removed freelabel()
4483 * added undefined label detection in internal assembler, this prevents
4484 a lot of ld crashes and wrong .o files
4485 * .o files aren't written anymore if errors have occured
4486 * inlining of assembler labels is now correct
4488 Revision 1.64 1999/12/20 21:42:35 pierre
4489 + dllversion global variable
4490 * FPC_USE_CPREFIX code removed, not necessary anymore
4491 as we use .edata direct writing by default now.
4493 Revision 1.63 1999/12/01 22:45:54 peter
4494 * fixed wrong assembler with in-node
4496 Revision 1.62 1999/11/30 10:40:43 peter
4497 + ttype, tsymlist
4499 Revision 1.61 1999/11/20 01:22:18 pierre
4500 + cond FPC_USE_CPREFIX (needs also some RTL changes)
4501 this allows to use unit global vars as DLL exports
4502 (the underline prefix seems needed by dlltool)
4504 Revision 1.60 1999/11/17 17:04:58 pierre
4505 * Notes/hints changes
4507 Revision 1.59 1999/11/15 14:04:00 pierre
4508 * self pointer stabs for local function was wrong
4509 }