1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543 |
- {
- $Id$
- Copyright (c) 1998-2000 by Florian Klaempfl
- Generate i386 assembler for type converting nodes
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit n386cnv;
- {$i defines.inc}
- interface
- uses
- node,ncnv,types;
- type
- ti386typeconvnode = class(ttypeconvnode)
- procedure second_int_to_int;virtual;
- procedure second_string_to_string;virtual;
- procedure second_cstring_to_pchar;virtual;
- procedure second_string_to_chararray;virtual;
- procedure second_array_to_pointer;virtual;
- procedure second_pointer_to_array;virtual;
- procedure second_chararray_to_string;virtual;
- procedure second_char_to_string;virtual;
- procedure second_int_to_real;virtual;
- procedure second_real_to_fix;virtual;
- procedure second_real_to_real;virtual;
- procedure second_fix_to_real;virtual;
- procedure second_cord_to_pointer;virtual;
- procedure second_int_to_fix;virtual;
- procedure second_proc_to_procvar;virtual;
- procedure second_bool_to_int;virtual;
- procedure second_int_to_bool;virtual;
- procedure second_load_smallset;virtual;
- procedure second_ansistring_to_pchar;virtual;
- procedure second_pchar_to_string;virtual;
- procedure second_class_to_intf;virtual;
- procedure second_nothing;virtual;
- procedure pass_2;override;
- procedure second_call_helper(c : tconverttype);
- end;
- ti386asnode = class(tasnode)
- procedure pass_2;override;
- end;
- ti386isnode = class(tisnode)
- procedure pass_2;override;
- end;
- implementation
- uses
- verbose,globals,systems,
- symconst,symdef,aasm,
- hcodegen,temp_gen,pass_2,
- ncon,ncal,
- cpubase,cpuasm,
- cgai386,tgcpu,n386util;
- {*****************************************************************************
- SecondTypeConv
- *****************************************************************************}
- procedure ti386typeconvnode.second_int_to_int;
- var
- op : tasmop;
- opsize : topsize;
- hregister,
- hregister2 : tregister;
- l : pasmlabel;
- begin
- { insert range check if not explicit conversion }
- if not(nf_explizit in flags) then
- emitrangecheck(left,resulttype);
- { is the result size smaller ? }
- if resulttype^.size<left.resulttype^.size then
- begin
- { only need to set the new size of a register }
- if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- case resulttype^.size of
- 1 : location.register:=makereg8(left.location.register);
- 2 : location.register:=makereg16(left.location.register);
- 4 : location.register:=makereg32(left.location.register);
- end;
- { we can release the upper register }
- if is_64bitint(left.resulttype) then
- ungetregister32(left.location.registerhigh);
- end;
- end
- { is the result size bigger ? }
- else if resulttype^.size>left.resulttype^.size then
- begin
- { remove reference }
- if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- del_reference(left.location.reference);
- { we can do this here as we need no temp inside }
- ungetiftemp(left.location.reference);
- end;
- { get op and opsize, handle separate for constants, because
- movz doesn't support constant values }
- if (left.location.loc=LOC_MEM) and (left.location.reference.is_immediate) then
- begin
- if is_64bitint(resulttype) then
- opsize:=S_L
- else
- opsize:=def_opsize(resulttype);
- op:=A_MOV;
- end
- else
- begin
- opsize:=def2def_opsize(left.resulttype,resulttype);
- if opsize in [S_B,S_W,S_L] then
- op:=A_MOV
- else
- if is_signed(left.resulttype) then
- op:=A_MOVSX
- else
- op:=A_MOVZX;
- end;
- { load the register we need }
- if left.location.loc<>LOC_REGISTER then
- hregister:=getregister32
- else
- hregister:=left.location.register;
- { set the correct register size and location }
- clear_location(location);
- location.loc:=LOC_REGISTER;
- { do we need a second register for a 64 bit type ? }
- if is_64bitint(resulttype) then
- begin
- hregister2:=getregister32;
- location.registerhigh:=hregister2;
- end;
- case resulttype^.size of
- 1:
- location.register:=makereg8(hregister);
- 2:
- location.register:=makereg16(hregister);
- 4,8:
- location.register:=makereg32(hregister);
- end;
- { insert the assembler code }
- if left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
- emit_reg_reg(op,opsize,left.location.register,location.register)
- else
- emit_ref_reg(op,opsize,
- newreference(left.location.reference),location.register);
- { do we need a sign extension for int64? }
- if is_64bitint(resulttype) then
- { special case for constants (JM) }
- if is_constintnode(left) then
- begin
- if tordconstnode(left).value >= 0 then
- emit_reg_reg(A_XOR,S_L,
- hregister2,hregister2)
- else
- emit_const_reg(A_MOV,S_L,longint($ffffffff),hregister2);
- end
- else
- begin
- emit_reg_reg(A_XOR,S_L,
- hregister2,hregister2);
- if (porddef(resulttype)^.typ=s64bit) and
- is_signed(left.resulttype) then
- begin
- getlabel(l);
- emit_const_reg(A_TEST,S_L,longint($80000000),makereg32(hregister));
- emitjmp(C_Z,l);
- emit_reg(A_NOT,S_L,
- hregister2);
- emitlab(l);
- end;
- end;
- end;
- end;
- procedure ti386typeconvnode.second_string_to_string;
- var
- pushed : tpushed;
- regs_to_push: byte;
- begin
- { does anybody know a better solution than this big case statement ? }
- { ok, a proc table would do the job }
- case pstringdef(resulttype)^.string_typ of
- st_shortstring:
- case pstringdef(left.resulttype)^.string_typ of
- st_shortstring:
- begin
- gettempofsizereference(resulttype^.size,location.reference);
- copyshortstring(location.reference,left.location.reference,
- pstringdef(resulttype)^.len,false,true);
- { done by copyshortstring now (JM) }
- { del_reference(left.location.reference); }
- ungetiftemp(left.location.reference);
- end;
- st_longstring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_ansistring:
- begin
- gettempofsizereference(resulttype^.size,location.reference);
- loadansi2short(left,self);
- { this is done in secondtypeconv (FK)
- removetemps(exprasmlist,temptoremove);
- destroys:=true;
- }
- end;
- st_widestring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- end;
- st_longstring:
- case pstringdef(left.resulttype)^.string_typ of
- st_shortstring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_ansistring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_widestring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- end;
- st_ansistring:
- case pstringdef(left.resulttype)^.string_typ of
- st_shortstring:
- begin
- clear_location(location);
- location.loc:=LOC_REFERENCE;
- gettempansistringreference(location.reference);
- decrstringref(cansistringdef,location.reference);
- { We don't need the source regs anymore (JM) }
- regs_to_push := $ff;
- remove_non_regvars_from_loc(left.location,regs_to_push);
- pushusedregisters(pushed,regs_to_push);
- release_loc(left.location);
- emit_push_lea_loc(left.location,true);
- emit_push_lea_loc(location,false);
- saveregvars(regs_to_push);
- emitcall('FPC_SHORTSTR_TO_ANSISTR');
- maybe_loadesi;
- popusedregisters(pushed);
- end;
- st_longstring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_widestring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- end;
- st_widestring:
- case pstringdef(left.resulttype)^.string_typ of
- st_shortstring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_longstring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_ansistring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_widestring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- end;
- end;
- end;
- procedure ti386typeconvnode.second_cstring_to_pchar;
- var
- hr : preference;
- begin
- clear_location(location);
- location.loc:=LOC_REGISTER;
- location.register:=getregister32;
- case pstringdef(left.resulttype)^.string_typ of
- st_shortstring :
- begin
- inc(left.location.reference.offset);
- emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
- location.register);
- end;
- st_ansistring :
- begin
- if (left.nodetype=stringconstn) and
- (str_length(left)=0) then
- begin
- new(hr);
- reset_reference(hr^);
- hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
- emit_ref_reg(A_LEA,S_L,hr,location.register);
- end
- else
- emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
- location.register);
- end;
- st_longstring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_widestring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- end;
- end;
- procedure ti386typeconvnode.second_string_to_chararray;
- var
- pushedregs: tpushed;
- //l1 : pasmlabel;
- //hr : preference;
- arrsize, strtype: longint;
- regstopush: byte;
- begin
- with parraydef(resulttype)^ do
- arrsize := highrange-lowrange+1;
- if (left.nodetype = stringconstn) and
- { left.length+1 since there's always a terminating #0 character (JM) }
- (tstringconstnode(left).len+1 >= arrsize) and
- (pstringdef(left.resulttype)^.string_typ=st_shortstring) then
- begin
- inc(location.reference.offset);
- exit;
- end;
- clear_location(location);
- location.loc := LOC_REFERENCE;
- gettempofsizereference(arrsize,location.reference);
- regstopush := $ff;
- remove_non_regvars_from_loc(left.location,regstopush);
- pushusedregisters(pushedregs,regstopush);
- emit_push_lea_loc(location,false);
- case pstringdef(left.resulttype)^.string_typ of
- st_shortstring :
- begin
- { 0 means shortstring }
- strtype := 0;
- del_reference(left.location.reference);
- emit_push_lea_loc(left.location,true);
- ungetiftemp(left.location.reference);
- end;
- st_ansistring :
- begin
- { 1 means ansistring }
- strtype := 1;
- case left.location.loc of
- LOC_CREGISTER,LOC_REGISTER:
- begin
- ungetregister(left.location.register);
- emit_push_loc(left.location);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- del_reference(left.location.reference);
- emit_push_loc(left.location);
- ungetiftemp(left.location.reference);
- end;
- end;
- end;
- st_longstring:
- begin
- {!!!!!!!}
- { 2 means longstring, but still needs support in FPC_STR_TO_CHARARRAY,
- which is in i386.inc and/or generic.inc (JM) }
- strtype := 2;
- internalerror(8888);
- end;
- st_widestring:
- begin
- {!!!!!!!}
- { 3 means widestring, but still needs support in FPC_STR_TO_CHARARRAY,
- which is in i386.inc and/or generic.inc (JM) }
- strtype := 3;
- internalerror(8888);
- end;
- end;
- push_int(arrsize);
- push_int(strtype);
- saveregvars(regstopush);
- emitcall('FPC_STR_TO_CHARARRAY');
- popusedregisters(pushedregs);
- end;
- procedure ti386typeconvnode.second_array_to_pointer;
- begin
- del_reference(left.location.reference);
- clear_location(location);
- location.loc:=LOC_REGISTER;
- location.register:=getregister32;
- emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
- location.register);
- end;
- procedure ti386typeconvnode.second_pointer_to_array;
- begin
- clear_location(location);
- location.loc:=LOC_REFERENCE;
- reset_reference(location.reference);
- case left.location.loc of
- LOC_REGISTER :
- location.reference.base:=left.location.register;
- LOC_CREGISTER :
- begin
- location.reference.base:=getregister32;
- emit_reg_reg(A_MOV,S_L,left.location.register,location.reference.base);
- end
- else
- begin
- del_reference(left.location.reference);
- location.reference.base:=getregister32;
- emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
- location.reference.base);
- end;
- end;
- end;
- { generates the code for the type conversion from an array of char }
- { to a string }
- procedure ti386typeconvnode.second_chararray_to_string;
- var
- pushed : tpushed;
- regstopush: byte;
- l : longint;
- begin
- { calc the length of the array }
- l:=parraydef(left.resulttype)^.highrange-parraydef(left.resulttype)^.lowrange+1;
- { this is a type conversion which copies the data, so we can't }
- { return a reference }
- clear_location(location);
- location.loc:=LOC_MEM;
- case pstringdef(resulttype)^.string_typ of
- st_shortstring :
- begin
- if l>255 then
- begin
- CGMessage(type_e_mismatch);
- l:=255;
- end;
- gettempofsizereference(resulttype^.size,location.reference);
- { we've also to release the registers ... }
- { Yes, but before pushusedregisters since that one resets unused! }
- { This caused web bug 1073 (JM) }
- regstopush := $ff;
- remove_non_regvars_from_loc(left.location,regstopush);
- pushusedregisters(pushed,regstopush);
- if l>=resulttype^.size then
- push_int(resulttype^.size-1)
- else
- push_int(l);
- { ... here only the temp. location is released }
- emit_push_lea_loc(left.location,true);
- del_reference(left.location.reference);
- emitpushreferenceaddr(location.reference);
- saveregvars(regstopush);
- emitcall('FPC_CHARARRAY_TO_SHORTSTR');
- maybe_loadesi;
- popusedregisters(pushed);
- end;
- st_ansistring :
- begin
- gettempansistringreference(location.reference);
- decrstringref(cansistringdef,location.reference);
- regstopush := $ff;
- remove_non_regvars_from_loc(left.location,regstopush);
- pushusedregisters(pushed,regstopush);
- push_int(l);
- emitpushreferenceaddr(left.location.reference);
- release_loc(left.location);
- emitpushreferenceaddr(location.reference);
- saveregvars(regstopush);
- emitcall('FPC_CHARARRAY_TO_ANSISTR');
- popusedregisters(pushed);
- maybe_loadesi;
- end;
- st_longstring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- st_widestring:
- begin
- {!!!!!!!}
- internalerror(8888);
- end;
- end;
- end;
- procedure ti386typeconvnode.second_char_to_string;
- var
- pushed : tpushed;
- begin
- clear_location(location);
- location.loc:=LOC_MEM;
- case pstringdef(resulttype)^.string_typ of
- st_shortstring :
- begin
- gettempofsizereference(256,location.reference);
- loadshortstring(left,self);
- end;
- st_ansistring :
- begin
- gettempansistringreference(location.reference);
- decrstringref(cansistringdef,location.reference);
- release_loc(left.location);
- pushusedregisters(pushed,$ff);
- emit_pushw_loc(left.location);
- emitpushreferenceaddr(location.reference);
- saveregvars($ff);
- emitcall('FPC_CHAR_TO_ANSISTR');
- popusedregisters(pushed);
- maybe_loadesi;
- end;
- else
- internalerror(4179);
- end;
- end;
- procedure ti386typeconvnode.second_int_to_real;
- var
- r : preference;
- hregister : tregister;
- l1,l2 : pasmlabel;
- begin
- { for u32bit a solution is to push $0 and to load a comp }
- { does this first, it destroys maybe EDI }
- hregister:=R_EDI;
- if porddef(left.resulttype)^.typ=u32bit then
- push_int(0);
- if (left.location.loc=LOC_REGISTER) or
- (left.location.loc=LOC_CREGISTER) then
- begin
- {$ifndef noAllocEdi}
- if not (porddef(left.resulttype)^.typ in [u32bit,s32bit,u64bit,s64bit]) then
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- case porddef(left.resulttype)^.typ of
- s8bit : emit_reg_reg(A_MOVSX,S_BL,left.location.register,R_EDI);
- u8bit : emit_reg_reg(A_MOVZX,S_BL,left.location.register,R_EDI);
- s16bit : emit_reg_reg(A_MOVSX,S_WL,left.location.register,R_EDI);
- u16bit : emit_reg_reg(A_MOVZX,S_WL,left.location.register,R_EDI);
- u32bit,s32bit:
- hregister:=left.location.register;
- u64bit,s64bit:
- begin
- emit_reg(A_PUSH,S_L,left.location.registerhigh);
- hregister:=left.location.registerlow;
- end;
- end;
- ungetregister(left.location.register);
- end
- else
- begin
- r:=newreference(left.location.reference);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- case porddef(left.resulttype)^.typ of
- s8bit:
- emit_ref_reg(A_MOVSX,S_BL,r,R_EDI);
- u8bit:
- emit_ref_reg(A_MOVZX,S_BL,r,R_EDI);
- s16bit:
- emit_ref_reg(A_MOVSX,S_WL,r,R_EDI);
- u16bit:
- emit_ref_reg(A_MOVZX,S_WL,r,R_EDI);
- u32bit,s32bit:
- emit_ref_reg(A_MOV,S_L,r,R_EDI);
- u64bit,s64bit:
- begin
- inc(r^.offset,4);
- emit_ref_reg(A_MOV,S_L,r,R_EDI);
- emit_reg(A_PUSH,S_L,R_EDI);
- r:=newreference(left.location.reference);
- emit_ref_reg(A_MOV,S_L,r,R_EDI);
- end;
- end;
- del_reference(left.location.reference);
- ungetiftemp(left.location.reference);
- end;
- { for 64 bit integers, the high dword is already pushed }
- emit_reg(A_PUSH,S_L,hregister);
- {$ifndef noAllocEdi}
- if hregister = R_EDI then
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- r:=new_reference(R_ESP,0);
- case porddef(left.resulttype)^.typ of
- u32bit:
- begin
- emit_ref(A_FILD,S_IQ,r);
- emit_const_reg(A_ADD,S_L,8,R_ESP);
- end;
- s64bit:
- begin
- emit_ref(A_FILD,S_IQ,r);
- emit_const_reg(A_ADD,S_L,8,R_ESP);
- end;
- u64bit:
- begin
- { unsigned 64 bit ints are harder to handle: }
- { we load bits 0..62 and then check bit 63: }
- { if it is 1 then we add $80000000 000000000 }
- { as double }
- inc(r^.offset,4);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,r,R_EDI);
- r:=new_reference(R_ESP,4);
- emit_const_ref(A_AND,S_L,$7fffffff,r);
- emit_const_reg(A_TEST,S_L,longint($80000000),R_EDI);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- r:=new_reference(R_ESP,0);
- emit_ref(A_FILD,S_IQ,r);
- getdatalabel(l1);
- getlabel(l2);
- emitjmp(C_Z,l2);
- Consts.concat(Tai_label.Create(l1));
- { I got this constant from a test progtram (FK) }
- Consts.concat(Tai_const.Create_32bit(0));
- Consts.concat(Tai_const.Create_32bit(1138753536));
- r:=new_reference(R_NO,0);
- r^.symbol:=l1;
- emit_ref(A_FADD,S_FL,r);
- emitlab(l2);
- emit_const_reg(A_ADD,S_L,8,R_ESP);
- end
- else
- begin
- emit_ref(A_FILD,S_IL,r);
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_reg(A_POP,S_L,R_EDI);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- end;
- end;
- inc(fpuvaroffset);
- clear_location(location);
- location.loc:=LOC_FPU;
- end;
- procedure ti386typeconvnode.second_real_to_fix;
- var
- rreg : tregister;
- ref : treference;
- begin
- { real must be on fpu stack }
- if (left.location.loc<>LOC_FPU) then
- emit_ref(A_FLD,S_FL,newreference(left.location.reference));
- push_int($1f3f);
- push_int(65536);
- reset_reference(ref);
- ref.base:=R_ESP;
- emit_ref(A_FIMUL,S_IL,newreference(ref));
- ref.offset:=4;
- emit_ref(A_FSTCW,S_NO,newreference(ref));
- ref.offset:=6;
- emit_ref(A_FLDCW,S_NO,newreference(ref));
- ref.offset:=0;
- emit_ref(A_FISTP,S_IL,newreference(ref));
- ref.offset:=4;
- emit_ref(A_FLDCW,S_NO,newreference(ref));
- rreg:=getregister32;
- emit_reg(A_POP,S_L,rreg);
- { better than an add on all processors }
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_reg(A_POP,S_L,R_EDI);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- clear_location(location);
- location.loc:=LOC_REGISTER;
- location.register:=rreg;
- inc(fpuvaroffset);
- end;
- procedure ti386typeconvnode.second_real_to_real;
- begin
- case left.location.loc of
- LOC_FPU : ;
- LOC_CFPUREGISTER:
- begin
- location:=left.location;
- exit;
- end;
- LOC_MEM,
- LOC_REFERENCE:
- begin
- floatload(pfloatdef(left.resulttype)^.typ,
- left.location.reference);
- { we have to free the reference }
- del_reference(left.location.reference);
- end;
- end;
- clear_location(location);
- location.loc:=LOC_FPU;
- end;
- procedure ti386typeconvnode.second_fix_to_real;
- var
- popeax,popebx,popecx,popedx : boolean;
- startreg : tregister;
- hl : pasmlabel;
- r : treference;
- begin
- if (left.location.loc=LOC_REGISTER) or
- (left.location.loc=LOC_CREGISTER) then
- begin
- startreg:=left.location.register;
- ungetregister(startreg);
- popeax:=(startreg<>R_EAX) and not (R_EAX in unused);
- if popeax then
- emit_reg(A_PUSH,S_L,R_EAX);
- { mov eax,eax is removed by emit_reg_reg }
- emit_reg_reg(A_MOV,S_L,startreg,R_EAX);
- end
- else
- begin
- emit_ref_reg(A_MOV,S_L,newreference(
- left.location.reference),R_EAX);
- del_reference(left.location.reference);
- startreg:=R_NO;
- end;
- popebx:=(startreg<>R_EBX) and not (R_EBX in unused);
- if popebx then
- emit_reg(A_PUSH,S_L,R_EBX);
- popecx:=(startreg<>R_ECX) and not (R_ECX in unused);
- if popecx then
- emit_reg(A_PUSH,S_L,R_ECX);
- popedx:=(startreg<>R_EDX) and not (R_EDX in unused);
- if popedx then
- emit_reg(A_PUSH,S_L,R_EDX);
- emit_none(A_CDQ,S_NO);
- emit_reg_reg(A_XOR,S_L,R_EDX,R_EAX);
- emit_reg_reg(A_MOV,S_L,R_EAX,R_EBX);
- emit_reg_reg(A_SUB,S_L,R_EDX,R_EAX);
- getlabel(hl);
- emitjmp(C_Z,hl);
- emit_const_reg(A_RCL,S_L,1,R_EBX);
- emit_reg_reg(A_BSR,S_L,R_EAX,R_EDX);
- emit_const_reg(A_MOV,S_B,32,R_CL);
- emit_reg_reg(A_SUB,S_B,R_DL,R_CL);
- emit_reg_reg(A_SHL,S_L,R_CL,R_EAX);
- emit_const_reg(A_ADD,S_W,1007,R_DX);
- emit_const_reg(A_SHL,S_W,5,R_DX);
- emit_const_reg_reg(A_SHLD,S_W,11,R_DX,R_BX);
- emit_const_reg_reg(A_SHLD,S_L,20,R_EAX,R_EBX);
- emit_const_reg(A_SHL,S_L,20,R_EAX);
- emitlab(hl);
- { better than an add on all processors }
- emit_reg(A_PUSH,S_L,R_EBX);
- emit_reg(A_PUSH,S_L,R_EAX);
- reset_reference(r);
- r.base:=R_ESP;
- emit_ref(A_FLD,S_FL,newreference(r));
- emit_const_reg(A_ADD,S_L,8,R_ESP);
- if popedx then
- emit_reg(A_POP,S_L,R_EDX);
- if popecx then
- emit_reg(A_POP,S_L,R_ECX);
- if popebx then
- emit_reg(A_POP,S_L,R_EBX);
- if popeax then
- emit_reg(A_POP,S_L,R_EAX);
- clear_location(location);
- location.loc:=LOC_FPU;
- end;
- procedure ti386typeconvnode.second_cord_to_pointer;
- begin
- { this can't happend, because constants are already processed in
- pass 1 }
- internalerror(47423985);
- end;
- procedure ti386typeconvnode.second_int_to_fix;
- var
- hregister : tregister;
- begin
- if (left.location.loc=LOC_REGISTER) then
- hregister:=left.location.register
- else if (left.location.loc=LOC_CREGISTER) then
- hregister:=getregister32
- else
- begin
- del_reference(left.location.reference);
- hregister:=getregister32;
- case porddef(left.resulttype)^.typ of
- s8bit : emit_ref_reg(A_MOVSX,S_BL,newreference(left.location.reference),
- hregister);
- u8bit : emit_ref_reg(A_MOVZX,S_BL,newreference(left.location.reference),
- hregister);
- s16bit : emit_ref_reg(A_MOVSX,S_WL,newreference(left.location.reference),
- hregister);
- u16bit : emit_ref_reg(A_MOVZX,S_WL,newreference(left.location.reference),
- hregister);
- u32bit,s32bit : emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
- hregister);
- {!!!! u32bit }
- end;
- end;
- emit_const_reg(A_SHL,S_L,16,hregister);
- clear_location(location);
- location.loc:=LOC_REGISTER;
- location.register:=hregister;
- end;
- procedure ti386typeconvnode.second_proc_to_procvar;
- begin
- { method pointer ? }
- if assigned(tcallnode(left).left) then
- begin
- set_location(location,left.location);
- end
- else
- begin
- clear_location(location);
- location.loc:=LOC_REGISTER;
- location.register:=getregister32;
- del_reference(left.location.reference);
- emit_ref_reg(A_LEA,S_L,
- newreference(left.location.reference),location.register);
- end;
- end;
- procedure ti386typeconvnode.second_bool_to_int;
- var
- oldtruelabel,oldfalselabel,hlabel : pasmlabel;
- hregister : tregister;
- newsize,
- opsize : topsize;
- op : tasmop;
- begin
- oldtruelabel:=truelabel;
- oldfalselabel:=falselabel;
- getlabel(truelabel);
- getlabel(falselabel);
- secondpass(left);
- { byte(boolean) or word(wordbool) or longint(longbool) must
- be accepted for var parameters }
- if (nf_explizit in flags) and
- (left.resulttype^.size=resulttype^.size) and
- (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
- begin
- set_location(location,left.location);
- truelabel:=oldtruelabel;
- falselabel:=oldfalselabel;
- exit;
- end;
- clear_location(location);
- location.loc:=LOC_REGISTER;
- del_reference(left.location.reference);
- case left.resulttype^.size of
- 1 : begin
- case resulttype^.size of
- 1 : opsize:=S_B;
- 2 : opsize:=S_BW;
- 4 : opsize:=S_BL;
- end;
- end;
- 2 : begin
- case resulttype^.size of
- 1 : begin
- if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- left.location.register:=reg16toreg8(left.location.register);
- opsize:=S_B;
- end;
- 2 : opsize:=S_W;
- 4 : opsize:=S_WL;
- end;
- end;
- 4 : begin
- case resulttype^.size of
- 1 : begin
- if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- left.location.register:=reg32toreg8(left.location.register);
- opsize:=S_B;
- end;
- 2 : begin
- if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- left.location.register:=reg32toreg16(left.location.register);
- opsize:=S_W;
- end;
- 4 : opsize:=S_L;
- end;
- end;
- end;
- if opsize in [S_B,S_W,S_L] then
- op:=A_MOV
- else
- if is_signed(resulttype) then
- op:=A_MOVSX
- else
- op:=A_MOVZX;
- hregister:=getregister32;
- case resulttype^.size of
- 1 : begin
- location.register:=reg32toreg8(hregister);
- newsize:=S_B;
- end;
- 2 : begin
- location.register:=reg32toreg16(hregister);
- newsize:=S_W;
- end;
- 4 : begin
- location.register:=hregister;
- newsize:=S_L;
- end;
- else
- internalerror(10060);
- end;
- case left.location.loc of
- LOC_MEM,
- LOC_REFERENCE : emit_ref_reg(op,opsize,
- newreference(left.location.reference),location.register);
- LOC_REGISTER,
- LOC_CREGISTER : begin
- { remove things like movb %al,%al }
- if left.location.register<>location.register then
- emit_reg_reg(op,opsize,
- left.location.register,location.register);
- end;
- LOC_FLAGS : begin
- emit_flag2reg(left.location.resflags,location.register);
- end;
- LOC_JUMP : begin
- getlabel(hlabel);
- emitlab(truelabel);
- emit_const_reg(A_MOV,newsize,1,location.register);
- emitjmp(C_None,hlabel);
- emitlab(falselabel);
- emit_reg_reg(A_XOR,newsize,location.register,
- location.register);
- emitlab(hlabel);
- end;
- else
- internalerror(10061);
- end;
- truelabel:=oldtruelabel;
- falselabel:=oldfalselabel;
- end;
- procedure ti386typeconvnode.second_int_to_bool;
- var
- hregister : tregister;
- resflags : tresflags;
- opsize : topsize;
- begin
- clear_location(location);
- { byte(boolean) or word(wordbool) or longint(longbool) must
- be accepted for var parameters }
- if (nf_explizit in flags) and
- (left.resulttype^.size=resulttype^.size) and
- (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
- begin
- set_location(location,left.location);
- exit;
- end;
- location.loc:=LOC_REGISTER;
- del_reference(left.location.reference);
- opsize:=def_opsize(left.resulttype);
- case left.location.loc of
- LOC_MEM,LOC_REFERENCE :
- begin
- hregister:=def_getreg(left.resulttype);
- emit_ref_reg(A_MOV,opsize,
- newreference(left.location.reference),hregister);
- emit_reg_reg(A_OR,opsize,hregister,hregister);
- resflags:=F_NE;
- end;
- LOC_FLAGS :
- begin
- hregister:=getregister32;
- resflags:=left.location.resflags;
- end;
- LOC_REGISTER,LOC_CREGISTER :
- begin
- hregister:=left.location.register;
- emit_reg_reg(A_OR,opsize,hregister,hregister);
- resflags:=F_NE;
- end;
- else
- internalerror(10062);
- end;
- case resulttype^.size of
- 1 : location.register:=makereg8(hregister);
- 2 : location.register:=makereg16(hregister);
- 4 : location.register:=makereg32(hregister);
- else
- internalerror(10064);
- end;
- emit_flag2reg(resflags,location.register);
- end;
- procedure ti386typeconvnode.second_load_smallset;
- var
- href : treference;
- pushedregs : tpushed;
- begin
- href.symbol:=nil;
- pushusedregisters(pushedregs,$ff);
- gettempofsizereference(32,href);
- emit_push_mem_size(left.location.reference,4);
- emitpushreferenceaddr(href);
- saveregvars($ff);
- emitcall('FPC_SET_LOAD_SMALL');
- maybe_loadesi;
- popusedregisters(pushedregs);
- clear_location(location);
- location.loc:=LOC_MEM;
- location.reference:=href;
- end;
- procedure ti386typeconvnode.second_ansistring_to_pchar;
- var
- l1 : pasmlabel;
- hr : preference;
- begin
- clear_location(location);
- location.loc:=LOC_REGISTER;
- getlabel(l1);
- case left.location.loc of
- LOC_CREGISTER,LOC_REGISTER:
- location.register:=left.location.register;
- LOC_MEM,LOC_REFERENCE:
- begin
- location.register:=getregister32;
- emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
- location.register);
- del_reference(left.location.reference);
- end;
- end;
- emit_const_reg(A_CMP,S_L,0,location.register);
- emitjmp(C_NZ,l1);
- new(hr);
- reset_reference(hr^);
- hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
- emit_ref_reg(A_LEA,S_L,hr,location.register);
- emitlab(l1);
- end;
- procedure ti386typeconvnode.second_pchar_to_string;
- var
- pushed : tpushed;
- regs_to_push: byte;
- begin
- case pstringdef(resulttype)^.string_typ of
- st_shortstring:
- begin
- location.loc:=LOC_REFERENCE;
- gettempofsizereference(resulttype^.size,location.reference);
- pushusedregisters(pushed,$ff);
- case left.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- emit_reg(A_PUSH,S_L,left.location.register);
- ungetregister32(left.location.register);
- end;
- LOC_REFERENCE,LOC_MEM:
- begin
- { Now release the registers (see cgai386.pas: }
- { loadansistring for more info on the order) (JM) }
- del_reference(left.location.reference);
- emit_push_mem(left.location.reference);
- end;
- end;
- emitpushreferenceaddr(location.reference);
- saveregvars($ff);
- emitcall('FPC_PCHAR_TO_SHORTSTR');
- maybe_loadesi;
- popusedregisters(pushed);
- end;
- st_ansistring:
- begin
- location.loc:=LOC_REFERENCE;
- gettempansistringreference(location.reference);
- decrstringref(cansistringdef,location.reference);
- { Find out which regs have to be pushed (JM) }
- regs_to_push := $ff;
- remove_non_regvars_from_loc(left.location,regs_to_push);
- pushusedregisters(pushed,regs_to_push);
- case left.location.loc of
- LOC_REFERENCE,LOC_MEM:
- begin
- { Now release the registers (see cgai386.pas: }
- { loadansistring for more info on the order) (JM) }
- del_reference(left.location.reference);
- emit_push_mem(left.location.reference);
- end;
- LOC_REGISTER,LOC_CREGISTER:
- begin
- { Now release the registers (see cgai386.pas: }
- { loadansistring for more info on the order) (JM) }
- emit_reg(A_PUSH,S_L,left.location.register);
- ungetregister32(left.location.register);
- end;
- end;
- emitpushreferenceaddr(location.reference);
- saveregvars(regs_to_push);
- emitcall('FPC_PCHAR_TO_ANSISTR');
- maybe_loadesi;
- popusedregisters(pushed);
- end;
- else
- begin
- internalerror(12121);
- end;
- end;
- end;
- procedure ti386typeconvnode.second_class_to_intf;
- var
- hreg : tregister;
- l1 : pasmlabel;
- begin
- case left.location.loc of
- LOC_MEM,
- LOC_REFERENCE:
- begin
- del_reference(left.location.reference);
- hreg:=getregister32;
- exprasmList.concat(Taicpu.Op_ref_reg(
- A_MOV,S_L,newreference(left.location.reference),hreg));
- end;
- LOC_CREGISTER:
- begin
- hreg:=getregister32;
- exprasmList.concat(Taicpu.Op_reg_reg(
- A_MOV,S_L,left.location.register,hreg));
- end;
- LOC_REGISTER:
- hreg:=left.location.register;
- else internalerror(121120001);
- end;
- emit_reg_reg(A_TEST,S_L,hreg,hreg);
- getlabel(l1);
- emitjmp(C_Z,l1);
- emit_const_reg(A_ADD,S_L,pobjectdef(left.resulttype)^.implementedinterfaces^.ioffsets(
- pobjectdef(left.resulttype)^.implementedinterfaces^.searchintf(resulttype))^,hreg);
- emitlab(l1);
- location.loc:=LOC_REGISTER;
- location.register:=hreg;
- end;
- procedure ti386typeconvnode.second_nothing;
- begin
- end;
- {****************************************************************************
- TI386TYPECONVNODE
- ****************************************************************************}
- procedure ti386typeconvnode.second_call_helper(c : tconverttype);
- const
- secondconvert : array[tconverttype] of pointer = (
- @ti386typeconvnode.second_nothing, {equal}
- @ti386typeconvnode.second_nothing, {not_possible}
- @ti386typeconvnode.second_string_to_string,
- @ti386typeconvnode.second_char_to_string,
- @ti386typeconvnode.second_pchar_to_string,
- @ti386typeconvnode.second_nothing, {cchar_to_pchar}
- @ti386typeconvnode.second_cstring_to_pchar,
- @ti386typeconvnode.second_ansistring_to_pchar,
- @ti386typeconvnode.second_string_to_chararray,
- @ti386typeconvnode.second_chararray_to_string,
- @ti386typeconvnode.second_array_to_pointer,
- @ti386typeconvnode.second_pointer_to_array,
- @ti386typeconvnode.second_int_to_int,
- @ti386typeconvnode.second_int_to_bool,
- @ti386typeconvnode.second_bool_to_int, { bool_to_bool }
- @ti386typeconvnode.second_bool_to_int,
- @ti386typeconvnode.second_real_to_real,
- @ti386typeconvnode.second_int_to_real,
- @ti386typeconvnode.second_int_to_fix,
- @ti386typeconvnode.second_real_to_fix,
- @ti386typeconvnode.second_fix_to_real,
- @ti386typeconvnode.second_proc_to_procvar,
- @ti386typeconvnode.second_nothing, {arrayconstructor_to_set}
- @ti386typeconvnode.second_load_smallset,
- @ti386typeconvnode.second_cord_to_pointer,
- @ti386typeconvnode.second_nothing, { interface 2 string }
- @ti386typeconvnode.second_nothing, { interface 2 guid }
- @ti386typeconvnode.second_class_to_intf
- );
- type
- tprocedureofobject = procedure of object;
- var
- r : packed record
- proc : pointer;
- obj : pointer;
- end;
- begin
- { this is a little bit dirty but it works }
- { and should be quite portable too }
- r.proc:=secondconvert[c];
- r.obj:=self;
- tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
- end;
- procedure ti386typeconvnode.pass_2;
- {$ifdef TESTOBJEXT2}
- var
- r : preference;
- nillabel : plabel;
- {$endif TESTOBJEXT2}
- begin
- { this isn't good coding, I think tc_bool_2_int, shouldn't be }
- { type conversion (FK) }
- if not(convtype in [tc_bool_2_int,tc_bool_2_bool]) then
- begin
- secondpass(left);
- set_location(location,left.location);
- if codegenerror then
- exit;
- end;
- second_call_helper(convtype);
- {$ifdef TESTOBJEXT2}
- { Check explicit conversions to objects pointers !! }
- if p^.explizit and
- (p^.resulttype^.deftype=pointerdef) and
- (ppointerdef(p^.resulttype)^.definition^.deftype=objectdef) and not
- (pobjectdef(ppointerdef(p^.resulttype)^.definition)^.isclass) and
- ((pobjectdef(ppointerdef(p^.resulttype)^.definition)^.options and oo_hasvmt)<>0) and
- (cs_check_range in aktlocalswitches) then
- begin
- new(r);
- reset_reference(r^);
- if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- r^.base:=p^.location.register
- else
- begin
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_mov_loc_reg(p^.location,R_EDI);
- r^.base:=R_EDI;
- end;
- { NIL must be accepted !! }
- emit_reg_reg(A_OR,S_L,r^.base,r^.base);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- getlabel(nillabel);
- emitjmp(C_E,nillabel);
- { this is one point where we need vmt_offset (PM) }
- r^.offset:= pobjectdef(ppointerdef(p^.resulttype)^.definition)^.vmt_offset;
- {$ifndef noAllocEdi}
- getexplicitregister32(R_EDI);
- {$endif noAllocEdi}
- emit_ref_reg(A_MOV,S_L,r,R_EDI);
- emit_sym(A_PUSH,S_L,
- newasmsymbol(pobjectdef(ppointerdef(p^.resulttype)^.definition)^.vmt_mangledname));
- emit_reg(A_PUSH,S_L,R_EDI);
- {$ifndef noAllocEdi}
- ungetregister32(R_EDI);
- {$endif noAllocEdi}
- emitcall('FPC_CHECK_OBJECT_EXT');
- emitlab(nillabel);
- end;
- {$endif TESTOBJEXT2}
- end;
- {*****************************************************************************
- TI386ISNODE
- *****************************************************************************}
- procedure ti386isnode.pass_2;
- var
- pushed : tpushed;
- begin
- { save all used registers }
- pushusedregisters(pushed,$ff);
- secondpass(left);
- clear_location(location);
- location.loc:=LOC_FLAGS;
- location.resflags:=F_NE;
- { push instance to check: }
- case left.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- emit_reg(A_PUSH,
- S_L,left.location.register);
- ungetregister32(left.location.register);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- emit_ref(A_PUSH,
- S_L,newreference(left.location.reference));
- del_reference(left.location.reference);
- end;
- else internalerror(100);
- end;
- { generate type checking }
- secondpass(right);
- case right.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- emit_reg(A_PUSH,
- S_L,right.location.register);
- ungetregister32(right.location.register);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- emit_ref(A_PUSH,
- S_L,newreference(right.location.reference));
- del_reference(right.location.reference);
- end;
- else internalerror(100);
- end;
- saveregvars($ff);
- emitcall('FPC_DO_IS');
- emit_reg_reg(A_OR,S_B,R_AL,R_AL);
- popusedregisters(pushed);
- maybe_loadesi;
- end;
- {*****************************************************************************
- TI386ASNODE
- *****************************************************************************}
- procedure ti386asnode.pass_2;
- var
- pushed : tpushed;
- begin
- secondpass(left);
- { save all used registers }
- pushusedregisters(pushed,$ff);
- { push instance to check: }
- case left.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- emit_reg(A_PUSH,
- S_L,left.location.register);
- LOC_MEM,LOC_REFERENCE:
- emit_ref(A_PUSH,
- S_L,newreference(left.location.reference));
- else internalerror(100);
- end;
- { we doesn't modifiy the left side, we check only the type }
- set_location(location,left.location);
- { generate type checking }
- secondpass(right);
- case right.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- emit_reg(A_PUSH,
- S_L,right.location.register);
- ungetregister32(right.location.register);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- emit_ref(A_PUSH,
- S_L,newreference(right.location.reference));
- del_reference(right.location.reference);
- end;
- else internalerror(100);
- end;
- saveregvars($ff);
- emitcall('FPC_DO_AS');
- { restore register, this restores automatically the }
- { result }
- popusedregisters(pushed);
- maybe_loadesi;
- end;
- begin
- ctypeconvnode:=ti386typeconvnode;
- cisnode:=ti386isnode;
- casnode:=ti386asnode;
- end.
- {
- $Log$
- Revision 1.11 2000-12-25 00:07:32 peter
- + new tlinkedlist class (merge of old tstringqueue,tcontainer and
- tlinkedlist objects)
- Revision 1.10 2000/12/07 17:19:46 jonas
- * new constant handling: from now on, hex constants >$7fffffff are
- parsed as unsigned constants (otherwise, $80000000 got sign extended
- and became $ffffffff80000000), all constants in the longint range
- become longints, all constants >$7fffffff and <=cardinal($ffffffff)
- are cardinals and the rest are int64's.
- * added lots of longint typecast to prevent range check errors in the
- compiler and rtl
- * type casts of symbolic ordinal constants are now preserved
- * fixed bug where the original resulttype wasn't restored correctly
- after doing a 64bit rangecheck
- Revision 1.9 2000/12/05 11:44:33 jonas
- + new integer regvar handling, should be much more efficient
- Revision 1.8 2000/11/29 00:30:46 florian
- * unused units removed from uses clause
- * some changes for widestrings
- Revision 1.7 2000/11/16 15:27:48 jonas
- * fixed web bug 1242
- Revision 1.6 2000/11/13 11:30:56 florian
- * some bugs with interfaces and NIL fixed
- Revision 1.5 2000/11/12 23:24:14 florian
- * interfaces are basically running
- Revision 1.4 2000/11/11 16:00:10 jonas
- * optimize converting of 8/16/32 bit constants to 64bit ones
- Revision 1.3 2000/11/04 14:25:23 florian
- + merged Attila's changes for interfaces, not tested yet
- Revision 1.2 2000/10/31 22:02:56 peter
- * symtable splitted, no real code changes
- Revision 1.1 2000/10/15 09:33:31 peter
- * moved n386*.pas to i386/ cpu_target dir
- Revision 1.1 2000/10/14 10:14:48 peter
- * moehrendorf oct 2000 rewrite
- }
|