paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ a lot of delphi switches

Browse Source
This commit is contained in:
peter 1998-09-01 12:52:05 +00:00
parent 0382686875
commit f4799ed92f
2 changed files with 195 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

217
compiler/scandir.inc
View File

@ -26,40 +26,52 @@ type
directivestr=string[directivelen];
tdirectivetoken=(
_DIR_NONE,
_DIR_ALIGN,_DIR_ASMMODE,
_DIR_D,_DIR_DEFINE,_DIR_DESCRIPTION,
_DIR_ELSE,_DIR_ENDIF,_DIR_ERROR,
_DIR_ALIGN,_DIR_ASMMODE,_DIR_ASSERTIONS,
_DIR_BOOLEVAL,
_DIR_D,_DIR_DEBUGINFO,_DIR_DEFINE,_DIR_DESCRIPTION,
_DIR_ELSE,_DIR_ENDIF,_DIR_ERROR,_DIR_EXTENDEDSYNTAX,
_DIR_FATAL,
_DIR_HINT,_DIR_HINTS,
_DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
_DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INFO,
_DIR_L,_DIR_LINKLIB,
_DIR_MESSAGE,_DIR_MMX,
_DIR_NOTE,
_DIR_OUTPUT_FORMAT,
_DIR_PACKRECORDS,
_DIR_SATURATION,_DIR_SMARTLINK,_DIR_STOP,
_DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INCLUDE,_DIR_INFO,
_DIR_L,_DIR_LINK,_DIR_LINKLIB,_DIR_LOCALSYMBOLS,_DIR_LONGSTRINGS,
_DIR_M,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,
_DIR_NOTE,_DIR_NOTES,
_DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
_DIR_PACKENUM,_DIR_PACKRECORDS,
_DIR_RANGECHECKS,_DIR_REFERENCEINFO,
_DIR_SATURATION,_DIR_SMARTLINK,_DIR_STACKFRAMES,_DIR_STOP,
_DIR_TYPEDADDRESS,_DIR_TYPEINFO,
_DIR_UNDEF,
_DIR_WAIT,_DIR_WARNING
_DIR_VARSTRINGCHECKS,
_DIR_WAIT,_DIR_WARNING,_DIR_WARNINGS,
_DIR_Z1,_DIR_Z2,_DIR_Z4
);
const
firstdirective=_DIR_NONE;
lastdirective=_DIR_WARNING;
lastdirective=_DIR_Z4;
directive:array[tdirectivetoken] of directivestr=(
'',
'ALIGN','ASMMODE',
'D','DEFINE','DESCRIPTION',
'ELSE','ENDIF','ERROR',
'ALIGN','ASMMODE','ASSERTIONS',
'BOOLEVAL',
'D','DEBUGINFO','DEFINE','DESCRIPTION',
'ELSE','ENDIF','ERROR','EXTENDEDSYNTAX',
'FATAL',
'HINT','HINTS',
'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
'IF','IFDEF','IFNDEF','IFOPT','INFO',
'L','LINKLIB',
'MESSAGE','MMX',
'NOTE',
'OUTPUT_FORMAT',
'PACKRECORDS',
'SATURATION','SMARTLINK','STOP',
'IF','IFDEF','IFNDEF','IFOPT','INCLUDE','INFO',
'L','LINK','LINKLIB','LOCALSYMBOLS','LONGSTRINGS',
'M','MEMORY','MESSAGE','MINENUMSIZE','MMX',
'NOTE','NOTES',
'OPENSTRINGS','OUTPUT_FORMAT','OVERFLOWCHECKS',
'PACKENUM','PACKRECORDS',
'RANGECHECKS','REFERENCEINFO',
'SATURATION','SMARTLINK','STACKFRAMES','STOP',
'TYPEDADDRESS','TYPEINFO',
'UNDEF',
'WAIT','WARNING'
'VARSTRINGCHECKS',
'WAIT','WARNING','WARNINGS',
'Z1','Z2','Z4'
);
@ -445,6 +457,7 @@ const
_DIR_FATAL : w:=scan_f_user_defined;
_DIR_ERROR : w:=scan_e_user_defined;
_DIR_WARNING : w:=scan_w_user_defined;
_DIR_HINT : w:=scan_h_user_defined;
_DIR_NOTE : w:=scan_n_user_defined;
_DIR_MESSAGE,
_DIR_INFO : w:=scan_i_user_defined;
@ -596,7 +609,7 @@ const
hs : string;
begin
current_scanner^.skipspace;
if upcase(c)='N' then
if not(c in ['0'..'9']) then
begin
hs:=current_scanner^.readid;
if (hs='NORMAL') or (hs='DEFAULT') then
@ -617,12 +630,44 @@ const
end;
end;
procedure dir_packenum(t:tdirectivetoken);
var
hs : string;
begin
if t in [_DIR_Z1,_DIR_Z2,_DIR_Z4] then
begin
aktpackenum:=ord(pattern[2])-ord('0');
exit;
end;
current_scanner^.skipspace;
if not(c in ['0'..'9']) then
begin
hs:=current_scanner^.readid;
if (hs='NORMAL') or (hs='DEFAULT') then
aktpackenum:=4
else
Message(scan_w_only_pack_enum);
end
else
begin
case current_scanner^.readval of
1 : aktpackenum:=1;
2 : aktpackenum:=2;
4 : aktpackenum:=4;
else
Message(scan_w_only_pack_enum);
end;
end;
end;
procedure dir_wait(t:tdirectivetoken);
begin
Message(scan_i_press_enter);
readln;
end;
procedure dir_asmmode(t:tdirectivetoken);
var
s : string;
@ -636,6 +681,7 @@ const
Message1(scan_w_unsupported_asmmode_specifier,s);
end;
procedure dir_oldasmmode(t:tdirectivetoken);
begin
{$ifdef i386}
@ -650,16 +696,91 @@ const
procedure dir_delphiswitch(t:tdirectivetoken);
var
sw : char;
sw,state : char;
begin
case t of
_DIR_ALIGN : sw:='A';
_DIR_IOCHECKS : sw:='I';
_DIR_ALIGN : sw:='A';
_DIR_ASSERTIONS : sw:='C';
_DIR_BOOLEVAL : sw:='B';
_DIR_DEBUGINFO : sw:='D';
_DIR_IOCHECKS : sw:='I';
_DIR_LOCALSYMBOLS : sw:='L';
_DIR_LONGSTRINGS : sw:='H';
_DIR_OPENSTRINGS : sw:='P';
_DIR_OVERFLOWCHECKS : sw:='Q';
_DIR_RANGECHECKS : sw:='R';
_DIR_REFERENCEINFO : sw:='Y';
_DIR_STACKFRAMES : sw:='W';
_DIR_TYPEDADDRESS : sw:='T';
_DIR_TYPEINFO : sw:='M';
_DIR_VARSTRINGCHECKS : sw:='V';
else
exit;
end;
{ support ON/OFF }
if c=' ' then
begin
current_scanner^.skipspace;
current_scanner^.readid;
if pattern='ON' then
state:='+'
else
if pattern='OFF' then
state:='-';
end
else
state:=c;
{ c contains the next char, a + or - would be fine }
HandleSwitch(sw,c);
HandleSwitch(sw,state);
end;
procedure dir_memory(t:tdirectivetoken);
var
l : longint;
begin
current_scanner^.skipspace;
l:=current_scanner^.readval;
if l>1024 then
stacksize:=l;
current_scanner^.skipspace;
if c=',' then
begin
current_scanner^.readchar;
current_scanner^.skipspace;
l:=current_scanner^.readval;
if l>1024 then
heapsize:=l;
end;
end;
procedure dir_setverbose(t:tdirectivetoken);
var
flag,
state : char;
begin
case t of
_DIR_HINTS : flag:='H';
_DIR_WARNINGS : flag:='W';
_DIR_NOTES : flag:='N';
else
exit;
end;
{ support ON/OFF }
if c=' ' then
begin
current_scanner^.skipspace;
current_scanner^.readid;
if pattern='ON' then
state:='+'
else
if pattern='OFF' then
state:='-';
end
else
state:=c;
SetVerbosity(flag+state);
end;
@ -670,13 +791,19 @@ const
{_DIR_NONE} nil,
{_DIR_ALIGN} dir_delphiswitch,
{_DIR_ASMMODE} dir_asmmode,
{_DIR_ASSERTION} dir_delphiswitch,
{_DIR_BOOLEVAL} dir_delphiswitch,
{_DIR_D} dir_description,
{_DIR_DEBUGINFO} dir_delphiswitch,
{_DIR_DEFINE} dir_define,
{_DIR_DESCRIPTION} dir_description,
{_DIR_ELSE} dir_conditional,
{_DIR_ENDIF} dir_conditional,
{_DIR_ERROR} dir_message,
{_DIR_EXTENDEDSYNTAX} dir_delphiswitch,
{_DIR_FATAL} dir_message,
{_DIR_HINT} dir_message,
{_DIR_HINTS} dir_setverbose,
{_DIR_I} dir_include,
{_DIR_I386_ATT} dir_oldasmmode,
{_DIR_I386_DIRECT} dir_oldasmmode,
@ -686,20 +813,41 @@ const
{_DIR_IFDEF} dir_conditional,
{_DIR_IFNDEF} dir_conditional,
{_DIR_IFOPT} dir_conditional,
{_DIR_INCLUDE} dir_include,
{_DIR_INFO} dir_message,
{_DIR_L} dir_linkobject,
{_DIR_LINK} dir_linkobject,
{_DIR_LINKLIB} dir_linklib,
{_DIR_LOCALSYMBOLS} dir_delphiswitch,
{_DIR_LONGSTRINGS} dir_delphiswitch,
{_DIR_M} dir_memory,
{_DIR_MEMORY} dir_memory,
{_DIR_MESSAGE} dir_message,
{_DIR_MINENUMSIZE} dir_packenum,
{_DIR_MMX} dir_localswitch,
{_DIR_NOTE} dir_message,
{_DIR_NOTES} dir_setverbose,
{_DIR_OPENSTRINGS} dir_delphiswitch,
{_DIR_OUTPUT_FORMAT} dir_outputformat,
{_DIR_OVERFLOWCHECKS} dir_delphiswitch,
{_DIR_PACKENUM} dir_packenum,
{_DIR_PACKRECORDS} dir_packrecords,
{_DIR_RANGECHECKS} dir_delphiswitch,
{_DIR_REFERENCEINFO} dir_delphiswitch,
{_DIR_SATURATION} dir_localswitch,
{_DIR_SMARTLINK} dir_moduleswitch,
{_DIR_STACKFRAMES} dir_delphiswitch,
{_DIR_STOP} dir_message,
{_DIR_UNDEF} dir_undef,
{_DIR_TYPEDADDRESS} dir_delphiswitch,
{_DIR_TYPEINFO} dir_delphiswitch,
{_DIR_VARSTRINGCHECKS} dir_delphiswitch,
{_DIR_WAIT} dir_wait,
{_DIR_WARNING} dir_message
{_DIR_WARNING} dir_message,
{_DIR_WARNINGS} dir_setverbose,
{_DIR_Z1} dir_packenum,
{_DIR_Z2} dir_packenum,
{_DIR_Z4} dir_packenum
);
{-------------------------------------------
@ -751,11 +899,11 @@ const
if t<>_DIR_NONE then
begin
p:=directiveproc[t];
{$ifdef FPC}
{$ifdef FPC}
if assigned(p) then
{$else}
{$else}
if @p<>nil then
{$endif}
{$endif}
p(t);
end
else
@ -768,7 +916,10 @@ const
{
$Log$
Revision 1.23 1998-08-26 15:35:34 peter
Revision 1.24 1998-09-01 12:52:06 peter
+ a lot of delphi switches
Revision 1.23 1998/08/26 15:35:34 peter
* fixed scannerfiles for macros
+ $I %<environment>%

18
compiler/switches.pas
View File

@ -35,7 +35,7 @@ uses globals,verbose,files,systems;
****************************************************************************}
type
TSwitchType=(localsw,modulesw,globalsw,illegalsw,unsupportedsw);
TSwitchType=(ignoredsw,localsw,modulesw,globalsw,illegalsw,unsupportedsw);
SwitchRec=record
typesw : TSwitchType;
setsw : byte;
@ -47,8 +47,8 @@ const
{C} (typesw:localsw; setsw:ord(cs_do_assertion)),
{D} (typesw:modulesw; setsw:ord(cs_debuginfo)),
{E} (typesw:globalsw; setsw:ord(cs_fp_emulation)),
{F} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{G} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{F} (typesw:ignoredsw; setsw:ord(cs_localnone)),
{G} (typesw:ignoredsw; setsw:ord(cs_localnone)),
{H} (typesw:localsw; setsw:ord(cs_ansistrings)),
{I} (typesw:localsw; setsw:ord(cs_check_io)),
{J} (typesw:illegalsw; setsw:ord(cs_localnone)),
@ -66,7 +66,7 @@ const
{V} (typesw:localsw; setsw:ord(cs_strict_var_strings)),
{W} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{X} (typesw:modulesw; setsw:ord(cs_extsyntax)),
{Y} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{Y} (typesw:modulesw; setsw:ord(cs_browser)),
{Z} (typesw:illegalsw; setsw:ord(cs_localnone))
);
@ -83,8 +83,9 @@ begin
with SwitchTable[switch] do
begin
case typesw of
illegalsw : Message1(scan_w_illegal_switch,'$'+switch);
unsupportedsw : Message1(scan_w_unsupported_switch,'$'+switch);
ignoredsw : Message1(scan_n_ignored_switch,'$'+switch);
illegalsw : Message1(scan_w_illegal_switch,'$'+switch);
unsupportedsw : Message1(scan_w_unsupported_switch,'$'+switch);
localsw : begin
if state='+' then
aktlocalswitches:=aktlocalswitches+[tlocalswitch(setsw)]
@ -153,7 +154,10 @@ end;
end.
{
$Log$
Revision 1.11 1998-08-18 20:52:21 peter
Revision 1.12 1998-09-01 12:52:05 peter
+ a lot of delphi switches
Revision 1.11 1998/08/18 20:52:21 peter
* renamed in_main to in_global which is more logical
Revision 1.10 1998/08/14 18:14:57 peter