pexports.pas 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. This unit handles the exports parsing
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit pexports;
  19. interface
  20. { reads an exports statement in a library }
  21. procedure read_exports;
  22. implementation
  23. uses
  24. globtype,systems,tokens,
  25. strings,cobjects,globals,verbose,
  26. scanner,symconst,symtable,pbase,
  27. export,GenDef;
  28. procedure read_exports;
  29. var
  30. hp : pexported_item;
  31. code : integer;
  32. DefString:string;
  33. ProcName:string;
  34. InternalProcName:string;
  35. begin
  36. DefString:='';
  37. InternalProcName:='';
  38. consume(_EXPORTS);
  39. while true do
  40. begin
  41. hp:=new(pexported_item,init);
  42. if token=_ID then
  43. begin
  44. getsym(pattern,true);
  45. if srsym^.typ=unitsym then
  46. begin
  47. consume(_ID);
  48. consume(_POINT);
  49. getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
  50. end;
  51. consume(_ID);
  52. if assigned(srsym) then
  53. begin
  54. hp^.sym:=srsym;
  55. if ((srsym^.typ<>procsym) or
  56. ((tf_need_export in target_info.flags) and
  57. not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)
  58. )
  59. ) and
  60. (srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then
  61. Message(parser_e_illegal_symbol_exported)
  62. else
  63. begin
  64. ProcName:=hp^.sym^.name;
  65. InternalProcName:=hp^.sym^.mangledname;
  66. { This is wrong if the first is not
  67. an underline }
  68. if InternalProcName[1]='_' then
  69. delete(InternalProcName,1,1)
  70. else if (target_os.id=os_i386_win32) and UseDeffileForExport then
  71. begin
  72. Message(parser_e_dlltool_unit_var_problem);
  73. Message(parser_e_dlltool_unit_var_problem2);
  74. end;
  75. if length(InternalProcName)<2 then
  76. Message(parser_e_procname_to_short_for_export);
  77. DefString:=ProcName+'='+InternalProcName;
  78. end;
  79. if (idtoken=_INDEX) then
  80. begin
  81. consume(_INDEX);
  82. hp^.options:=hp^.options or eo_index;
  83. val(pattern,hp^.index,code);
  84. consume(_INTCONST);
  85. if target_os.id=os_i386_win32 then
  86. DefString:=ProcName+'='+InternalProcName+' @ '+tostr(hp^.index)
  87. else
  88. DefString:=ProcName+'='+InternalProcName; {Index ignored!}
  89. end;
  90. if (idtoken=_NAME) then
  91. begin
  92. consume(_NAME);
  93. hp^.name:=stringdup(pattern);
  94. hp^.options:=hp^.options or eo_name;
  95. if token=_CCHAR then
  96. consume(_CCHAR)
  97. else
  98. consume(_CSTRING);
  99. DefString:=hp^.name^+'='+InternalProcName;
  100. end;
  101. if (idtoken=_RESIDENT) then
  102. begin
  103. consume(_RESIDENT);
  104. hp^.options:=hp^.options or eo_resident;
  105. DefString:=ProcName+'='+InternalProcName;{Resident ignored!}
  106. end;
  107. if (DefString<>'') and UseDeffileForExport then
  108. DefFile.AddExport(DefString);
  109. if srsym^.typ=procsym then
  110. exportlib^.exportprocedure(hp)
  111. else
  112. begin
  113. exportlib^.exportvar(hp);
  114. end;
  115. end;
  116. end
  117. else
  118. consume(_ID);
  119. if token=_COMMA then
  120. consume(_COMMA)
  121. else
  122. break;
  123. end;
  124. consume(_SEMICOLON);
  125. if not DefFile.empty then
  126. DefFile.writefile;
  127. end;
  128. end.
  129. {
  130. $Log$
  131. Revision 1.19 2000-02-09 13:22:56 peter
  132. * log truncated
  133. Revision 1.18 2000/01/07 01:14:28 peter
  134. * updated copyright to 2000
  135. Revision 1.17 1999/12/20 23:23:30 pierre
  136. + $description $version
  137. Revision 1.16 1999/12/08 10:40:01 pierre
  138. + allow use of unit var in exports of DLL for win32
  139. by using direct export writing by default instead of use of DEFFILE
  140. that does not allow assembler labels that do not
  141. start with an underscore.
  142. Use -WD to force use of Deffile for Win32 DLL
  143. Revision 1.15 1999/11/22 22:20:43 pierre
  144. * Def file syntax for win32 with index corrected
  145. * direct output of .edata leads to same indexes
  146. (index 5 leads to next export being 6 unless otherwise
  147. specified like for enums)
  148. Revision 1.14 1999/11/20 01:19:10 pierre
  149. * DLL index used for win32 target with DEF file
  150. + DLL initialization/finalization support
  151. Revision 1.13 1999/10/26 12:30:44 peter
  152. * const parameter is now checked
  153. * better and generic check if a node can be used for assigning
  154. * export fixes
  155. * procvar equal works now (it never had worked at least from 0.99.8)
  156. * defcoll changed to linkedlist with pparaitem so it can easily be
  157. walked both directions
  158. Revision 1.12 1999/08/10 12:51:19 pierre
  159. * bind_win32_dll removed (Relocsection used instead)
  160. * now relocsection is true by default ! (needs dlltool
  161. for DLL generation)
  162. Revision 1.11 1999/08/04 13:02:54 jonas
  163. * all tokens now start with an underscore
  164. * PowerPC compiles!!
  165. Revision 1.10 1999/08/03 22:02:58 peter
  166. * moved bitmask constants to sets
  167. * some other type/const renamings
  168. }