{ $Id$ Copyright (c) 1998-2000 by Florian Klaempfl This unit handles the exports parsing 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 pexports; {$i defines.inc} interface { reads an exports statement in a library } procedure read_exports; implementation uses { common } cutils, { global } globals,tokens,verbose, systems, { symtable } symconst,symdef,symsym,symtable, { pass 1 } node,pass_1, ncon, { parser } scanner, pbase,pexpr, { link } gendef,export ; procedure read_exports; var hp : texported_item; orgs, DefString : string; ProcName : string; InternalProcName : string; pt : tnode; begin DefString:=''; InternalProcName:=''; consume(_EXPORTS); while true do begin hp:=texported_item.create; if token=_ID then begin getsym(pattern,true); if srsym^.typ=unitsym then begin consume(_ID); consume(_POINT); getsymonlyin(punitsym(srsym)^.unitsymtable,pattern); end; orgs:=orgpattern; consume(_ID); if assigned(srsym) then begin hp.sym:=srsym; if ((hp.sym^.typ<>procsym) or ((tf_need_export in target_info.flags) and not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions) ) ) and (srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then Message(parser_e_illegal_symbol_exported) else begin ProcName:=orgs; InternalProcName:=hp.sym^.mangledname; { This is wrong if the first is not an underline } if InternalProcName[1]='_' then delete(InternalProcName,1,1) else if (target_os.id=os_i386_win32) and UseDeffileForExport then begin Message(parser_e_dlltool_unit_var_problem); Message(parser_e_dlltool_unit_var_problem2); end; if length(InternalProcName)<2 then Message(parser_e_procname_to_short_for_export); DefString:=ProcName+'='+InternalProcName; end; if (idtoken=_INDEX) then begin consume(_INDEX); pt:=comp_expr(true); do_firstpass(pt); if pt.nodetype=ordconstn then hp.index:=tordconstnode(pt).value else begin hp.index:=0; consume(_INTCONST); end; hp.options:=hp.options or eo_index; pt.free; if target_os.id=os_i386_win32 then DefString:=ProcName+'='+InternalProcName+' @ '+tostr(hp.index) else DefString:=ProcName+'='+InternalProcName; {Index ignored!} end; if (idtoken=_NAME) then begin consume(_NAME); pt:=comp_expr(true); do_firstpass(pt); if pt.nodetype=stringconstn then hp.name:=stringdup(strpas(tstringconstnode(pt).value_str)) else begin hp.name:=stringdup(''); consume(_CSTRING); end; hp.options:=hp.options or eo_name; pt.free; DefString:=hp.name^+'='+InternalProcName; end; if (idtoken=_RESIDENT) then begin consume(_RESIDENT); hp.options:=hp.options or eo_resident; DefString:=ProcName+'='+InternalProcName;{Resident ignored!} end; if (DefString<>'') and UseDeffileForExport then DefFile.AddExport(DefString); { Default to generate a name entry with the provided name } if not assigned(hp.name) then begin hp.name:=stringdup(orgs); hp.options:=hp.options or eo_name; end; if hp.sym^.typ=procsym then exportlib.exportprocedure(hp) else exportlib.exportvar(hp); end; end else consume(_ID); if token=_COMMA then consume(_COMMA) else break; end; consume(_SEMICOLON); if not DefFile.empty then DefFile.writefile; end; end. { $Log$ Revision 1.11 2001-01-03 13:12:50 jonas * fixed copy/past bugs Revision 1.10 2000/12/30 22:53:25 peter * export with the case provided in the exports section Revision 1.9 2000/12/25 00:07:27 peter + new tlinkedlist class (merge of old tstringqueue,tcontainer and tlinkedlist objects) Revision 1.8 2000/11/29 00:30:36 florian * unused units removed from uses clause * some changes for widestrings Revision 1.7 2000/10/31 22:02:49 peter * symtable splitted, no real code changes Revision 1.6 2000/10/14 10:14:51 peter * moehrendorf oct 2000 rewrite Revision 1.5 2000/09/24 21:19:50 peter * delphi compile fixes Revision 1.4 2000/09/24 15:06:21 peter * use defines.inc Revision 1.3 2000/08/27 16:11:51 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule Revision 1.2 2000/07/13 11:32:44 michael + removed logs }