paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 19:02:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

* rework of macro subsystem

Browse Source 
+ exportable macros for mode macpas
This commit is contained in:
olle 2005-01-09 20:24:43 +00:00
parent dd84e43eca
commit 7572f3a539
18 changed files with 1147 additions and 732 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/compiler.pas
View File

@ -310,7 +310,7 @@ begin
do_initSymbolInfo;
{$endif BrowserCol}
inittokens;
InitSymtable;
InitSymtable; {Must come before read_arguments, to enable macrosymstack}
CompilerInited:=true;
{ this is needed here for the IDE
in case of compilation failure
@ -448,7 +448,11 @@ end;
end.
{
$Log$
Revision 1.50 2004-11-22 19:34:58 peter
Revision 1.51 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.50 2004/11/22 19:34:58 peter
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
Revision 1.49 2004/10/15 09:14:16 mazen

27
compiler/fmodule.pas
View File

@ -95,6 +95,7 @@ interface
is_unit,
in_interface, { processing the implementation part? }
in_global : boolean; { allow global settings }
mode_switch_allowed : boolean; { Whether a mode switch is still allowed at this point in the parsing.}
mainfilepos : tfileposinfo;
recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
crc,
@ -107,6 +108,8 @@ interface
derefdata : tdynamicarray;
globalsymtable, { pointer to the global symtable of this unit }
localsymtable : tsymtable;{ pointer to the local symtable of this unit }
globalmacrosymtable, { pointer to the global macro symtable of this unit }
localmacrosymtable : tsymtable;{ pointer to the local macro symtable of this unit }
scanner : pointer; { scanner object used }
procinfo : pointer; { current procedure being compiled }
loaded_from : tmodule;
@ -396,6 +399,8 @@ implementation
derefdataintflen:=0;
globalsymtable:=nil;
localsymtable:=nil;
globalmacrosymtable:=nil;
localmacrosymtable:=nil;
loaded_from:=LoadedFrom;
do_reload:=false;
do_compile:=false;
@ -410,6 +415,7 @@ implementation
islibrary:=false;
is_stab_written:=false;
is_reset:=false;
mode_switch_allowed:= true;
uses_imports:=false;
imports:=TLinkedList.Create;
_exports:=TLinkedList.Create;
@ -484,6 +490,10 @@ implementation
globalsymtable.free;
if assigned(localsymtable) then
localsymtable.free;
if assigned(globalmacrosymtable) then
globalmacrosymtable.free;
if assigned(localmacrosymtable) then
localmacrosymtable.free;
{$ifdef MEMDEBUG}
d.free;
{$endif}
@ -534,6 +544,16 @@ implementation
localsymtable.free;
localsymtable:=nil;
end;
if assigned(globalmacrosymtable) then
begin
globalmacrosymtable.free;
globalmacrosymtable:=nil;
end;
if assigned(localmacrosymtable) then
begin
localmacrosymtable.free;
localmacrosymtable:=nil;
end;
derefdata.free;
derefdata:=TDynamicArray.Create(1024);
if assigned(map) then
@ -577,6 +597,7 @@ implementation
interface_compiled:=false;
in_interface:=true;
in_global:=true;
mode_switch_allowed:=true;
is_stab_written:=false;
is_reset:=false;
crc:=0;
@ -711,7 +732,11 @@ implementation
end.
{
$Log$
Revision 1.50 2004-12-28 20:43:01 hajny
Revision 1.51 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.50 2004/12/28 20:43:01 hajny
* 8.3 fixes (short target name in paths)
Revision 1.49 2004/11/04 23:59:13 peter

107
compiler/fppu.pas
View File

@ -64,20 +64,22 @@ interface
procedure load_implementation;
procedure load_symtable_refs;
procedure load_usedunits;
procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
procedure writeusedmacros;
procedure writesourcefiles;
procedure writeusedunit(intf:boolean);
procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
procedure writederefdata;
procedure putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
procedure writeasmsymbols;
procedure readusedmacros;
procedure readsourcefiles;
procedure readloadunit;
procedure readlinkcontainer(var p:tlinkcontainer);
procedure readderefdata;
procedure readasmsymbols;
{$IFDEF MACRO_DIFF_HINT}
procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
procedure writeusedmacros;
procedure readusedmacros;
{$ENDIF}
end;
procedure reload_flagged_units;
@ -88,7 +90,7 @@ implementation
uses
verbose,systems,version,
symtable,
symtable, symsym,
scanner,
aasmbase,
parser;
@ -398,25 +400,33 @@ uses
PPU Reading/Writing Helpers
***********************************}
{$IFDEF MACRO_DIFF_HINT}
var
is_initial: Boolean;
procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
begin
if tmacro(p).is_used or tmacro(p).defined_at_startup then
if tmacro(p).is_used or is_initial then
begin
ppufile.putstring(p.name);
ppufile.putbyte(byte(tmacro(p).defined_at_startup));
ppufile.putbyte(byte(is_initial));
ppufile.putbyte(byte(tmacro(p).is_used));
end;
end;
procedure tppumodule.writeusedmacros;
begin
ppufile.do_crc:=false;
tscannerfile(scanner).macros.foreach(@writeusedmacro,nil);
is_initial:= true;
initialmacrosymtable.foreach(@writeusedmacro,nil);
is_initial:= false;
if assigned(globalmacrosymtable) then
globalmacrosymtable.foreach(@writeusedmacro,nil);
localmacrosymtable.foreach(@writeusedmacro,nil);
ppufile.writeentry(ibusedmacros);
ppufile.do_crc:=true;
end;
{$ENDIF}
procedure tppumodule.writesourcefiles;
var
@ -588,41 +598,55 @@ uses
ppufile.writeentry(ibasmsymbols);
end;
{$IFDEF MACRO_DIFF_HINT}
{
Define MACRO_DIFF_HINT for the whole compiler (and ppudump)
to turn this facility on. There is some problems with this,
thats why it is shut off:
At the first compilation, consider a macro which is not initially
defined, but it is used (e g the check that it is undefined is true).
Since it do not exist, there is no macro object where the is_used
flag can be set. Later on when the macro is defined, and the ppu
is opened, the check cannot detect this.
Also, in which macro object should this flag be set ? It cant be set
for macros in the initialmacrosymboltable since this table is shared
between different files.
}
procedure tppumodule.readusedmacros;
var
hs : string;
mac : tmacro;
was_defined_at_startup,
was_initial,
was_used : boolean;
{Reads macros which was defined or used when the module was compiled.
This is done when a ppu file is open, before it possibly is parsed.}
begin
{ only possible when we've a scanner of the current file }
if not assigned(current_scanner) then
exit;
while not ppufile.endofentry do
begin
hs:=ppufile.getstring;
was_defined_at_startup:=boolean(ppufile.getbyte);
was_initial:=boolean(ppufile.getbyte);
was_used:=boolean(ppufile.getbyte);
mac:=tmacro(tscannerfile(current_scanner).macros.search(hs));
mac:=tmacro(initialmacrosymtable.search(hs));
if assigned(mac) then
begin
{$ifndef EXTDEBUG}
{ if we don't have the sources why tell }
if sources_avail then
{$endif ndef EXTDEBUG}
if (not was_defined_at_startup) and
was_used and
mac.defined_at_startup then
if (not was_initial) and was_used then
Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
end
else { not assigned }
if was_defined_at_startup and
if was_initial and
was_used then
Message2(unit_h_cond_set_in_last_compile,hs,mainsource^);
end;
end;
{$ENDIF}
procedure tppumodule.readsourcefiles;
var
@ -854,8 +878,10 @@ uses
end;
ibsourcefiles :
readsourcefiles;
{$IFDEF MACRO_DIFF_HINT}
ibusedmacros :
readusedmacros;
{$ENDIF}
ibloadunit :
readloadunit;
iblinkunitofiles :
@ -962,7 +988,9 @@ uses
ppufile.writeentry(ibmodulename);
writesourcefiles;
{$IFDEF MACRO_DIFF_HINT}
writeusedmacros;
{$ENDIF}
{ write interface uses }
writeusedunit(true);
@ -1000,6 +1028,18 @@ uses
{ write the symtable entries }
tstoredsymtable(globalsymtable).ppuwrite(ppufile);
if assigned(globalmacrosymtable) and (globalmacrosymtable.symindex.count > 0) then
begin
ppufile.putbyte(byte(true));
ppufile.writeentry(ibexportedmacros);
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
end
else
begin
ppufile.putbyte(byte(false));
ppufile.writeentry(ibexportedmacros);
end;
{ everything after this doesn't affect the crc }
ppufile.do_crc:=false;
@ -1095,6 +1135,18 @@ uses
{ write the symtable entries }
tstoredsymtable(globalsymtable).ppuwrite(ppufile);
if assigned(globalmacrosymtable) and (globalmacrosymtable.symindex.count > 0) then
begin
ppufile.putbyte(byte(true));
ppufile.writeentry(ibexportedmacros);
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
end
else
begin
ppufile.putbyte(byte(false));
ppufile.writeentry(ibexportedmacros);
end;
{ save crc }
crc:=ppufile.crc;
interface_crc:=ppufile.interface_crc;
@ -1180,6 +1232,15 @@ uses
internalerror(200208187);
globalsymtable:=tglobalsymtable.create(modulename^);
tstoredsymtable(globalsymtable).ppuload(ppufile);
if ppufile.readentry<>ibexportedmacros then
Message(unit_f_ppu_read_error);
if boolean(ppufile.getbyte) then
begin
globalmacrosymtable:=tmacrosymtable.Create(true);
tstoredsymtable(globalmacrosymtable).ppuload(ppufile)
end;
interface_compiled:=true;
{ read the implementation part, containing
@ -1512,7 +1573,11 @@ uses
end.
{
$Log$
Revision 1.63 2004-10-15 09:14:16 mazen
Revision 1.64 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.63 2004/10/15 09:14:16 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

9
compiler/globals.pas
View File

@ -187,7 +187,6 @@ interface
aktexceptblock : integer; { the exceptblock number of the current block (0 if none) }
{ commandline values }
initdefines : tstringlist;
initglobalswitches : tglobalswitches;
initmoduleswitches : tmoduleswitches;
initlocalswitches : tlocalswitches;
@ -2041,7 +2040,6 @@ end;
procedure DoneGlobals;
begin
initdefines.free;
if assigned(DLLImageBase) then
StringDispose(DLLImageBase);
librarysearchpath.Free;
@ -2168,7 +2166,6 @@ end;
{$endif x86_64}
initinterfacetype:=it_interfacecom;
initdefproccall:=pocall_default;
initdefines:=TStringList.Create;
{ memory sizes, will be overriden by parameter or default for target
in options or init_parser }
@ -2180,7 +2177,11 @@ end;
end.
{
$Log$
Revision 1.159 2005-01-06 13:40:41 florian
Revision 1.160 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.159 2005/01/06 13:40:41 florian
* 1.0.10 starting patch from Peter
Revision 1.158 2005/01/06 09:20:36 karoly

5
compiler/msg/errore.msg
View File

@ -303,6 +303,9 @@ scan_e_error_macro_lacks_value=02065_E_Macro "$1" does not have any value
% Thus the conditional compiling expression cannot be evaluated.
scan_e_wrong_switch_toggle_default=02066_E_Wrong switch toggle, use ON/OFF/DEFAULT or +/-/*
% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch
scan_e_mode_switch_not_allowed=02067_E_Mode switch "$1" not allowed here
% A mode switch has already been encountered, or, in case of option -Mmacpas,
% a mode switch occur after UNIT.
% \end{description}
#
# Parser
@ -2076,8 +2079,6 @@ option_interpreting_firstpass_option=11036_D_interpreting firstpass option "$1"
option_interpreting_file_option=11033_D_interpreting file option "$1"
option_read_config_file=11034_D_Reading config file "$1"
option_found_file=11035_D_found source file name "$1"
option_defining_symbol=11037_D_Defining symbol $1
option_undefining_symbol=11038_D_Undefining symbol $1
% Additional infos about options, displayed
% when you have debug option turned on.
option_code_page_not_available=11039_E_Unknown code page

7
compiler/msgidx.inc
View File

@ -81,6 +81,7 @@ const
scan_e_too_many_pop=02064;
scan_e_error_macro_lacks_value=02065;
scan_e_wrong_switch_toggle_default=02066;
scan_e_mode_switch_not_allowed=02067;
parser_e_syntax_error=03000;
parser_e_dont_nest_interrupt=03004;
parser_w_proc_directive_ignored=03005;
@ -644,16 +645,14 @@ const
option_interpreting_file_option=11033;
option_read_config_file=11034;
option_found_file=11035;
option_defining_symbol=11037;
option_undefining_symbol=11038;
option_code_page_not_available=11039;
option_logo=11023;
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 37959;
MsgTxtSize = 37945;
MsgIdxMax : array[1..20] of longint=(
18,67,213,59,57,46,100,20,35,60,
18,68,213,59,57,46,100,20,35,60,
40,1,1,1,1,1,1,1,1,1
);

535
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

443
compiler/options.pas
View File

@ -33,7 +33,7 @@ type
TOption=class
FirstPass,
NoPressEnter,
DoWriteLogo : boolean;
LogoWritten : boolean;
FileLevel : longint;
QuickInfo : string;
ParaIncludePath,
@ -76,7 +76,8 @@ uses
dos,
{$ENDIF USE_SYSUTILS}
version,
cutils,cmsgs
cutils,cmsgs,
symtable
{$ifdef BrowserLog}
,browlog
{$endif BrowserLog}
@ -100,47 +101,23 @@ var
Defines
****************************************************************************}
procedure def_symbol(const s : string);
begin
if s='' then
exit;
initdefines.insert(upper(s));
Message1(option_defining_symbol,s);
end;
procedure undef_symbol(const s : string);
begin
if s='' then
exit;
InitDefines.Remove(s);
Message1(option_undefining_symbol,s);
end;
function check_symbol(const s:string):boolean;
begin
check_symbol:=(initdefines.find(s)<>nil);
end;
procedure set_default_link_type;
begin
{ win32 and wdosx need smartlinking by default to prevent including too much
dll dependencies }
if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
begin
def_symbol('FPC_LINK_SMART');
undef_symbol('FPC_LINK_STATIC');
undef_symbol('FPC_LINK_DYNAMIC');
def_system_macro('FPC_LINK_SMART');
undef_system_macro('FPC_LINK_STATIC');
undef_system_macro('FPC_LINK_DYNAMIC');
initglobalswitches:=initglobalswitches+[cs_link_smart];
initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static];
end
else
begin
undef_symbol('FPC_LINK_SMART');
def_symbol('FPC_LINK_STATIC');
undef_symbol('FPC_LINK_DYNAMIC');
undef_system_macro('FPC_LINK_SMART');
def_system_macro('FPC_LINK_STATIC');
undef_system_macro('FPC_LINK_DYNAMIC');
initglobalswitches:=initglobalswitches+[cs_link_static];
initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
end;
@ -168,9 +145,13 @@ procedure Toption.WriteLogo;
var
p : pchar;
begin
p:=MessagePchar(option_logo);
while assigned(p) do
Comment(V_Normal,GetMsgLine(p));
if not LogoWritten then
begin
p:=MessagePchar(option_logo);
while assigned(p) do
Comment(V_Normal,GetMsgLine(p));
LogoWritten:= true;
end;
end;
@ -384,9 +365,9 @@ begin
if opt='' then
exit;
{ only parse define,undef,target,verbosity and link options the firsttime }
{ only parse define,undef,target,verbosity,link etc options the firsttime }
if firstpass and
not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X'])) then
not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X','l'])) then
exit;
Message1(option_handling_option,opt);
@ -587,7 +568,8 @@ begin
end;
'd' :
def_symbol(more);
if more <> '' then
def_system_macro(more);
'D' :
begin
@ -834,7 +816,8 @@ begin
end;
'l' :
DoWriteLogo:=not UnSetBool(more,0);
if not UnSetBool(more,0) then
WriteLogo;
'm' :
parapreprocess:=not UnSetBool(more,0);
@ -874,7 +857,7 @@ begin
if UnsetBool(More, 0) then
begin
initmoduleswitches:=initmoduleswitches-[cs_profile];
undef_symbol('FPC_PROFILE');
undef_system_macro('FPC_PROFILE');
end
else
if Length(More)=0 then
@ -884,12 +867,12 @@ begin
'g' : if UnsetBool(more, 1) then
begin
exclude(initmoduleswitches,cs_profile);
undef_symbol('FPC_PROFILE');
undef_system_macro('FPC_PROFILE');
end
else
begin
include(initmoduleswitches,cs_profile);
def_symbol('FPC_PROFILE');
def_system_macro('FPC_PROFILE');
end;
else
IllegalPara(opt);
@ -1008,8 +991,8 @@ begin
end;
'u' :
undef_symbol(upper(More));
if more <> '' then
undef_system_macro(more);
'U' :
begin
j:=1;
@ -1148,9 +1131,9 @@ begin
include(initglobalswitches,cs_link_staticflag);
'D' :
begin
def_symbol('FPC_LINK_DYNAMIC');
undef_symbol('FPC_LINK_SMART');
undef_symbol('FPC_LINK_STATIC');
def_system_macro('FPC_LINK_DYNAMIC');
undef_system_macro('FPC_LINK_SMART');
undef_system_macro('FPC_LINK_STATIC');
exclude(initglobalswitches,cs_link_static);
exclude(initglobalswitches,cs_link_smart);
include(initglobalswitches,cs_link_shared);
@ -1167,9 +1150,9 @@ begin
end;
'S' :
begin
def_symbol('FPC_LINK_STATIC');
undef_symbol('FPC_LINK_SMART');
undef_symbol('FPC_LINK_DYNAMIC');
def_system_macro('FPC_LINK_STATIC');
undef_system_macro('FPC_LINK_SMART');
undef_system_macro('FPC_LINK_DYNAMIC');
include(initglobalswitches,cs_link_static);
exclude(initglobalswitches,cs_link_smart);
exclude(initglobalswitches,cs_link_shared);
@ -1177,9 +1160,9 @@ begin
end;
'X' :
begin
def_symbol('FPC_LINK_SMART');
undef_symbol('FPC_LINK_STATIC');
undef_symbol('FPC_LINK_DYNAMIC');
def_system_macro('FPC_LINK_SMART');
undef_system_macro('FPC_LINK_STATIC');
undef_system_macro('FPC_LINK_DYNAMIC');
exclude(initglobalswitches,cs_link_static);
include(initglobalswitches,cs_link_smart);
exclude(initglobalswitches,cs_link_shared);
@ -1253,7 +1236,7 @@ const
maxlevel=16;
var
f : text;
s,
s, tmp,
opts : string;
skip : array[0..maxlevel-1] of boolean;
level : longint;
@ -1294,7 +1277,7 @@ begin
RemoveSep(opts);
s:=upper(GetName(opts));
if level=0 then
skip[level]:=not (check_symbol(s) or (s='COMMON'));
skip[level]:=not (assigned(search_macro(s)) or (s='COMMON'));
end
else
if (s='IFDEF') then
@ -1306,7 +1289,7 @@ begin
stopOptions(1);
end;
inc(Level);
skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
skip[level]:=(skip[level-1] or not assigned(search_macro(upper(GetName(opts)))));
end
else
if (s='IFNDEF') then
@ -1318,7 +1301,7 @@ begin
stopOptions(1);
end;
inc(Level);
skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
skip[level]:=(skip[level-1] or assigned(search_macro(upper(GetName(opts)))));
end
else
if (s='ELSE') then
@ -1340,13 +1323,17 @@ begin
if (s='DEFINE') then
begin
RemoveSep(opts);
def_symbol(upper(GetName(opts)));
tmp:= GetName(opts);
if tmp <> '' then
def_system_macro(tmp);
end
else
if (s='UNDEF') then
begin
RemoveSep(opts);
undef_symbol(upper(GetName(opts)));
tmp:= GetName(opts);
if tmp <> '' then
undef_system_macro(tmp);
end
else
if (s='WRITE') then
@ -1587,9 +1574,9 @@ var
i : integer;
begin
if def then
def_symbol(upper(target_info.shortname))
def_system_macro(target_info.shortname)
else
undef_symbol(upper(target_info.shortname));
undef_system_macro(target_info.shortname);
s:=target_info.extradefines;
while (s<>'') do
begin
@ -1597,9 +1584,9 @@ begin
if i=0 then
i:=length(s)+1;
if def then
def_symbol(Copy(s,1,i-1))
def_system_macro(Copy(s,1,i-1))
else
undef_symbol(Copy(s,1,i-1));
undef_system_macro(Copy(s,1,i-1));
delete(s,1,i);
end;
end;
@ -1607,7 +1594,7 @@ end;
constructor TOption.create;
begin
DoWriteLogo:=false;
LogoWritten:=false;
NoPressEnter:=false;
FirstPass:=false;
FileLevel:=0;
@ -1697,145 +1684,6 @@ begin
option:=coption.create;
disable_configfile:=false;
{ default defines }
def_symbol(upper(target_info.shortname));
def_symbol('FPC');
def_symbol('VER'+version_nr);
def_symbol('VER'+version_nr+'_'+release_nr);
def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
{ Temporary defines, until things settle down }
def_symbol('HASWIDECHAR');
def_symbol('HASWIDESTRING');
def_symbol('HASOUT');
def_symbol('HASGLOBALPROPERTY');
def_symbol('FPC_HASPREFETCH');
def_symbol('FPC_LINEEND_IN_TEXTREC');
def_symbol('FPC_ALIGNSRTTI');
{$ifdef i386}
def_symbol('HASINTF');
def_symbol('HASVARIANT');
{$endif i386}
{$ifdef x86_64}
def_symbol('HASINTF');
def_symbol('HASVARIANT');
{$endif x86_64}
{$ifdef powerpc}
def_symbol('HASINTF');
def_symbol('HASVARIANT');
def_symbol('FPC_MTFSB0_CORRECTED');
{$endif powerpc}
{$ifdef arm}
def_symbol('HASINTF');
def_symbol('HASVARIANT');
{$endif arm}
{$ifdef sparc}
def_symbol('HASINTF');
def_symbol('HASVARIANT');
{$endif sparc}
def_symbol('INTERNSETLENGTH');
def_symbol('INTERNLENGTH');
def_symbol('INTERNCOPY');
def_symbol('INT64FUNCRESOK');
def_symbol('HAS_ADDR_STACK_ON_STACK');
def_symbol('NOBOUNDCHECK');
def_symbol('HASCOMPILERPROC');
def_symbol('INTERNCONSTINTF');
def_symbol('VALUEGETMEM');
def_symbol('VALUEFREEMEM');
def_symbol('HASCURRENCY');
def_symbol('HASTHREADVAR');
def_symbol('HAS_GENERICCONSTRUCTOR');
def_symbol('NOCLASSHELPERS');
if pocall_default = pocall_register then
def_symbol('REGCALL');
def_symbol('DECRREFNOTNIL');
def_symbol('HAS_INTERNAL_INTTYPES');
def_symbol('STR_USES_VALINT');
def_symbol('NOSAVEREGISTERS');
def_symbol('SHORTSTRCOMPAREINREG');
def_symbol('HASGETHEAPSTATUS');
{ using a case is pretty useless here (FK) }
{ some stuff for TP compatibility }
{$ifdef i386}
def_symbol('CPU86');
def_symbol('CPU87');
{$endif}
{$ifdef m68k}
def_symbol('CPU68');
{$endif}
{ new processor stuff }
{$ifdef i386}
def_symbol('CPUI386');
def_symbol('CPU32');
def_symbol('FPC_HAS_TYPE_EXTENDED');
def_symbol('FPC_HAS_TYPE_DOUBLE');
def_symbol('FPC_HAS_TYPE_SINGLE');
{$endif}
{$ifdef m68k}
def_symbol('CPU68K');
def_symbol('CPUM68K');
def_symbol('CPU32');
def_symbol('FPC_CURRENCY_IS_INT64');
def_symbol('FPC_COMP_IS_INT64');
{$endif}
{$ifdef ALPHA}
def_symbol('CPUALPHA');
def_symbol('CPU64');
{$endif}
{$ifdef powerpc}
def_symbol('CPUPOWERPC');
def_symbol('CPUPOWERPC32');
def_symbol('CPU32');
def_symbol('FPC_HAS_TYPE_DOUBLE');
def_symbol('FPC_HAS_TYPE_SINGLE');
def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_symbol('FPC_CURRENCY_IS_INT64');
def_symbol('FPC_COMP_IS_INT64');
{$endif}
{$ifdef iA64}
def_symbol('CPUIA64');
def_symbol('CPU64');
{$endif}
{$ifdef x86_64}
def_symbol('CPUX86_64');
def_symbol('CPUAMD64');
def_symbol('CPU64');
{ not supported for now, afaik (FK)
def_symbol('FPC_HAS_TYPE_FLOAT128'); }
def_symbol('FPC_HAS_TYPE_EXTENDED');
def_symbol('FPC_HAS_TYPE_DOUBLE');
def_symbol('FPC_HAS_TYPE_SINGLE');
{$endif}
{$ifdef sparc}
def_symbol('CPUSPARC');
def_symbol('CPUSPARC32');
def_symbol('CPU32');
def_symbol('FPC_HAS_TYPE_DOUBLE');
def_symbol('FPC_HAS_TYPE_SINGLE');
def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_symbol('FPC_CURRENCY_IS_INT64');
def_symbol('FPC_COMP_IS_INT64');
def_symbol('FPC_REQUIRES_PROPER_ALIGNMENT');
{$endif}
{$ifdef vis}
def_symbol('CPUVIS');
def_symbol('CPU32');
{$endif}
{$ifdef arm}
def_symbol('CPUARM');
def_symbol('FPUFPA');
def_symbol('CPU32');
def_symbol('FPC_HAS_TYPE_DOUBLE');
def_symbol('FPC_HAS_TYPE_SINGLE');
def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_symbol('FPC_CURRENCY_IS_INT64');
def_symbol('FPC_COMP_IS_INT64');
def_symbol('FPC_REQUIRES_PROPER_ALIGNMENT');
{$endif arm}
{ get default messagefile }
{$IFDEF USE_SYSUTILS}
msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');
@ -1843,31 +1691,170 @@ begin
msgfilename:=dos.getenv('PPC_ERROR_FILE');
{$ENDIF USE_SYSUTILS}
{ default configfile can be specified on the commandline,
remove it first }
if (cmd<>'') and (cmd[1]='[') then
{ default configfile can be specified on the commandline,
remove it first }
if (cmd<>'') and (cmd[1]='[') then
begin
ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
Delete(cmd,1,pos(']',cmd));
end
else
else
begin
ppccfg:='fpc.cfg';
ppcaltcfg:='ppc386.cfg';
end;
{ read the parameters quick, only -i -v -T }
option.firstpass:=true;
if cmd<>'' then
option.parsecmd(cmd)
else
{ first pass reading of parameters, only -i -v -T etc.}
option.firstpass:=true;
if cmd<>'' then
option.parsecmd(cmd)
else
begin
option.read_parameters;
{ Write only quickinfo }
if option.quickinfo<>'' then
option.writequickinfo;
option.writequickinfo;
end;
option.firstpass:=false;
option.firstpass:=false;
{ default defines }
def_system_macro(target_info.shortname);
def_system_macro('FPC');
def_system_macro('VER'+version_nr);
def_system_macro('VER'+version_nr+'_'+release_nr);
def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
{ Temporary defines, until things settle down }
def_system_macro('HASWIDECHAR');
def_system_macro('HASWIDESTRING');
def_system_macro('HASOUT');
def_system_macro('HASGLOBALPROPERTY');
def_system_macro('FPC_HASPREFETCH');
def_system_macro('FPC_LINEEND_IN_TEXTREC');
def_system_macro('FPC_ALIGNSRTTI');
{$ifdef i386}
def_system_macro('HASINTF');
def_system_macro('HASVARIANT');
{$endif i386}
{$ifdef x86_64}
def_system_macro('HASINTF');
def_system_macro('HASVARIANT');
{$endif x86_64}
{$ifdef powerpc}
def_system_macro('HASINTF');
def_system_macro('HASVARIANT');
def_system_macro('FPC_MTFSB0_CORRECTED');
{$endif powerpc}
{$ifdef arm}
def_system_macro('HASINTF');
def_system_macro('HASVARIANT');
{$endif arm}
{$ifdef sparc}
def_system_macro('HASINTF');
def_system_macro('HASVARIANT');
{$endif sparc}
def_system_macro('INTERNSETLENGTH');
def_system_macro('INTERNLENGTH');
def_system_macro('INTERNCOPY');
def_system_macro('INT64FUNCRESOK');
def_system_macro('HAS_ADDR_STACK_ON_STACK');
def_system_macro('NOBOUNDCHECK');
def_system_macro('HASCOMPILERPROC');
def_system_macro('INTERNCONSTINTF');
def_system_macro('VALUEGETMEM');
def_system_macro('VALUEFREEMEM');
def_system_macro('HASCURRENCY');
def_system_macro('HASTHREADVAR');
def_system_macro('HAS_GENERICCONSTRUCTOR');
def_system_macro('NOCLASSHELPERS');
if pocall_default = pocall_register then
def_system_macro('REGCALL');
def_system_macro('DECRREFNOTNIL');
def_system_macro('HAS_INTERNAL_INTTYPES');
def_system_macro('STR_USES_VALINT');
def_system_macro('NOSAVEREGISTERS');
def_system_macro('SHORTSTRCOMPAREINREG');
def_system_macro('HASGETHEAPSTATUS');
{ using a case is pretty useless here (FK) }
{ some stuff for TP compatibility }
{$ifdef i386}
def_system_macro('CPU86');
def_system_macro('CPU87');
{$endif}
{$ifdef m68k}
def_system_macro('CPU68');
{$endif}
{ new processor stuff }
{$ifdef i386}
def_system_macro('CPUI386');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_EXTENDED');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
{$endif}
{$ifdef m68k}
def_system_macro('CPU68K');
def_system_macro('CPUM68K');
def_system_macro('CPU32');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif}
{$ifdef ALPHA}
def_system_macro('CPUALPHA');
def_system_macro('CPU64');
{$endif}
{$ifdef powerpc}
def_system_macro('CPUPOWERPC');
def_system_macro('CPUPOWERPC32');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif}
{$ifdef iA64}
def_system_macro('CPUIA64');
def_system_macro('CPU64');
{$endif}
{$ifdef x86_64}
def_system_macro('CPUX86_64');
def_system_macro('CPUAMD64');
def_system_macro('CPU64');
{ not supported for now, afaik (FK)
def_system_macro('FPC_HAS_TYPE_FLOAT128'); }
def_system_macro('FPC_HAS_TYPE_EXTENDED');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
{$endif}
{$ifdef sparc}
def_system_macro('CPUSPARC');
def_system_macro('CPUSPARC32');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
{$endif}
{$ifdef vis}
def_system_macro('CPUVIS');
def_system_macro('CPU32');
{$endif}
{$ifdef arm}
def_system_macro('CPUARM');
def_system_macro('FPUFPA');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
{$endif arm}
{ read configuration file }
if (not disable_configfile) and
@ -1917,33 +1904,29 @@ begin
case target_info.endian of
endian_little :
begin
def_symbol('ENDIAN_LITTLE');
def_symbol('FPC_LITTLE_ENDIAN');
def_system_macro('ENDIAN_LITTLE');
def_system_macro('FPC_LITTLE_ENDIAN');
end;
endian_big :
begin
def_symbol('ENDIAN_BIG');
def_symbol('FPC_BIG_ENDIAN');
def_system_macro('ENDIAN_BIG');
def_system_macro('FPC_BIG_ENDIAN');
end;
end;
{ abi define }
case target_info.abi of
abi_powerpc_sysv :
def_symbol('FPC_ABI_SYSV');
def_system_macro('FPC_ABI_SYSV');
abi_powerpc_aix :
def_symbol('FPC_ABI_AIX');
def_system_macro('FPC_ABI_AIX');
end;
{$ifdef m68k}
if initoptprocessor=MC68020 then
def_symbol('CPUM68020');
def_system_macro('CPUM68020');
{$endif m68k}
{ write logo if set }
if option.DoWriteLogo then
option.WriteLogo;
{ Check file to compile }
if param_file='' then
begin
@ -2089,6 +2072,10 @@ begin
end;
UpdateAlignment(initalignment,option.paraalignment);
set_system_macro('FPC_VERSION',version_nr);
set_system_macro('FPC_RELEASE',release_nr);
set_system_macro('FPC_PATCH',patch_nr);
option.free;
Option:=nil;
end;
@ -2102,7 +2089,11 @@ finalization
end.
{
$Log$
Revision 1.160 2005-01-08 23:14:50 peter
Revision 1.161 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.160 2005/01/08 23:14:50 peter
* Allow #include ~/.fpc.cfg
Revision 1.159 2005/01/04 16:19:52 florian

49
compiler/parser.pas
View File

@ -160,22 +160,6 @@ implementation
end;
procedure default_macros;
var
hp : tstringlistitem;
begin
{ commandline }
hp:=tstringlistitem(initdefines.first);
while assigned(hp) do
begin
current_scanner.def_macro(hp.str);
hp:=tstringlistitem(hp.next);
end;
{ set macros for version checking }
current_scanner.set_macro('FPC_VERSION',version_nr);
current_scanner.set_macro('FPC_RELEASE',release_nr);
current_scanner.set_macro('FPC_PATCH',patch_nr);
end;
{$ifdef PREPROCWRITE}
@ -184,11 +168,15 @@ implementation
i : longint;
begin
new(preprocfile,init('pre'));
{ default macros }
current_scanner^.macros:=new(pdictionary,init);
default_macros;
{ initialize a module }
current_module:=new(pmodule,init(filename,false));
macrosymtablestack:= initialmacrosymtable;
current_module.localmacrosymtable:= tmacrosymtable.create(false);
current_module.localmacrosymtable.next:= initialmacrosymtable;
macrosymtablestack:= current_module.localmacrosymtable;
ConsolidateMode;
main_module:=current_module;
{ startup scanner, and save in current_module }
current_scanner:=new(pscannerfile,Init(filename));
@ -334,6 +322,8 @@ implementation
oldrefsymtable,
olddefaultsymtablestack,
oldsymtablestack : tsymtable;
olddefaultmacrosymtablestack,
oldmacrosymtablestack : tsymtable;
oldaktprocsym : tprocsym;
{ cg }
oldparse_only : boolean;
@ -395,7 +385,9 @@ implementation
old_compiled_module:=compiled_module;
{ save symtable state }
oldsymtablestack:=symtablestack;
oldmacrosymtablestack:=macrosymtablestack;
olddefaultsymtablestack:=defaultsymtablestack;
olddefaultmacrosymtablestack:=defaultmacrosymtablestack;
oldrefsymtable:=refsymtable;
oldcurrent_procinfo:=current_procinfo;
oldaktdefproccall:=aktdefproccall;
@ -457,7 +449,9 @@ implementation
{ reset symtable }
symtablestack:=nil;
macrosymtablestack:=nil;
defaultsymtablestack:=nil;
defaultmacrosymtablestack:=nil;
systemunit:=nil;
refsymtable:=nil;
aktdefproccall:=initdefproccall;
@ -506,8 +500,13 @@ implementation
current_scanner:=tscannerfile.Create(filename);
current_scanner.firstfile;
current_module.scanner:=current_scanner;
{ macros }
default_macros;
{ init macros before anything in the file is parsed.}
macrosymtablestack:= initialmacrosymtable;
current_module.localmacrosymtable:= tmacrosymtable.create(false);
current_module.localmacrosymtable.next:= initialmacrosymtable;
macrosymtablestack:= current_module.localmacrosymtable;
{ read the first token }
current_scanner.readtoken;
@ -606,7 +605,9 @@ implementation
{ restore symtable state }
refsymtable:=oldrefsymtable;
symtablestack:=oldsymtablestack;
macrosymtablestack:=oldmacrosymtablestack;
defaultsymtablestack:=olddefaultsymtablestack;
defaultmacrosymtablestack:=olddefaultmacrosymtablestack;
aktdefproccall:=oldaktdefproccall;
current_procinfo:=oldcurrent_procinfo;
aktsourcecodepage:=oldsourcecodepage;
@ -698,7 +699,11 @@ implementation
end.
{
$Log$
Revision 1.68 2004-10-25 15:38:41 peter
Revision 1.69 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.68 2004/10/25 15:38:41 peter
* heap and heapsize removed
* checkpointer fixes

112
compiler/pmodules.pas
View File

@ -381,6 +381,11 @@ implementation
{ add to symtable stack }
tsymtable(hp.globalsymtable).next:=symtablestack;
symtablestack:=hp.globalsymtable;
if (m_mac in aktmodeswitches) and assigned(hp.globalmacrosymtable) then
begin
tsymtable(hp.globalmacrosymtable).next:=macrosymtablestack;
macrosymtablestack:=hp.globalmacrosymtable;
end;
{ insert unitsym }
unitsym:=tunitsym.create(s,hp.globalsymtable);
inc(unitsym.refs);
@ -424,7 +429,8 @@ implementation
exit;
end;
{ insert the system unit, it is allways the first }
Symtablestack:=nil;
symtablestack:=nil;
macrosymtablestack:=initialmacrosymtable;
AddUnit('System');
SystemUnit:=TGlobalSymtable(Symtablestack);
{ read default constant definitions }
@ -468,6 +474,7 @@ implementation
end;
{ save default symtablestack }
defaultsymtablestack:=symtablestack;
defaultmacrosymtablestack:=macrosymtablestack;
end;
@ -479,6 +486,8 @@ implementation
hp2 : tmodule;
hp3 : tsymtable;
unitsym : tunitsym;
top_of_macrosymtable : tsymtable;
begin
consume(_USES);
{$ifdef DEBUG}
@ -536,9 +545,9 @@ implementation
else
break;
until false;
consume(_SEMICOLON);
{ Load the units }
top_of_macrosymtable:= macrosymtablestack;
pu:=tused_unit(current_module.used_units.first);
while assigned(pu) do
begin
@ -571,6 +580,7 @@ implementation
then insert the units in the symtablestack }
pu:=tused_unit(current_module.used_units.first);
symtablestack:=defaultsymtablestack;
macrosymtablestack:=defaultmacrosymtablestack;
while assigned(pu) do
begin
if pu.in_uses then
@ -588,6 +598,11 @@ implementation
begin
tsymtable(pu.u.globalsymtable).next:=symtablestack;
symtablestack:=tsymtable(pu.u.globalsymtable);
if (m_mac in aktmodeswitches) and assigned(pu.u.globalmacrosymtable) then
begin
tsymtable(pu.u.globalmacrosymtable).next:=macrosymtablestack;
macrosymtablestack:=tsymtable(pu.u.globalmacrosymtable);
end;
{$ifdef DEBUG}
test_symtablestack;
{$endif DEBUG}
@ -596,6 +611,13 @@ implementation
end;
pu:=tused_unit(pu.next);
end;
if assigned (current_module.globalmacrosymtable) then
top_of_macrosymtable.next.next:= macrosymtablestack
else
top_of_macrosymtable.next:= macrosymtablestack;
macrosymtablestack:= top_of_macrosymtable;
consume(_SEMICOLON);
end;
@ -771,22 +793,6 @@ implementation
if (cs_local_browser in aktmoduleswitches) and
not(cs_browser in aktmoduleswitches) then
exclude(aktmoduleswitches,cs_local_browser);
{ define a symbol in delphi,objfpc,tp,gpc mode }
if (m_delphi in aktmodeswitches) then
current_scanner.def_macro('FPC_DELPHI')
else
if (m_tp7 in aktmodeswitches) then
current_scanner.def_macro('FPC_TP')
else
if (m_objfpc in aktmodeswitches) then
current_scanner.def_macro('FPC_OBJFPC')
else
if (m_gpc in aktmodeswitches) then
current_scanner.def_macro('FPC_GPC')
else
if (m_mac in aktmodeswitches) then
current_scanner.def_macro('FPC_MACPAS');
end;
@ -880,7 +886,15 @@ implementation
release_main_proc(pd);
end;
procedure delete_duplicate_macros(p:TNamedIndexItem; arg:pointer);
var
hp: tsymentry;
begin
hp:= current_module.localmacrosymtable.search(p.name);
if assigned(hp) then
current_module.localmacrosymtable.delete(hp);
end;
procedure proc_unit;
function is_assembler_generated:boolean;
@ -907,6 +921,12 @@ implementation
unitname8 : string[8];
has_impl: boolean;
begin
if m_mac in aktmodeswitches then
begin
ConsolidateMode;
current_module.mode_switch_allowed:= false;
end;
consume(_UNIT);
if compile_level=1 then
Status.IsExe:=false;
@ -956,6 +976,7 @@ implementation
current_module.in_global:=false;
{ handle the global switches }
ConsolidateMode;
setupglobalswitches;
message1(unit_u_loading_interface_units,current_module.modulename^);
@ -986,9 +1007,20 @@ implementation
{ with the same name as the unit }
refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
macrosymtablestack:= initialmacrosymtable;
{ load default units, like the system unit }
loaddefaultunits;
current_module.localmacrosymtable.next:=macrosymtablestack;
if assigned(current_module.globalmacrosymtable) then
begin
current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
macrosymtablestack:=current_module.globalmacrosymtable;
end
else
macrosymtablestack:=current_module.localmacrosymtable;
{ reset }
make_ref:=true;
@ -1054,13 +1086,7 @@ implementation
if (m_mac in aktmodeswitches) and try_to_consume(_END) then
has_impl:= false
else
begin
consume(_IMPLEMENTATION);
has_impl:= true;
end;
if has_impl then
Message1(unit_u_loading_implementation_units,current_module.modulename^);
has_impl:= true;
parse_only:=false;
@ -1068,16 +1094,30 @@ implementation
st:=tstaticsymtable.create(current_module.modulename^);
current_module.localsymtable:=st;
{ Swap the positions of the local and global macro sym table}
if assigned(current_module.globalmacrosymtable) then
begin
macrosymtablestack:=current_module.localmacrosymtable;
current_module.globalmacrosymtable.next:= current_module.localmacrosymtable.next;
current_module.localmacrosymtable.next:=current_module.globalmacrosymtable;
current_module.globalmacrosymtable.foreach_static(@delete_duplicate_macros, nil);
end;
{ remove the globalsymtable from the symtable stack }
{ to reinsert it after loading the implementation units }
symtablestack:=unitst.next;
{ we don't want implementation units symbols in unitsymtable !! PM }
refsymtable:=st;
{ Read the implementation units }
if has_impl then
parse_implementation_uses;
begin
consume(_IMPLEMENTATION);
Message1(unit_u_loading_implementation_units,current_module.modulename^);
{ Read the implementation units }
parse_implementation_uses;
end;
if current_module.state=ms_compiled then
exit;
@ -1340,7 +1380,8 @@ implementation
{ global switches are read, so further changes aren't allowed }
current_module.in_global:=false;
{ setup things using the global switches }
{ setup things using the switches }
ConsolidateMode;
setupglobalswitches;
{ set implementation flag }
@ -1353,9 +1394,14 @@ implementation
current_module.localsymtable:=st;
refsymtable:=st;
macrosymtablestack:= nil;
{ load standard units (system,objpas,profile unit) }
loaddefaultunits;
current_module.localmacrosymtable.next:=macrosymtablestack;
macrosymtablestack:=current_module.localmacrosymtable;
{Load the units used by the program we compile.}
if token=_USES then
loadunits;
@ -1554,7 +1600,11 @@ implementation
end.
{
$Log$
Revision 1.178 2004-12-06 19:23:05 peter
Revision 1.179 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.178 2004/12/06 19:23:05 peter
implicit load of variants unit
Revision 1.177 2004/11/29 18:50:15 peter

12
compiler/ppu.pas
View File

@ -44,7 +44,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=46;
CurrentPPUVersion=47;
{ buffer sizes }
maxentrysize = 1024;
@ -79,8 +79,11 @@ const
ibdefref = 13;
ibendsymtablebrowser = 14;
ibbeginsymtablebrowser = 15;
{$IFDEF MACRO_DIFF_HINT}
ibusedmacros = 16;
{$ENDIF}
ibderefdata = 17;
ibexportedmacros = 18;
{syms}
ibtypesym = 20;
ibprocsym = 21;
@ -97,6 +100,7 @@ const
ibrttisym = 32;
iblocalvarsym = 33;
ibparavarsym = 34;
ibmacrosym = 35;
{definitions}
iborddef = 40;
ibpointerdef = 41;
@ -1055,7 +1059,11 @@ end;
end.
{
$Log$
Revision 1.60 2004-12-06 19:23:05 peter
Revision 1.61 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.60 2004/12/06 19:23:05 peter
implicit load of variants unit
Revision 1.59 2004/11/15 23:35:31 peter

62
compiler/scandir.pas
View File

@ -37,6 +37,7 @@ implementation
verbose,comphook,
scanner,switches,
fmodule,
symtable,
rabase;
const
@ -617,17 +618,24 @@ implementation
procedure dir_mode;
begin
if not current_module.in_global then
Message(scan_w_switch_is_global)
else
begin
current_scanner.skipspace;
current_scanner.readstring;
if not SetCompileMode(pattern,false) then
Message1(scan_w_illegal_switch,pattern);
end;
end;
begin
if not current_module.in_global then
Message(scan_w_switch_is_global)
else
begin
current_scanner.skipspace;
current_scanner.readstring;
if not current_module.mode_switch_allowed and
not ((m_mac in aktmodeswitches) and (pattern='MACPAS')) then
Message1(scan_e_mode_switch_not_allowed,pattern)
else if SetCompileMode(pattern,false) then
ConsolidateMode
else
Message1(scan_w_illegal_switch,pattern)
end;
current_module.mode_switch_allowed:= false;
end;
procedure dir_mmx;
begin
@ -779,18 +787,13 @@ implementation
end;
procedure dir_profile;
var
mac : tmacro;
begin
do_moduleswitch(cs_profile);
{ defined/undefine FPC_PROFILE }
mac:=tmacro(current_scanner.macros.search('FPC_PROFILE'));
if not assigned(mac) then
begin
mac:=tmacro.create('FPC_PROFILE');
current_scanner.macros.insert(mac);
end;
mac.defined:=(cs_profile in aktmoduleswitches);
if cs_profile in aktmoduleswitches then
def_system_macro('FPC_PROFILE')
else
undef_system_macro('FPC_PROFILE');
end;
procedure dir_push;
@ -895,18 +898,13 @@ implementation
{$endif}
procedure dir_threading;
var
mac : tmacro;
begin
do_moduleswitch(cs_threading);
{ defined/undefine FPC_THREADING }
mac:=tmacro(current_scanner.macros.search('FPC_THREADING'));
if not assigned(mac) then
begin
mac:=tmacro.create('FPC_THREADING');
current_scanner.macros.insert(mac);
end;
mac.defined:=(cs_threading in aktmoduleswitches);
if cs_threading in aktmoduleswitches then
def_system_macro('FPC_THREADING')
else
undef_system_macro('FPC_THREADING');
end;
procedure dir_typedaddress;
@ -1170,7 +1168,11 @@ begin
end.
{
$Log$
Revision 1.50 2005-01-06 02:13:03 karoly
Revision 1.51 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.50 2005/01/06 02:13:03 karoly
* more SysV call support stuff for MorphOS
Revision 1.49 2005/01/04 17:40:33 karoly

165
compiler/scanner.pas
View File

@ -36,30 +36,14 @@ interface
const
max_include_nesting=32;
max_macro_nesting=16;
maxmacrolen=16*1024;
preprocbufsize=32*1024;
type
tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
pmacrobuffer = ^tmacrobuffer;
tmacrobuffer = array[0..maxmacrolen-1] of char;
tscannerfile = class;
tmacro = class(TNamedIndexItem)
defined : boolean; { normally true, but false when the macro is undef-ed}
defined_at_startup : boolean;
is_used : boolean;
is_compiler_var : boolean; { if this is a mac style compiler variable, in
which case no macro substitutions shall be done.}
buftext : pchar;
buflen : longint;
fileinfo : tfileposinfo;
constructor Create(const n : string);
destructor destroy;override;
end;
preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else,pp_elseif);
tpreprocstack = class
@ -103,7 +87,6 @@ interface
lastasmgetchar : char;
ignoredirectives : tstringlist; { ignore directives, used to give warnings only once }
preprocstack : tpreprocstack;
macros : Tdictionary;
in_asm_string : boolean;
preproc_pattern : string;
@ -124,8 +107,6 @@ interface
procedure reload;
procedure insertmacro(const macname:string;p:pchar;len,line,fileindex:longint);
{ Scanner things }
procedure def_macro(const s : string);
procedure set_macro(const s : string;value : string);
procedure gettokenpos;
procedure inc_comment_level;
procedure dec_comment_level;
@ -200,6 +181,8 @@ interface
procedure InitScanner;
procedure DoneScanner;
{To be called when the language mode is finally determined}
procedure ConsolidateMode;
implementation
@ -251,6 +234,33 @@ implementation
end;
{To be called when the language mode is finally determined}
procedure ConsolidateMode;
begin
if m_mac in aktmodeswitches then
if current_module.is_unit and not assigned(current_module.globalmacrosymtable) then
begin
current_module.globalmacrosymtable:= tmacrosymtable.create(true);
current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
macrosymtablestack:=current_module.globalmacrosymtable;
end;
{ define a symbol in delphi,objfpc,tp,gpc,macpas mode }
if (m_delphi in aktmodeswitches) then
def_system_macro('FPC_DELPHI')
else if (m_tp7 in aktmodeswitches) then
def_system_macro('FPC_TP')
else if (m_objfpc in aktmodeswitches) then
def_system_macro('FPC_OBJFPC')
else if (m_gpc in aktmodeswitches) then
def_system_macro('FPC_GPC')
else if (m_mac in aktmodeswitches) then
def_system_macro('FPC_MACPAS');
end;
{*****************************************************************************
Conditional Directives
*****************************************************************************}
@ -276,7 +286,7 @@ implementation
hs:=current_scanner.readid;
if hs='' then
Message(scan_e_error_in_preproc_expr);
mac:=tmacro(current_scanner.macros.search(hs));
mac:=tmacro(search_macro(hs));
if assigned(mac) then
mac.is_used:=true;
current_scanner.addpreprocstack(pp_ifdef,assigned(mac) and mac.defined,hs,scan_c_ifdef_found);
@ -292,7 +302,7 @@ implementation
hs:=current_scanner.readid;
if hs='' then
Message(scan_e_error_in_preproc_expr);
mac:=tmacro(current_scanner.macros.search(hs));
mac:=tmacro(search_macro(hs));
if assigned(mac) then
mac.is_used:=true;
current_scanner.addpreprocstack(pp_ifndef,not(assigned(mac) and mac.defined),hs,scan_c_ifndef_found);
@ -383,7 +393,7 @@ implementation
For real macros also do recursive substitution. }
macrocount:=0;
repeat
mac:=tmacro(current_scanner.macros.search(result));
mac:=tmacro(search_macro(result));
inc(macrocount);
if macrocount>max_macro_nesting then
@ -405,6 +415,7 @@ implementation
hs[0]:=char(len);
move(mac.buftext^,hs[1],len);
result:=upcase(hs);
mac.is_used:=true;
end
else
begin
@ -445,9 +456,12 @@ implementation
if current_scanner.preproc_token =_ID then
begin
hs := current_scanner.preproc_pattern;
mac := tmacro(current_scanner.macros.search(hs));
mac := tmacro(search_macro(hs));
if assigned(mac) then
hs := '1'
begin
hs := '1';
mac.is_used:=true;
end
else
hs := '0';
read_factor := hs;
@ -469,9 +483,12 @@ implementation
if current_scanner.preproc_token =_ID then
begin
hs := current_scanner.preproc_pattern;
mac := tmacro(current_scanner.macros.search(hs));
mac := tmacro(search_macro(hs));
if assigned(mac) then
hs := '0'
begin
hs := '0';
mac.is_used:=true;
end
else
hs := '1';
read_factor := hs;
@ -757,13 +774,13 @@ implementation
begin
current_scanner.skipspace;
hs:=current_scanner.readid;
mac:=tmacro(current_scanner.macros.search(hs));
if not assigned(mac) then
mac:=tmacro(search_macro(hs));
if not assigned(mac) or (mac.owner <> macrosymtablestack) then
begin
mac:=tmacro.create(hs);
mac.defined:=true;
Message1(parser_c_macro_defined,mac.name);
current_scanner.macros.insert(mac);
macrosymtablestack.insert(mac);
end
else
begin
@ -855,14 +872,14 @@ implementation
begin
current_scanner.skipspace;
hs:=current_scanner.readid;
mac:=tmacro(current_scanner.macros.search(hs));
if not assigned(mac) then
mac:=tmacro(search_macro(hs));
if not assigned(mac) or (mac.owner <> macrosymtablestack) then
begin
mac:=tmacro.create(hs);
mac.defined:=true;
mac.is_compiler_var:=true;
Message1(parser_c_macro_defined,mac.name);
current_scanner.macros.insert(mac);
macrosymtablestack.insert(mac);
end
else
begin
@ -920,13 +937,13 @@ implementation
begin
current_scanner.skipspace;
hs:=current_scanner.readid;
mac:=tmacro(current_scanner.macros.search(hs));
if not assigned(mac) then
mac:=tmacro(search_macro(hs));
if not assigned(mac) or (mac.owner <> macrosymtablestack) then
begin
mac:=tmacro.create(hs);
Message1(parser_c_macro_undefined,mac.name);
mac.defined:=false;
current_scanner.macros.insert(mac);
macrosymtablestack.insert(mac);
end
else
begin
@ -1071,32 +1088,6 @@ implementation
end;
{*****************************************************************************
TMacro
*****************************************************************************}
constructor tmacro.create(const n : string);
begin
inherited createname(n);
defined:=true;
defined_at_startup:=false;
fileinfo:=akttokenpos;
is_used:=false;
is_compiler_var:= false;
buftext:=nil;
buflen:=0;
end;
destructor tmacro.destroy;
begin
if assigned(buftext) then
freemem(buftext,buflen);
inherited destroy;
end;
{*****************************************************************************
Preprocessor writting
*****************************************************************************}
@ -1206,7 +1197,6 @@ implementation
lastasmgetchar:=#0;
ignoredirectives:=TStringList.Create;
in_asm_string:=false;
macros:=tdictionary.create;
end;
@ -1233,48 +1223,6 @@ implementation
if not inputfile.closed then
closeinputfile;
ignoredirectives.free;
macros.free;
end;
procedure tscannerfile.def_macro(const s : string);
var
mac : tmacro;
begin
mac:=tmacro(macros.search(s));
if mac=nil then
begin
mac:=tmacro.create(s);
Message1(parser_c_macro_defined,mac.name);
macros.insert(mac);
end;
mac.defined:=true;
mac.defined_at_startup:=true;
end;
procedure tscannerfile.set_macro(const s : string;value : string);
var
mac : tmacro;
begin
mac:=tmacro(macros.search(s));
if mac=nil then
begin
mac:=tmacro.create(s);
macros.insert(mac);
end
else
begin
mac.is_compiler_var:=false;
if assigned(mac.buftext) then
freemem(mac.buftext,mac.buflen);
end;
Message2(parser_c_macro_set_to,mac.name,value);
mac.buflen:=length(value);
getmem(mac.buftext,mac.buflen);
move(value[1],mac.buftext^,mac.buflen);
mac.defined:=true;
mac.defined_at_startup:=true;
end;
@ -2483,11 +2431,12 @@ implementation
{ this takes some time ... }
if (cs_support_macro in aktmoduleswitches) then
begin
mac:=tmacro(macros.search(pattern));
mac:=tmacro(search_macro(pattern));
if assigned(mac) and (not mac.is_compiler_var) and (assigned(mac.buftext)) then
begin
if yylexcount<max_macro_nesting then
begin
mac.is_used:=true;
inc(yylexcount);
insertmacro(pattern,mac.buftext,mac.buflen,
mac.fileinfo.line,mac.fileinfo.fileindex);
@ -3310,7 +3259,11 @@ exit_label:
end.
{
$Log$
Revision 1.97 2005-01-04 16:34:03 peter
Revision 1.98 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.97 2005/01/04 16:34:03 peter
* give error when reading identifier > 255 chars
Revision 1.96 2004/11/08 22:09:59 peter

20
compiler/symbase.pas
View File

@ -117,6 +117,8 @@ interface
procedure foreach(proc2call : tnamedindexcallback;arg:pointer);
procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
procedure insert(sym : tsymentry);virtual;
{ deletes a tsymentry and removes it from the tsymtable}
procedure delete(sym:tsymentry);
procedure replace(oldsym,newsym:tsymentry);
function search(const s : stringid) : tsymentry;
function speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
@ -136,11 +138,16 @@ interface
defaultsymtablestack : tsymtable; { symtablestack after default units have been loaded }
symtablestack : tsymtable; { linked list of symtables }
defaultmacrosymtablestack : tsymtable;{ macrosymtablestack after default units have been loaded }
macrosymtablestack: tsymtable; { linked list of macro symtables }
aktrecordsymtable : tsymtable; { current record symtable }
aktparasymtable : tsymtable; { current proc para symtable }
aktlocalsymtable : tsymtable; { current proc local symtable }
initialmacrosymtable: tsymtable; { macros initially defined by the compiler or
given on the command line. Is common
for all files compiled and do not change. }
implementation
@ -266,6 +273,13 @@ implementation
symsearch.insert(sym);
end;
procedure tsymtable.delete(sym:tsymentry);
begin
sym.owner:=nil;
{ remove from index and search hash }
symsearch.delete(sym.name);
symindex.delete(sym);
end;
procedure tsymtable.replace(oldsym,newsym:tsymentry);
begin
@ -331,7 +345,11 @@ implementation
end.
{
$Log$
Revision 1.23 2004-10-15 09:14:17 mazen
Revision 1.24 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.23 2004/10/15 09:14:17 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

9
compiler/symconst.pas
View File

@ -334,7 +334,8 @@ type
globalsymtable,staticsymtable,
objectsymtable,recordsymtable,
localsymtable,parasymtable,
withsymtable,stt_exceptsymtable
withsymtable,stt_exceptsymtable,
exportedmacrosymtable, localmacrosymtable
);
@ -439,7 +440,11 @@ initialization
end.
{
$Log$
Revision 1.99 2005-01-06 02:13:03 karoly
Revision 1.100 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.99 2005/01/06 02:13:03 karoly
* more SysV call support stuff for MorphOS
Revision 1.98 2005/01/05 02:31:06 karoly

86
compiler/symsym.pas
View File

@ -340,6 +340,31 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
end;
const
maxmacrolen=16*1024;
type
pmacrobuffer = ^tmacrobuffer;
tmacrobuffer = array[0..maxmacrolen-1] of char;
tmacro = class(tstoredsym)
{Normally true, but false when a previously defined macro is undef-ed}
defined : boolean;
{True if this is a mac style compiler variable, in which case no macro
substitutions shall be done.}
is_compiler_var : boolean;
{Whether the macro was used. NOTE: A use of a macro which was never defined}
{e. g. an IFDEF which returns false, will not be registered as used,}
{since there is no place to register its use. }
is_used : boolean;
buftext : pchar;
buflen : longint;
constructor create(const n : string);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
destructor destroy;override;
end;
{ compiler generated symbol to point to rtti and init/finalize tables }
trttisym = class(tstoredsym)
private
@ -2498,6 +2523,61 @@ implementation
end;
{*****************************************************************************
TMacro
*****************************************************************************}
constructor tmacro.create(const n : string);
begin
inherited create(n);
typ:= macrosym;
owner:= nil;
defined:=false;
is_used:=false;
is_compiler_var:= false;
buftext:=nil;
buflen:=0;
end;
constructor tmacro.ppuload(ppufile:tcompilerppufile);
begin
inherited ppuload(ppufile);
typ:=macrosym;
name:=ppufile.getstring;
defined:=boolean(ppufile.getbyte);
is_compiler_var:=boolean(ppufile.getbyte);
is_used:=false;
buflen:= ppufile.getlongint;
if buflen > 0 then
begin
getmem(buftext, buflen);
ppufile.getdata(buftext^, buflen)
end
else
buftext:=nil;
end;
destructor tmacro.destroy;
begin
if assigned(buftext) then
freemem(buftext,buflen);
inherited destroy;
end;
procedure tmacro.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putstring(name);
ppufile.putbyte(byte(defined));
ppufile.putbyte(byte(is_compiler_var));
ppufile.putlongint(buflen);
if buflen > 0 then
ppufile.putdata(buftext^,buflen);
ppufile.writeentry(ibmacrosym);
end;
{****************************************************************************
TRTTISYM
****************************************************************************}
@ -2569,7 +2649,11 @@ implementation
end.
{
$Log$
Revision 1.198 2005-01-04 16:38:54 peter
Revision 1.199 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.198 2005/01/04 16:38:54 peter
* fix setting minval for enum with specified values
Revision 1.197 2005/01/03 22:27:56 peter

159
compiler/symtable.pas
View File

@ -180,6 +180,11 @@ interface
constructor create;
end;
tmacrosymtable = class(tstoredsymtable)
public
constructor create(exported: boolean);
procedure ppuload(ppufile:tcompilerppufile);override;
end;
var
constsymtable : tsymtable; { symtable were the constants can be inserted }
@ -208,11 +213,22 @@ interface
{$endif notused}
function search_class_member(pd : tobjectdef;const s : string):tsym;
function search_assignment_operator(from_def,to_def:Tdef):Tprocdef;
{Looks for macro s (must be given in upper case) in the macrosymbolstack, }
{and returns it if found. Returns nil otherwise.}
function search_macro(const s : string):tsym;
{*** Object Helpers ***}
procedure search_class_overloads(aprocsym : tprocsym);
function search_default_property(pd : tobjectdef) : tpropertysym;
{*** Macro Helpers ***}
{If called initially, the following procedures manipulate macros in }
{initialmacrotable, otherwise they manipulate system macros local to a module.}
{Name can be given in any case (it will be converted to upper case).}
procedure def_system_macro(const name : string);
procedure set_system_macro(const name, value : string);
procedure undef_system_macro(const name : string);
{*** symtable stack ***}
{$ifdef DEBUG}
procedure test_symtablestack;
@ -374,6 +390,7 @@ implementation
iblabelsym : sym:=tlabelsym.ppuload(ppufile);
ibsyssym : sym:=tsyssym.ppuload(ppufile);
ibrttisym : sym:=trttisym.ppuload(ppufile);
ibmacrosym : sym:=tmacro.ppuload(ppufile);
ibendsyms : break;
ibend : Message(unit_f_ppu_read_error);
else
@ -1699,6 +1716,33 @@ implementation
end;
{****************************************************************************
TMacroSymtable
****************************************************************************}
constructor tmacrosymtable.create(exported: boolean);
begin
inherited create('');
if exported then
symtabletype:=exportedmacrosymtable
else
symtabletype:=localmacrosymtable;
symtablelevel:=main_program_level;
end;
procedure tmacrosymtable.ppuload(ppufile:tcompilerppufile);
begin
next:=macrosymtablestack;
macrosymtablestack:=self;
inherited ppuload(ppufile);
{ restore symtablestack }
macrosymtablestack:=next;
end;
{*****************************************************************************
Helper Routines
*****************************************************************************}
@ -2086,6 +2130,28 @@ implementation
search_class_member:=nil;
end;
function search_macro(const s : string):tsym;
var
p : tsymtable;
speedvalue : cardinal;
srsym : tsym;
begin
speedvalue:= getspeedvalue(s);
p:=macrosymtablestack;
while assigned(p) do
begin
srsym:=tsym(p.speedsearch(s,speedvalue));
if assigned(srsym) then
begin
search_macro:= srsym;
exit;
end;
p:=p.next;
end;
search_macro:= nil;
end;
{*****************************************************************************
Definition Helpers
@ -2197,6 +2263,88 @@ implementation
search_default_property:=_defaultprop;
end;
{****************************************************************************
Macro Helpers
****************************************************************************}
{NOTE: Initially, macrosymtablestack contains initialmacrosymtable.}
procedure def_system_macro(const name : string);
var
mac : tmacro;
s: string;
begin
if name = '' then
internalerror(2004121201);
s:= upper(name);
mac:=tmacro(search_macro(s));
if not assigned(mac) then
begin
mac:=tmacro.create(s);
if macrosymtablestack.symtabletype=localmacrosymtable then
macrosymtablestack.insert(mac)
else
macrosymtablestack.next.insert(mac)
end;
if not mac.defined then
Message1(parser_c_macro_defined,mac.name);
mac.defined:=true;
end;
procedure set_system_macro(const name, value : string);
var
mac : tmacro;
s: string;
begin
if name = '' then
internalerror(2004121201);
s:= upper(name);
mac:=tmacro(search_macro(s));
if not assigned(mac) then
begin
mac:=tmacro.create(s);
if macrosymtablestack.symtabletype=localmacrosymtable then
macrosymtablestack.insert(mac)
else
macrosymtablestack.next.insert(mac)
end
else
begin
mac.is_compiler_var:=false;
if assigned(mac.buftext) then
freemem(mac.buftext,mac.buflen);
end;
Message2(parser_c_macro_set_to,mac.name,value);
mac.buflen:=length(value);
getmem(mac.buftext,mac.buflen);
move(value[1],mac.buftext^,mac.buflen);
mac.defined:=true;
end;
procedure undef_system_macro(const name : string);
var
mac : tmacro;
s: string;
begin
if name = '' then
internalerror(2004121201);
s:= upper(name);
mac:=tmacro(search_macro(s));
if not assigned(mac) then
{If not found, then it's already undefined.}
else
begin
if mac.defined then
Message1(parser_c_macro_undefined,mac.name);
mac.defined:=false;
mac.is_compiler_var:=false;
{ delete old definition }
if assigned(mac.buftext) then
begin
freemem(mac.buftext,mac.buflen);
mac.buftext:=nil;
end;
end;
end;
{$ifdef UNITALIASES}
{****************************************************************************
@ -2290,6 +2438,7 @@ implementation
{ Reset symbolstack }
registerdef:=false;
symtablestack:=nil;
macrosymtablestack:=nil;
systemunit:=nil;
{$ifdef GDB}
globaltypecount:=1;
@ -2302,6 +2451,9 @@ implementation
{ unit aliases }
unitaliases:=tdictionary.create;
{$endif}
initialmacrosymtable:= tmacrosymtable.create(false);
macrosymtablestack:= initialmacrosymtable;
dupnr:=0;
end;
@ -2313,12 +2465,17 @@ implementation
{$ifdef UNITALIASES}
unitaliases.free;
{$endif}
initialmacrosymtable.Free;
end;
end.
{
$Log$
Revision 1.167 2004-12-27 16:35:48 peter
Revision 1.168 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.167 2004/12/27 16:35:48 peter
* set flag if a procedure references a symbol in staticsymtable
Revision 1.166 2004/12/21 08:38:16 michael

64
compiler/utils/ppudump.pp
View File

@ -1250,10 +1250,10 @@ begin
readderef;
writeln(space,' ParaNr : ',getword);
if (vo_has_explicit_paraloc in varoptions) then
begin
i:=getbyte;
getdata(tempbuf,i);
end;
begin
i:=getbyte;
getdata(tempbuf,i);
end;
end;
ibenumsym :
@ -1276,6 +1276,24 @@ begin
writeln(space,' RTTI Type : ',getbyte);
end;
ibmacrosym :
begin
readcommonsym('Macro symbol ');
writeln(space,' Name: ',getstring);
writeln(space,' Defined: ',getbyte);
writeln(space,' Compiler var: ',getbyte);
len:=getlongint;
writeln(space,' Value length: ',len);
if len > 0 then
begin
getmem(pc,len+1);
getdata(pc^,len);
(pc+len)^:= #0;
writeln(space,' Value: "',pc,'"');
freemem(pc,len+1);
end;
end;
ibtypedconstsym :
begin
readcommonsym('Typed constant ');
@ -1703,7 +1721,7 @@ begin
inc(sourcenumber);
end;
end;
{$IFDEF MACRO_DIFF_HINT}
ibusedmacros :
begin
while not EndOfEntry do
@ -1721,7 +1739,7 @@ begin
writeln;
end;
end;
{$ENDIF}
ibloadunit :
ReadLoadUnit;
@ -1944,6 +1962,32 @@ begin
end
else
ppufile.skipuntilentry(ibendsyms);
{read the macro symbols}
if (verbose and v_syms)<>0 then
begin
Writeln;
Writeln('Interface Macro Symbols');
Writeln('-----------------------');
end;
if ppufile.readentry<>ibexportedmacros then
begin
Writeln('!! Error in PPU');
exit;
end;
if boolean(ppufile.getbyte) then
begin
{skip the definition section for macros (since they are never used) }
ppufile.skipuntilentry(ibenddefs);
{read the macro symbols}
if (verbose and v_syms)<>0 then
readsymbols('interface macro')
else
ppufile.skipuntilentry(ibendsyms);
end
else
Writeln('(no exported macros)');
{read the implementation stuff}
if (verbose and v_implementation)<>0 then
begin
@ -2064,7 +2108,7 @@ begin
case upcase(para[2]) of
'V' : begin
verbose:=0;
for i:=3to length(para) do
for i:=3 to length(para) do
case upcase(para[i]) of
'H' : verbose:=verbose or v_header;
'I' : verbose:=verbose or v_interface;
@ -2088,7 +2132,11 @@ begin
end.
{
$Log$
Revision 1.63 2004-11-19 08:33:02 marco
Revision 1.64 2005-01-09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas
Revision 1.63 2004/11/19 08:33:02 marco
* fix for " Split po_public into po_public and po_global"
Revision 1.62 2004/11/19 08:17:02 michael