123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888 |
- {
- $Id$
- Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione
- Does the parsing and codegeneration at subroutine level
- 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 psub;
- {$i fpcdefs.inc}
- interface
- procedure compile_proc_body(make_global,parent_has_class:boolean);
- { reads the declaration blocks }
- procedure read_declarations(islibrary : boolean);
- { reads declarations in the interface part of a unit }
- procedure read_interface_declarations;
- implementation
- uses
- { common }
- cutils,cclasses,
- { global }
- globtype,globals,tokens,verbose,comphook,
- systems,
- { aasm }
- cpubase,cpuinfo,aasmbase,aasmtai,
- { symtable }
- symconst,symbase,symdef,symsym,symtype,symtable,defbase,paramgr,
- ppu,fmodule,
- { pass 1 }
- node,
- nbas,
- pass_1,
- {$ifdef state_tracking}
- nstate,
- {$endif state_tracking}
- { pass 2 }
- {$ifndef NOPASS2}
- pass_2,
- {$endif}
- { parser }
- scanner,
- pbase,pstatmnt,pdecl,pdecsub,pexports,
- { codegen }
- tgobj,cgbase,rgobj,rgcpu,
- ncgutil
- {$ifndef NOOPT}
- {$ifdef i386}
- ,aopt386
- {$else i386}
- ,aoptcpu
- {$endif i386}
- {$endif}
- ;
- {****************************************************************************
- PROCEDURE/FUNCTION BODY PARSING
- ****************************************************************************}
- function block(islibrary : boolean) : tnode;
- var
- storepos : tfileposinfo;
- begin
- { do we have an assembler block without the po_assembler?
- we should allow this for Delphi compatibility (PFV) }
- if (token=_ASM) and (m_delphi in aktmodeswitches) then
- include(aktprocdef.procoptions,po_assembler);
- { Handle assembler block different }
- if (po_assembler in aktprocdef.procoptions) then
- begin
- read_declarations(false);
- block:=assembler_block;
- exit;
- end;
- if not is_void(aktprocdef.rettype.def) then
- begin
- { if the current is a function aktprocsym is non nil }
- { and there is a local symtable set }
- storepos:=akttokenpos;
- akttokenpos:=aktprocsym.fileinfo;
- aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype);
- { insert in local symtable }
- symtablestack.insert(aktprocdef.funcretsym);
- symtablestack.insertvardata(aktprocdef.funcretsym);
- akttokenpos:=storepos;
- procinfo.set_result_offset;
- { insert result also if support is on }
- if (m_result in aktmodeswitches) then
- begin
- aktprocdef.resultfuncretsym:=tfuncretsym.create('RESULT',aktprocdef.rettype);
- symtablestack.insert(aktprocdef.resultfuncretsym);
- end;
- end;
- read_declarations(islibrary);
- procinfo.handle_body_start;
- {Unit initialization?.}
- if (lexlevel=unit_init_level) and (current_module.is_unit)
- or islibrary then
- begin
- if (token=_END) then
- begin
- consume(_END);
- { We need at least a node, else the entry/exit code is not
- generated and thus no PASCALMAIN symbol which we need (PFV) }
- if islibrary then
- block:=cnothingnode.create
- else
- block:=nil;
- end
- else
- begin
- if token=_INITIALIZATION then
- begin
- current_module.flags:=current_module.flags or uf_init;
- block:=statement_block(_INITIALIZATION);
- end
- else if (token=_FINALIZATION) then
- begin
- if (current_module.flags and uf_finalize)<>0 then
- block:=statement_block(_FINALIZATION)
- else
- begin
- { can we allow no INITIALIZATION for DLL ??
- I think it should work PM }
- block:=nil;
- exit;
- end;
- end
- else
- begin
- current_module.flags:=current_module.flags or uf_init;
- block:=statement_block(_BEGIN);
- end;
- end;
- end
- else
- block:=statement_block(_BEGIN);
- end;
- {****************************************************************************
- PROCEDURE/FUNCTION COMPILING
- ****************************************************************************}
- procedure compile_proc_body(make_global,parent_has_class:boolean);
- {
- Compile the body of a procedure
- }
- var
- oldexitlabel,oldexit2label : tasmlabel;
- oldfaillabel,oldquickexitlabel:tasmlabel;
- _class,hp:tobjectdef;
- { switches can change inside the procedure }
- entryswitches, exitswitches : tlocalswitches;
- oldaktmaxfpuregisters,localmaxfpuregisters : longint;
- { code for the subroutine as tree }
- code:tnode;
- { true when no stackframe is required }
- nostackframe:boolean;
- { number of bytes which have to be cleared by RET }
- parasize:longint;
- { filepositions }
- entrypos,
- savepos,
- exitpos : tfileposinfo;
- begin
- { calculate the lexical level }
- inc(lexlevel);
- if lexlevel>32 then
- Message(parser_e_too_much_lexlevel);
- { static is also important for local procedures !! }
- if (po_staticmethod in aktprocdef.procoptions) then
- allow_only_static:=true
- else if (lexlevel=normal_function_level) then
- allow_only_static:=false;
- { save old labels }
- oldexitlabel:=aktexitlabel;
- oldexit2label:=aktexit2label;
- oldquickexitlabel:=quickexitlabel;
- oldfaillabel:=faillabel;
- { get new labels }
- objectlibrary.getlabel(aktexitlabel);
- objectlibrary.getlabel(aktexit2label);
- { exit for fail in constructors }
- if (aktprocdef.proctypeoption=potype_constructor) then
- begin
- objectlibrary.getlabel(faillabel);
- objectlibrary.getlabel(quickexitlabel);
- end;
- { reset break and continue labels }
- block_type:=bt_general;
- aktbreaklabel:=nil;
- aktcontinuelabel:=nil;
- {$ifdef state_tracking}
- { aktstate:=Tstate_storage.create;}
- {$endif state_tracking}
- { insert symtables for the class, by only if it is no nested function }
- if assigned(procinfo._class) and not(parent_has_class) then
- begin
- { insert them in the reverse order ! }
- hp:=nil;
- repeat
- _class:=procinfo._class;
- while _class.childof<>hp do
- _class:=_class.childof;
- hp:=_class;
- _class.symtable.next:=symtablestack;
- symtablestack:=_class.symtable;
- until hp=procinfo._class;
- end;
- { insert parasymtable in symtablestack}
- { only if lexlevel > 1 !!! global symtable should be right after staticsymtazble
- for checking of same names used in interface and implementation !! }
- if lexlevel>=normal_function_level then
- begin
- aktprocdef.parast.next:=symtablestack;
- symtablestack:=aktprocdef.parast;
- symtablestack.symtablelevel:=lexlevel;
- end;
- { insert localsymtable in symtablestack}
- aktprocdef.localst.next:=symtablestack;
- symtablestack:=aktprocdef.localst;
- symtablestack.symtablelevel:=lexlevel;
- { constant symbols are inserted in this symboltable }
- constsymtable:=symtablestack;
- { reset the temporary memory }
- rg.cleartempgen;
- rg.usedinproc:=[];
- rg.usedbyproc:=[];
- { save entry info }
- entrypos:=aktfilepos;
- entryswitches:=aktlocalswitches;
- localmaxfpuregisters:=aktmaxfpuregisters;
- { parse the code ... }
- code:=block(current_module.islibrary);
- { get a better entry point }
- if assigned(code) then
- entrypos:=code.fileinfo;
- { save exit info }
- exitswitches:=aktlocalswitches;
- exitpos:=last_endtoken_filepos;
- { save current filepos }
- savepos:=aktfilepos;
- {When we are called to compile the body of a unit, aktprocsym should
- point to the unit initialization. If the unit has no initialization,
- aktprocsym=nil. But in that case code=nil. hus we should check for
- code=nil, when we use aktprocsym.}
- { set the start offset to the start of the temp area in the stack }
- tg.setfirsttemp(procinfo.firsttemp_offset);
- { ... and generate assembler }
- { but set the right switches for entry !! }
- aktlocalswitches:=entryswitches;
- oldaktmaxfpuregisters:=aktmaxfpuregisters;
- aktmaxfpuregisters:=localmaxfpuregisters;
- if assigned(code) then
- begin
- { the procedure is now defined }
- aktprocdef.forwarddef:=false;
- {$ifdef state_tracking}
- { writenode(code);
- do_track_state_pass(code);
- writenode(code);}
- {$endif}
- { only generate the code if no type errors are found, else
- finish at least the type checking pass }
- {$ifndef NOPASS2}
- if (status.errorcount=0) then
- begin
- generatecode(code);
- aktprocdef.code:=code;
- { first generate entry code with the correct position and switches }
- aktfilepos:=entrypos;
- aktlocalswitches:=entryswitches;
- genentrycode(procinfo.aktentrycode,make_global,0,parasize,nostackframe,false);
- { FPC_POPADDRSTACK destroys all registers (JM) }
- if (procinfo.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0 then
- begin
- rg.usedinproc := ALL_REGISTERS;
- end;
- { now generate exit code with the correct position and switches }
- aktfilepos:=exitpos;
- aktlocalswitches:=exitswitches;
- genexitcode(procinfo.aktexitcode,parasize,nostackframe,false);
- { now all the registers used are known }
- aktprocdef.usedregisters:=rg.usedinproc;
- procinfo.aktproccode.insertlist(procinfo.aktentrycode);
- procinfo.aktproccode.concatlist(procinfo.aktexitcode);
- {$ifdef i386}
- {$ifndef NoOpt}
- if (cs_optimize in aktglobalswitches) and
- { do not optimize pure assembler procedures }
- ((procinfo.flags and pi_is_assembler)=0) then
- Optimize(procinfo.aktproccode);
- {$endif NoOpt}
- {$endif i386}
- { save local data (casetable) also in the same file }
- if assigned(procinfo.aktlocaldata) and
- (not procinfo.aktlocaldata.empty) then
- begin
- procinfo.aktproccode.concat(Tai_section.Create(sec_data));
- procinfo.aktproccode.concatlist(procinfo.aktlocaldata);
- procinfo.aktproccode.concat(Tai_section.Create(sec_code));
- end;
- { add the procedure to the codesegment }
- if (cs_create_smart in aktmoduleswitches) then
- codeSegment.concat(Tai_cut.Create);
- codeSegment.concatlist(procinfo.aktproccode);
- end
- else
- do_resulttypepass(code);
- {$else NOPASS2}
- do_resulttypepass(code);
- {$endif NOPASS2}
- end;
- { ... remove symbol tables }
- if lexlevel>=normal_function_level then
- symtablestack:=symtablestack.next.next
- else
- symtablestack:=symtablestack.next;
- { ... check for unused symbols }
- { but only if there is no asm block }
- if assigned(code) then
- begin
- if (Errorcount=0) then
- begin
- { check if forwards are resolved }
- tstoredsymtable(aktprocdef.localst).check_forwards;
- { check if all labels are used }
- tstoredsymtable(aktprocdef.localst).checklabels;
- { remove cross unit overloads }
- tstoredsymtable(aktprocdef.localst).unchain_overloaded;
- end;
- if (procinfo.flags and pi_uses_asm)=0 then
- begin
- { not for unit init, becuase the var can be used in finalize,
- it will be done in proc_unit }
- if not(aktprocdef.proctypeoption
- in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
- tstoredsymtable(aktprocdef.localst).allsymbolsused;
- tstoredsymtable(aktprocdef.parast).allsymbolsused;
- end;
- end;
- { the local symtables can be deleted, but the parast }
- { doesn't, (checking definitons when calling a }
- { function }
- { not for a inline procedure !! (PM) }
- { at lexlevel = 1 localst is the staticsymtable itself }
- { so no dispose here !! }
- if assigned(code) and
- not(cs_browser in aktmoduleswitches) and
- (aktprocdef.proccalloption<>pocall_inline) then
- begin
- if lexlevel>=normal_function_level then
- aktprocdef.localst.free;
- aktprocdef.localst:=nil;
- end;
- { all registers can be used again }
- rg.resetusableregisters;
- { only now we can remove the temps }
- tg.resettempgen;
- { remove code tree, if not inline procedure }
- if assigned(code) and (aktprocdef.proccalloption<>pocall_inline) then
- code.free;
- { remove class member symbol tables }
- while symtablestack.symtabletype=objectsymtable do
- symtablestack:=symtablestack.next;
- aktmaxfpuregisters:=oldaktmaxfpuregisters;
- {$ifdef state_tracking}
- { aktstate.destroy;}
- {$endif state_tracking}
- { restore filepos, the switches are already set }
- aktfilepos:=savepos;
- { restore labels }
- aktexitlabel:=oldexitlabel;
- aktexit2label:=oldexit2label;
- quickexitlabel:=oldquickexitlabel;
- faillabel:=oldfaillabel;
- { reset to normal non static function }
- if (lexlevel=normal_function_level) then
- allow_only_static:=false;
- { previous lexlevel }
- dec(lexlevel);
- end;
- {****************************************************************************
- PROCEDURE/FUNCTION PARSING
- ****************************************************************************}
- procedure checkvaluepara(p:tnamedindexitem;arg:pointer);
- var
- vs : tvarsym;
- s : string;
- begin
- if tsym(p).typ<>varsym then
- exit;
- with tvarsym(p) do
- begin
- if copy(name,1,3)='val' then
- begin
- s:=Copy(name,4,255);
- if not(po_assembler in aktprocdef.procoptions) then
- begin
- vs:=tvarsym.create(s,vartype);
- vs.fileinfo:=fileinfo;
- vs.varspez:=varspez;
- aktprocdef.localst.insert(vs);
- aktprocdef.localst.insertvardata(vs);
- include(vs.varoptions,vo_is_local_copy);
- vs.varstate:=vs_assigned;
- localvarsym:=vs;
- inc(refs); { the para was used to set the local copy ! }
- { warnings only on local copy ! }
- varstate:=vs_used;
- end
- else
- begin
- aktprocdef.parast.rename(name,s);
- end;
- end;
- end;
- end;
- procedure read_proc;
- {
- Parses the procedure directives, then parses the procedure body, then
- generates the code for it
- }
- var
- oldprocsym : tprocsym;
- oldprocdef : tprocdef;
- oldprocinfo : tprocinfo;
- oldconstsymtable : tsymtable;
- oldfilepos : tfileposinfo;
- pdflags : word;
- begin
- { save old state }
- oldprocdef:=aktprocdef;
- oldprocsym:=aktprocsym;
- oldconstsymtable:=constsymtable;
- oldprocinfo:=procinfo;
- { create a new procedure }
- codegen_newprocedure;
- with procinfo do
- begin
- parent:=oldprocinfo;
- { clear flags }
- flags:=0;
- { standard frame pointer }
- framepointer:=frame_pointer_reg;
- { is this a nested function of a method ? }
- if assigned(oldprocinfo) then
- _class:=oldprocinfo._class;
- end;
- parse_proc_dec;
- procinfo.procdef:=aktprocdef;
- { set the default function options }
- if parse_only then
- begin
- aktprocdef.forwarddef:=true;
- { set also the interface flag, for better error message when the
- implementation doesn't much this header }
- aktprocdef.interfacedef:=true;
- pdflags:=pd_interface;
- end
- else
- begin
- pdflags:=pd_body;
- if current_module.in_implementation then
- pdflags:=pdflags or pd_implemen;
- if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
- pdflags:=pdflags or pd_global;
- procinfo.exported:=false;
- aktprocdef.forwarddef:=false;
- end;
- { parse the directives that may follow }
- inc(lexlevel);
- parse_proc_directives(pdflags);
- dec(lexlevel);
- { hint directives, these can be separated by semicolons here,
- that need to be handled here with a loop (PFV) }
- while try_consume_hintdirective(aktprocsym.symoptions) do
- Consume(_SEMICOLON);
- { set aktfilepos to the beginning of the function declaration }
- oldfilepos:=aktfilepos;
- aktfilepos:=aktprocdef.fileinfo;
- { For varargs directive also cdecl and external must be defined }
- if (po_varargs in aktprocdef.procoptions) then
- begin
- { check first for external in the interface, if available there
- then the cdecl must also be there since there is no implementation
- available to contain it }
- if parse_only then
- begin
- { if external is available, then cdecl must also be available }
- if (po_external in aktprocdef.procoptions) and
- not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
- Message(parser_e_varargs_need_cdecl_and_external);
- end
- else
- begin
- { both must be defined now }
- if not(po_external in aktprocdef.procoptions) or
- not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
- Message(parser_e_varargs_need_cdecl_and_external);
- end;
- end;
- { search for forward declarations }
- if not proc_add_definition(aktprocsym,aktprocdef) then
- begin
- { A method must be forward defined (in the object declaration) }
- if assigned(procinfo._class) and
- (not assigned(oldprocinfo._class)) then
- begin
- Message1(parser_e_header_dont_match_any_member,aktprocdef.fullprocname);
- aktprocsym.write_parameter_lists(aktprocdef);
- end
- else
- begin
- { Give a better error if there is a forward def in the interface and only
- a single implementation }
- if (not aktprocdef.forwarddef) and
- (aktprocsym.procdef_count>1) and
- aktprocsym.first_procdef.forwarddef and
- aktprocsym.first_procdef.interfacedef and
- not(aktprocsym.procdef_count>2) then
- begin
- Message1(parser_e_header_dont_match_forward,aktprocdef.fullprocname);
- aktprocsym.write_parameter_lists(aktprocdef);
- end
- else
- begin
- { check the global flag, for delphi this is not
- required }
- if not(m_delphi in aktmodeswitches) and
- ((procinfo.flags and pi_is_global)<>0) then
- Message(parser_e_overloaded_must_be_all_global);
- end;
- end;
- end;
- { update procinfo, because the aktprocdef can be
- changed by check_identical_proc (PFV) }
- procinfo.procdef:=aktprocdef;
- {$ifdef i386}
- { add implicit pushes for interrupt routines }
- if (po_interrupt in aktprocdef.procoptions) then
- procinfo.allocate_interrupt_stackframe;
- begin
- end;
- {$endif i386}
- { pointer to the return value ? }
- if paramanager.ret_in_param(aktprocdef.rettype.def) then
- begin
- procinfo.return_offset:=procinfo.para_offset;
- inc(procinfo.para_offset,pointer_size);
- end;
- { allows to access the parameters of main functions in nested functions }
- aktprocdef.parast.address_fixup:=procinfo.para_offset;
- { when it is a value para and it needs a local copy then rename
- the parameter and insert a copy in the localst. This is not done
- for assembler procedures }
- if (not parse_only) and (not aktprocdef.forwarddef) then
- aktprocdef.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);
- { restore file pos }
- aktfilepos:=oldfilepos;
- { compile procedure when a body is needed }
- if (pdflags and pd_body)<>0 then
- begin
- Message1(parser_p_procedure_start,
- aktprocdef.fullprocname);
- aktprocdef.aliasnames.insert(aktprocdef.mangledname);
- { set _FAIL as keyword if constructor }
- if (aktprocdef.proctypeoption=potype_constructor) then
- tokeninfo^[_FAIL].keyword:=m_all;
- if assigned(aktprocdef._class) then
- tokeninfo^[_SELF].keyword:=m_all;
- compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo._class));
- { reset _FAIL as normal }
- if (aktprocdef.proctypeoption=potype_constructor) then
- tokeninfo^[_FAIL].keyword:=m_none;
- if assigned(aktprocdef._class) and (lexlevel=main_program_level) then
- tokeninfo^[_SELF].keyword:=m_none;
- consume(_SEMICOLON);
- end;
- { close }
- codegen_doneprocedure;
- { Restore old state }
- constsymtable:=oldconstsymtable;
- {$ifdef notused}
- { restore the interface order to maintain CRC values PM }
- if assigned(prevdef) and assigned(aktprocdef.nextoverloaded) then
- begin
- stdef:=aktprocdef;
- aktprocdef:=stdef.nextoverloaded;
- stdef.nextoverloaded:=prevdef.nextoverloaded;
- prevdef.nextoverloaded:=stdef;
- end;
- {$endif notused}
- aktprocsym:=oldprocsym;
- aktprocdef:=oldprocdef;
- procinfo:=oldprocinfo;
- otsym:=nil;
- end;
- {****************************************************************************
- DECLARATION PARSING
- ****************************************************************************}
- { search in symtablestack for not complete classes }
- procedure check_forward_class(p : tnamedindexitem;arg:pointer);
- begin
- if (tsym(p).typ=typesym) and
- (ttypesym(p).restype.def.deftype=objectdef) and
- (oo_is_forward in tobjectdef(ttypesym(p).restype.def).objectoptions) then
- MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
- end;
- procedure read_declarations(islibrary : boolean);
- procedure Not_supported_for_inline(t : ttoken);
- begin
- if assigned(aktprocsym) and
- (aktprocdef.proccalloption=pocall_inline) then
- Begin
- Message1(parser_w_not_supported_for_inline,tokenstring(t));
- Message(parser_w_inlining_disabled);
- aktprocdef.proccalloption:=pocall_fpccall;
- End;
- end;
- begin
- repeat
- case token of
- _LABEL:
- begin
- Not_supported_for_inline(token);
- label_dec;
- end;
- _CONST:
- begin
- Not_supported_for_inline(token);
- const_dec;
- end;
- _TYPE:
- begin
- Not_supported_for_inline(token);
- type_dec;
- end;
- _VAR:
- var_dec;
- _THREADVAR:
- threadvar_dec;
- _CONSTRUCTOR,_DESTRUCTOR,
- _FUNCTION,_PROCEDURE,_OPERATOR,_CLASS:
- begin
- Not_supported_for_inline(token);
- read_proc;
- end;
- _RESOURCESTRING:
- resourcestring_dec;
- _EXPORTS:
- begin
- Not_supported_for_inline(token);
- { here we should be at lexlevel 1, no ? PM }
- if (lexlevel<>main_program_level) or
- (current_module.is_unit) then
- begin
- Message(parser_e_syntax_error);
- consume_all_until(_SEMICOLON);
- end
- else if islibrary or (target_info.system in [system_i386_WIN32,system_i386_wdosx,system_i386_Netware])
- then // AD
- read_exports;
- end
- else break;
- end;
- until false;
- { check for incomplete class definitions, this is only required
- for fpc modes }
- if (m_fpc in aktmodeswitches) then
- symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
- end;
- procedure read_interface_declarations;
- begin
- {Since the body is now parsed at lexlevel 1, and the declarations
- must be parsed at the same lexlevel we increase the lexlevel.}
- inc(lexlevel);
- repeat
- case token of
- _CONST :
- const_dec;
- _TYPE :
- type_dec;
- _VAR :
- var_dec;
- _THREADVAR :
- threadvar_dec;
- _RESOURCESTRING:
- resourcestring_dec;
- _FUNCTION,
- _PROCEDURE,
- _OPERATOR :
- read_proc;
- else
- break;
- end;
- until false;
- dec(lexlevel);
- { check for incomplete class definitions, this is only required
- for fpc modes }
- if (m_fpc in aktmodeswitches) then
- symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
- end;
- end.
- {
- $Log$
- Revision 1.71 2002-09-07 15:25:07 peter
- * old logs removed and tabs fixed
- Revision 1.70 2002/09/03 16:26:27 daniel
- * Make Tprocdef.defs protected
- Revision 1.69 2002/08/25 19:25:20 peter
- * sym.insert_in_data removed
- * symtable.insertvardata/insertconstdata added
- * removed insert_in_data call from symtable.insert, it needs to be
- called separatly. This allows to deref the address calculation
- * procedures now calculate the parast addresses after the procedure
- directives are parsed. This fixes the cdecl parast problem
- * push_addr_param has an extra argument that specifies if cdecl is used
- or not
- Revision 1.68 2002/08/17 09:23:41 florian
- * first part of procinfo rewrite
- Revision 1.67 2002/08/16 14:24:59 carl
- * issameref() to test if two references are the same (then emit no opcodes)
- + ret_in_reg to replace ret_in_acc
- (fix some register allocation bugs at the same time)
- + save_std_register now has an extra parameter which is the
- usedinproc registers
- Revision 1.66 2002/08/11 14:32:27 peter
- * renamed current_library to objectlibrary
- Revision 1.65 2002/08/11 13:24:13 peter
- * saving of asmsymbols in ppu supported
- * asmsymbollist global is removed and moved into a new class
- tasmlibrarydata that will hold the info of a .a file which
- corresponds with a single module. Added librarydata to tmodule
- to keep the library info stored for the module. In the future the
- objectfiles will also be stored to the tasmlibrarydata class
- * all getlabel/newasmsymbol and friends are moved to the new class
- Revision 1.64 2002/08/09 19:14:28 carl
- * fixed stackframe parameter (should only contain local size),
- set to zero currently
- Revision 1.63 2002/08/06 20:55:22 florian
- * first part of ppc calling conventions fix
- Revision 1.62 2002/07/26 21:15:41 florian
- * rewrote the system handling
- Revision 1.61 2002/07/20 11:57:56 florian
- * types.pas renamed to defbase.pas because D6 contains a types
- unit so this would conflicts if D6 programms are compiled
- + Willamette/SSE2 instructions to assembler added
- Revision 1.60 2002/07/19 11:41:36 daniel
- * State tracker work
- * The whilen and repeatn are now completely unified into whilerepeatn. This
- allows the state tracker to change while nodes automatically into
- repeat nodes.
- * Resulttypepass improvements to the notn. 'not not a' is optimized away and
- 'not(a>b)' is optimized into 'a<=b'.
- * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
- by removing the notn and later switchting the true and falselabels. The
- same is done with 'repeat until not a'.
- Revision 1.59 2002/07/15 18:03:15 florian
- * readded removed changes
- Revision 1.57 2002/07/11 14:41:28 florian
- * start of the new generic parameter handling
- Revision 1.58 2002/07/14 18:00:44 daniel
- + Added the beginning of a state tracker. This will track the values of
- variables through procedures and optimize things away.
- Revision 1.56 2002/07/07 09:52:32 florian
- * powerpc target fixed, very simple units can be compiled
- * some basic stuff for better callparanode handling, far from being finished
- Revision 1.55 2002/07/04 20:43:01 florian
- * first x86-64 patches
- Revision 1.54 2002/07/01 18:46:25 peter
- * internal linker
- * reorganized aasm layer
- Revision 1.53 2002/05/18 13:34:14 peter
- * readded missing revisions
- Revision 1.52 2002/05/16 19:46:44 carl
- + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
- + try to fix temp allocation (still in ifdef)
- + generic constructor calls
- + start of tassembler / tmodulebase class cleanup
- Revision 1.51 2002/05/14 19:34:49 peter
- * removed old logs and updated copyright year
- }
|