browser.pas 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172
  1. {
  2. $Id$
  3. Copyright (c) 1996-98 by Florian Klaempfl
  4. This unit implements a browser object
  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. unit browser;
  18. interface
  19. uses globals, files;
  20. type
  21. pref = ^tref;
  22. tref = object
  23. nextref : pref;
  24. inputfile : pinputfile;
  25. lineno : longint;
  26. constructor init(ref : pref);
  27. constructor load(var ref : pref;fileindex : word;line : longint);
  28. destructor done; virtual;
  29. function get_file_line : string;
  30. end;
  31. { simple method to chain all refs }
  32. procedure add_new_ref(var ref : pref);
  33. function get_source_file(index : word) : pinputfile;
  34. { one big problem remains for overloaded procedure }
  35. { we should be able to separate them }
  36. { this might be feasable in pass_1 }
  37. implementation
  38. constructor tref.init(ref :pref);
  39. begin
  40. nextref:=nil;
  41. if ref<>nil then
  42. ref^.nextref:=@self;
  43. if current_module<>nil then
  44. begin
  45. inputfile:=current_module^.current_inputfile;
  46. if inputfile<>nil then
  47. begin
  48. inc(inputfile^.ref_index);
  49. lineno:=inputfile^.line_no;
  50. end
  51. else
  52. lineno:=0;
  53. end
  54. else
  55. begin
  56. inputfile:=nil;
  57. lineno:=0;
  58. end;
  59. end;
  60. constructor tref.load(var ref : pref;fileindex : word;line : longint);
  61. begin
  62. if assigned(ref) then
  63. ref^.nextref:=@self;
  64. nextref:=nil;
  65. inputfile:=get_source_file(fileindex);
  66. lineno:=line;
  67. ref:=@self;
  68. end;
  69. destructor tref.done;
  70. begin
  71. if inputfile<>nil then
  72. dec(inputfile^.ref_count);
  73. end;
  74. function tref.get_file_line : string;
  75. begin
  76. get_file_line:='';
  77. if inputfile=nil then exit;
  78. if Use_Rhide then
  79. get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
  80. else
  81. get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
  82. end;
  83. procedure add_new_ref(var ref : pref);
  84. var
  85. newref : pref;
  86. begin
  87. new(newref,init(ref));
  88. ref:=newref;
  89. end;
  90. function get_source_file(index : word) : pinputfile;
  91. var
  92. f : pinputfile;
  93. begin
  94. get_source_file:=nil;
  95. f:=pinputfile(current_module^.sourcefiles.files);
  96. while assigned(f) do
  97. begin
  98. if f^.ref_index=index then
  99. begin
  100. get_source_file:=f;
  101. exit;
  102. end;
  103. f:=pinputfile(f^._next);
  104. end;
  105. end;
  106. end.
  107. {
  108. $Log$
  109. Revision 1.2 1998-04-30 15:59:39 pierre
  110. * GDB works again better :
  111. correct type info in one pass
  112. + UseTokenInfo for better source position
  113. * fixed one remaining bug in scanner for line counts
  114. * several little fixes
  115. Revision 1.1.1.1 1998/03/25 11:18:12 root
  116. * Restored version
  117. Revision 1.5 1998/03/10 16:27:36 pierre
  118. * better line info in stabs debug
  119. * symtabletype and lexlevel separated into two fields of tsymtable
  120. + ifdef MAKELIB for direct library output, not complete
  121. + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  122. working
  123. + ifdef TESTFUNCRET for setting func result in underfunction, not
  124. working
  125. Revision 1.4 1998/03/10 01:17:15 peter
  126. * all files have the same header
  127. * messages are fully implemented, EXTDEBUG uses Comment()
  128. + AG... files for the Assembler generation
  129. Revision 1.3 1998/03/02 01:48:06 peter
  130. * renamed target_DOS to target_GO32V1
  131. + new verbose system, merged old errors and verbose units into one new
  132. verbose.pas, so errors.pas is obsolete
  133. Revision 1.2 1998/02/13 10:34:37 daniel
  134. * Made Motorola version compilable.
  135. * Fixed optimizer
  136. Revision 1.1.1.1 1997/11/27 08:32:51 michael
  137. FPC Compiler CVS start
  138. }