{ $Id$ Copyright (c) 1998-2002 by Florian Klaempfl Helper routines for all code generators 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 ncgutil; {$i fpcdefs.inc} interface uses node,cpuinfo, globtype, cpubase,cpupara, aasmbase,aasmtai,aasmcpu, cginfo,symbase,symdef,symtype, {$ifndef cpu64bit} cg64f32, {$endif cpu64bit} rgobj; type tloadregvars = (lr_dont_load_regvars, lr_load_regvars); tmaybesave = record saved : boolean; ref : treference; end; procedure firstcomplex(p : tbinarynode); procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars); procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset); procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean); procedure location_force_mem(list: TAAsmoutput;var l:tlocation); procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave); procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave); function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean; procedure push_value_para(p:tnode;calloption:tproccalloption; para_offset:longint;alignment : longint; const locpara : tparalocation); procedure genentrycode(list : TAAsmoutput; make_global:boolean; stackframe:longint; var parasize:longint;var nostackframe:boolean; inlined : boolean); procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean); procedure genimplicitunitinit(list : TAAsmoutput); procedure genimplicitunitfinal(list : TAAsmoutput); {# Allocate the buffers for exception management and setjmp environment. Return a pointer to these buffers, send them to the utility routine so they are registered, and then call setjmp. Then compare the result of setjmp with 0, and if not equal to zero, then jump to exceptlabel. Also store the result of setjmp to a temporary space by calling g_save_exception_reason It is to note that this routine may be called *after* the stackframe of a routine has been called, therefore on machines where the stack cannot be modified, all temps should be allocated on the heap instead of the stack. } procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference; a : aword; exceptlabel : tasmlabel); procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference; a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean); implementation uses {$ifdef Delphi} Sysutils, {$else} strings, {$endif} cutils,cclasses, globals,systems,verbose, symconst,symsym,symtable,defutil, paramgr,fmodule, cgbase,regvars, {$ifdef GDB} gdb, {$endif GDB} ncon, tgobj,cgobj,cgcpu; {***************************************************************************** Misc Helpers *****************************************************************************} { DO NOT RELY on the fact that the tnode is not yet swaped because of inlining code PM } procedure firstcomplex(p : tbinarynode); var hp : tnode; begin { always calculate boolean AND and OR from left to right } if (p.nodetype in [orn,andn]) and is_boolean(p.left.resulttype.def) then begin if nf_swaped in p.flags then internalerror(234234); end else if ( (p.location.loc=LOC_FPUREGISTER) and (p.right.registersfpu > p.left.registersfpu) ) or ( ( ( ((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or (p.location.loc<>LOC_FPUREGISTER) ) and (p.left.registers32