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

+ aktmodeswitches

Browse Source
This commit is contained in:
peter 1998-09-24 23:49:05 +00:00
parent 6467d64f16
commit 8e85a889de
15 changed files with 240 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/htypechk.pas
View File

@ -314,7 +314,7 @@ implementation
procvardef : begin
{ procedure variable can be assigned to an void pointer }
{ Not anymore. Use the @ operator now.}
if not(cs_tp_compatible in aktmoduleswitches) and
if not(m_tp_procvar in aktmodeswitches) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
@ -639,7 +639,10 @@ implementation
end.
{
$Log$
Revision 1.2 1998-09-24 09:02:14 peter
Revision 1.3 1998-09-24 23:49:05 peter
+ aktmodeswitches
Revision 1.2 1998/09/24 09:02:14 peter
* rewritten isconvertable to use case
* array of .. and single variable are compatible

74
compiler/msgtxt.inc
View File

@ -1,4 +1,4 @@
const msgtxt : array[0..00087,1..240] of char=(+
const msgtxt : array[0..00088,1..240] of char=(+
'U_Compiler: $1'#000+
'D_Source OS: $1'#000+
'I_Target OS: $1'#000+
@ -215,7 +215,7 @@ const msgtxt : array[0..00087,1..240] of char=(+
'E_illegal type declaration of set element','s'#000+
'E_Forward class definition not resolved $1'#000+
'H_Parameter not used $1'#000+
'W_Local variable not used $1'#000+
'N_Local variable not used $1'#000+
'E_Set type expected'#000+
'W_Function result does not seem to be set'#000+
'E_Unknown field identifier'#000+
@ -470,17 +470,17 @@ const msgtxt : array[0..00087,1..240] of char=(+
' fpc-devel@mail.tolna.hungary.net'#000+
'**0*_+ switch option on, - off'#000+
'**1a_the compiler doesn'#039't delete the generated assembler file'#000+
'**2al_list sourcecode lines in assembler file (still BETA !!)'#000+
'**2al_list sourcecode lines in assembler file'#000+
'*t1b_use EMS'#000+
'**1B_build',' all modules'#000+
'**1C_code generation options'#000+
'**1B_build all modules'#000+
'**1C','_code generation options'#000+
'3*2CD_create dynamic library'#000+
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
'**2Ci_IO-checking'#000+
'**2Cn_omit linking stage'#000+
'**2Co_check overflow of integer operations'#000+
'**2Cr_range checking'#000+
'**2Cs<n>_s','et stack size to <n>'#000+
'**2Cs<n>_set stack size to ','<n>'#000+
'**2Ct_stack checking'#000+
'3*2CS_create static library'#000+
'3*2Cx_use smartlinking'#000+
@ -489,47 +489,49 @@ const msgtxt : array[0..00087,1..240] of char=(+
'*O2Dd<x>_set description to <x>'#000+
'*O2Dw_PM application'#000+
'**1e<x>_set path to executable'#000+
'**1E_sa','me as -Cn'#000+
'**1F_set file names and paths'#000+
'**1E_same as -Cn'#000+
'**1F_se','t file names and paths'#000+
'**2Fe<x>_redirect error output to <x>'#000+
'**2FU<x>_set exe/unit output path to <x>'#000+
'*L2Fg<x>_same as -Fl'#000+
'**2Fi<x>_adds <x> to include path'#000+
'**2Fl<x>_adds <x> to library path'#000+
'*L2FL<x>_uses <x> as dynamic linker'#000+
'**2Fo<x>_adds <x> to object path'#000+
'**2F','r<x>_load error message file <x>'#000+
'**2Fo<x>_adds',' <x> to object path'#000+
'**2Fr<x>_load error message file <x>'#000+
'**2Fu<x>_adds <x> to unit path'#000+
'**2FU<x>_set unit output path to <x>, overrides -FE'#000+
'*g1g_generate debugger information'#000+
'*g2gg_use gsym'#000+
'*g2gd_use dbx'#000+
'**1i_information'#000+
'**1I<x>_adds <x> to include path'#000+
'**1I<x>_adds <x> to',' include path'#000+
'**1k<x>_Pass <x> to the linker'#000+
'**1l_write logo'#000+
'**1n_don'#039't read',' the default config file'#000+
'**1n_don'#039't read the default config file'#000+
'**1o<x>_change the name of the executable produced to <x>'#000+
'**1pg_generate profile code for gprof'#000+
'*L1P_use pipes instead of creating temporary assembler files'#000+
'*L1P_use pipes instead of creating temporar','y assembler files'#000+
'**1S_syntax options'#000+
'**2S2_switch some Delphi 2 extensions ','on'#000+
'**2S2_switch some Delphi 2 extensions on'#000+
'**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
'**2Sd_compiler disposes asm lists (uses less memory but slower)'#000+
'**2Sd_tries to be Delphi compatible'#000+
'**2Se_compiler stops after the first error'#000+
'**2Sg_allow LABEL and GOTO'#000+
'**2Si_support C++ stlyed INLINE'#000+
'**2Sm_support macros ','like C (global)'#000+
'**2Si','_support C++ stlyed INLINE'#000+
'**2Sm_support macros like C (global)'#000+
'**2So_tries to be TP/BP 7.0 compatible'#000+
'**2Sp_tries to be gpc compatible'#000+
'**2Ss_constructor name must be init (destructor must be done)'#000+
'**2St_allow static keyword in objects'#000+
'**2Sv_allow variable directives (cvar,external,publi','c,export)'#000+
'**2S','v_allow variable directives (cvar,external,public,export)'#000+
'**1s_don'#039't call assembler and linker (only with -a)'#000+
'**1T<x>_Target operating system'#000+
'3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
'3*2TLINUX_Linux'#000+
'3*','2TLINUX_Linux'#000+
'3*2TOS2_OS/2 2.x'#000+
'3*2TWin32_Windows',' 32 Bit'#000+
'3*2TWin32_Windows 32 Bit'#000+
'6*2TAMIGA_Commodore Amiga'#000+
'6*2TATARI_Atari ST/STe/TT'#000+
'6*2TMACOS_Macintosh m68k'#000+
@ -537,61 +539,61 @@ const msgtxt : array[0..00087,1..240] of char=(+
'**1u<x>_undefines the symbol <x>'#000+
'**1U_unit options'#000+
'**2Un_don'#039't check the unit name'#000+
'**2Up<x>_same as -Fu<x>'#000+
'**2Us_compile a system unit'#000,+
'**2U','p<x>_same as -Fu<x>'#000+
'**2Us_compile a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
'**2*_e : Show errors (default) d : Show debug info'#000+
'**2*_w : Show warnings u : Show used files'#000+
'**2*_n : Show notes t : Show tried files'#000,+
'**2*_n : S','how notes t : Show tried files'#000+
'**2*_h : Show hints m : Show defined macros'#000+
'**2*_i : Show general info p : Show compiled procedures'#000+
'**2*_l : Show linenumbers c : Show conditionals'#000+
'**2*_a : Show everything 0 : Show nothing ','(except errors'+
'**2*_a',' : Show everything 0 : Show nothing (except errors'+
')'#000+
'**2*_b : Show all procedure'#000+
'**2*_ declarations if an error'#000+
'**2*_ occurs'#000+
'**1X_executable options'#000+
'*L2Xc_link with the c library'#000+
'**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
'**2Xs_strip all symbols from ex','ecutable'#000+
'**2XD_link with dynamic libraries (defines F','PC_LINK_DYNAMIC)'#000+
'**2Xs_strip all symbols from executable'#000+
'**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
'**0*_Processor specific options:'#000+
'3*1A_output format'#000+
'3*2Ao_coff file using GNU AS'#000+
'3*2Anasmcoff_coff file using Nasm'#000+
'3*2Anasmelf_elf32 (linux) file using Nasm'#000+
'3*2Anasmobj_obj',' file using Nasm'#000+
'3*2Anasme','lf_elf32 (linux) file using Nasm'#000+
'3*2Anasmobj_obj file using Nasm'#000+
'3*2Amasm_obj using Masm (Mircosoft)'#000+
'3*2Atasm_obj using Tasm (Borland)'#000+
'3*1R_assembler reading style'#000+
'3*2Ratt_read AT&T style assembler'#000+
'3*2Rintel_read Intel style assembler'#000+
'3*2Rdirect_copy assembler text directly to assembler ','file'#000+
'3*2Rd','irect_copy assembler text directly to assembler file'#000+
'3*1O<x>_optimizations'#000+
'3*2Og_generate smaller code'#000+
'3*2OG_generate faster code (default)'#000+
'3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
'3*2Ou_enable uncertain optimizations (see docs)'#000+
'3*2O1_level 1 optimizations (quick optimi','zations)'#000+
'3*2Ou_enable uncertain optimizations (see',' docs)'#000+
'3*2O1_level 1 optimizations (quick optimizations)'#000+
'3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
'3*2O3_level 3 optimizations (same as -O2u)'#000+
'3*2Op_target processor'#000+
'3*3Op1_set target processor to 386/486'#000+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
'3*3Op3_set tar','get processor to PPro/PII/c6x86/K6 (tm)'#000+
'3*3Op2_set target pro','cessor to Pentium/PentiumMMX (tm)'#000+
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
'6*1A_output format'#000+
'6*2Ao_Unix o-file using GNU AS'#000+
'6*2Agas_GNU Motorola assembler'#000+
'6*2Amit_MIT Syntax (old GAS)'#000+
'6*2Amot_Standard Motorola assembler'#000+
'6*1O_optimizations'#000+
'6*1O_o','ptimizations'#000+
'6*2Oa_turn on the optimizer'#000+
'6*2Og_g','enerate smaller code'#000+
'6*2Og_generate smaller code'#000+
'6*2OG_generate faster code (default)'#000+
'6*2Ox_optimize maximum (still BUGGY!!!)'#000+
'6*2O2_set target processor to a MC68020+'#000+
'**1*_'#000+
'**1?_shows this help'#000+
'**1h_shows this help without waiting'#000
'**1h_shows this help witho','ut waiting'#000
);

34
compiler/parser.pas
View File

@ -188,9 +188,13 @@ unit parser;
{ reset symtable }
symtablestack:=nil;
defaultsymtablestack:=nil;
systemunit:=nil;
objpasunit:=nil;
refsymtable:=nil;
procprefix:='';
aktprocsym:=nil;
procprefix:='';
registerdef:=true;
{ macros }
macros:=new(psymtable,init(macrosymtable));
macros^.name:=stringdup('Conditionals for '+filename);
@ -219,6 +223,7 @@ unit parser;
{ Load current state from the init values }
aktlocalswitches:=initlocalswitches;
aktmoduleswitches:=initmoduleswitches;
aktmodeswitches:=initmodeswitches;
aktpackrecords:=initpackrecords;
aktpackenum:=initpackenum;
aktoutputformat:=initoutputformat;
@ -246,18 +251,6 @@ unit parser;
AsmRes.Init('ppas');
end;
{ load system unit always }
loadsystemunit;
registerdef:=true;
make_ref:=true;
{ current return type is void }
procinfo.retdef:=voiddef;
{ reset lexical level }
lexlevel:=0;
{ If the compile level > 1 we get a nice "unit expected" error
message if we are trying to use a program as unit.}
if (token=_UNIT) or (compile_level>1) then
@ -283,15 +276,7 @@ unit parser;
{ restore old state, close trees, > 0.99.5 has heapblocks, so
it's the default to release the trees }
{$ifdef VER0_99_5}
if dispose_asm_lists then
codegen_donemodule;
{$else}
{$ifdef TP}
if dispose_asm_lists then
{$endif}
codegen_donemodule;
{$endif}
codegen_donemodule;
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
@ -386,7 +371,10 @@ unit parser;
end.
{
$Log$
Revision 1.49 1998-09-23 15:39:07 pierre
Revision 1.50 1998-09-24 23:49:08 peter
+ aktmodeswitches
Revision 1.49 1998/09/23 15:39:07 pierre
* browser bugfixes
was adding a reference when looking for the symbol
if -bSYM_NAME was used

27
compiler/pdecl.pas
View File

@ -242,14 +242,14 @@ unit pdecl;
C_name:=orgpattern;
sc:=idlist;
consume(COLON);
if (cs_gpc_compatible in aktmoduleswitches) and
not(is_record or is_object) and
(token=ID) and (orgpattern='__asmname__') then
begin
consume(ID);
C_name:=get_stringconst;
Is_gpc_name:=true;
end;
if (m_gpc in aktmodeswitches) and
not(is_record or is_object) and
(token=ID) and (orgpattern='__asmname__') then
begin
consume(ID);
C_name:=get_stringconst;
Is_gpc_name:=true;
end;
p:=read_type('');
symdone:=false;
if is_gpc_name then
@ -1029,7 +1029,7 @@ unit pdecl;
Message(parser_e_no_local_objects);
storetypeforwardsallowed:=typecanbeforward;
if cs_tp_compatible in aktmoduleswitches then
if m_tp in aktmodeswitches then
typecanbeforward:=false;
{ distinguish classes and objects }
@ -1465,7 +1465,7 @@ unit pdecl;
symtablestack:=symtable;
consume(_RECORD);
storetypeforwardsallowed:=typecanbeforward;
if cs_tp_compatible in aktmoduleswitches then
if m_tp in aktmodeswitches then
typecanbeforward:=false;
read_var_decs(true,false);
@ -1484,7 +1484,7 @@ unit pdecl;
var
recsymtable : psymtable;
begin
if (p^.typ=typesym) then
if ((p^.properties and sp_forwarddef)<>0) then
@ -2056,7 +2056,10 @@ unit pdecl;
end.
{
$Log$
Revision 1.56 1998-09-23 15:39:09 pierre
Revision 1.57 1998-09-24 23:49:09 peter
+ aktmodeswitches
Revision 1.56 1998/09/23 15:39:09 pierre
* browser bugfixes
was adding a reference when looking for the symbol
if -bSYM_NAME was used

13
compiler/pexpr.pas
View File

@ -683,11 +683,11 @@ unit pexpr;
{ is this an access to a function result ? }
if assigned(p^.funcretsym) and
((pfuncretsym(sym)=p^.funcretsym) or
((pvarsym(sym)=opsym) and
((p^.flags and pi_operator)<>0))) and
((pvarsym(sym)=opsym) and
((p^.flags and pi_operator)<>0))) and
(p^.retdef<>pdef(voiddef)) and
(token<>LKLAMMER) and
(not ((cs_tp_compatible in aktmoduleswitches) and
(not ((m_tp in aktmodeswitches) and
(afterassignment or in_args))) then
begin
p1:=genzeronode(funcretn);
@ -719,7 +719,7 @@ unit pexpr;
begin
{ allow post fix operators }
again:=true;
if (cs_delphi2_compatible in aktmoduleswitches) and
if (m_result in aktmodeswitches) and
(pattern='RESULT') and
assigned(aktprocsym) and
(procinfo.retdef<>pdef(voiddef)) then
@ -1748,7 +1748,10 @@ unit pexpr;
end.
{
$Log$
Revision 1.54 1998-09-23 15:46:39 florian
Revision 1.55 1998-09-24 23:49:10 peter
+ aktmodeswitches
Revision 1.54 1998/09/23 15:46:39 florian
* problem with with and classes fixed
Revision 1.53 1998/09/23 09:58:54 peter

115
compiler/pmodules.pas
View File

@ -26,7 +26,6 @@ unit pmodules;
interface
procedure loadsystemunit;
procedure proc_unit;
procedure proc_program(islibrary : boolean);
@ -381,35 +380,51 @@ unit pmodules;
end;
procedure loadsystemunit;
procedure loaddefaultunits;
var
hp : pmodule;
begin
{ if the current file isn't a system unit the the system unit
will be loaded }
if not(cs_compilesystem in aktmoduleswitches) then
begin
hp:=loadunit(upper(target_info.system_unit),true);
systemunit:=hp^.symtable;
{ add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
{ read default constant definitions }
make_ref:=false;
readconstdefs;
{ we could try to overload caret by default }
symtablestack:=systemunit;
{ if POWER is defined in the RTL then use it for starstar overloading }
getsym('POWER',false);
if assigned(srsym) and (srsym^.typ=procsym) and
(overloaded_operators[STARSTAR]=nil) then
overloaded_operators[STARSTAR]:=pprocsym(srsym);
make_ref:=true;
end
{ are we compiling the system unit? }
if (cs_compilesystem in aktmoduleswitches) then
begin
{ create system defines }
createconstdefs;
{ we don't need to reset anything, it's already done in parser.pas }
exit;
end;
{ insert the system unit, it is allways the first }
hp:=loadunit(upper(target_info.system_unit),true);
systemunit:=hp^.symtable;
{ it's always the first unit }
systemunit^.next:=nil;
symtablestack:=systemunit;
{ add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
{ read default constant definitions }
make_ref:=false;
readconstdefs;
make_ref:=true;
{ if POWER is defined in the RTL then use it for starstar overloading }
getsym('POWER',false);
if assigned(srsym) and (srsym^.typ=procsym) and (overloaded_operators[STARSTAR]=nil) then
overloaded_operators[STARSTAR]:=pprocsym(srsym);
{ Objpas unit? }
if m_objpas in aktmodeswitches then
begin
hp:=loadunit('OBJPAS',false);
objpasunit:=hp^.symtable;
{ insert in stack }
objpasunit^.next:=symtablestack;
symtablestack:=objpasunit;
{ add to the used units }
current_module^.used_units.concat(new(pused_unit,init(hp,true)));
refsymtable^.insert(new(punitsym,init('OBJPAS',objpasunit)));
end
else
begin
createconstdefs;
systemunit:=nil;
end;
objpasunit:=nil;
{ save default symtablestack }
defaultsymtablestack:=symtablestack;
end;
@ -447,7 +462,7 @@ unit pmodules;
consume(SEMICOLON);
{ set the symtable to systemunit so it gets reorderd correctly }
symtablestack:=systemunit;
symtablestack:=defaultsymtablestack;
{ now insert the units in the symtablestack }
hp:=pused_unit(current_module^.used_units.first);
@ -519,7 +534,7 @@ unit pmodules;
if token=ID then
begin
{ create filenames and unit name }
current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^,true);
stringdispose(current_module^.modulename);
current_module^.modulename:=stringdup(upper(pattern));
{ check for system unit }
@ -555,6 +570,10 @@ unit pmodules;
{ update status }
status.currentmodule:=current_module^.modulename^;
{ maybe turn off m_objpas if we are compiling objpas }
if (current_module^.modulename^='OBJPAS') then
aktmodeswitches:=aktmodeswitches-[m_objpas];
{ this should be placed after uses !!}
{$ifndef UseNiceNames}
procprefix:='_'+current_module^.modulename^+'$$';
@ -574,23 +593,21 @@ unit pmodules;
{ this also forbids to have another symbol }
{ with the same name as the unit }
refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
{ set the symbol table for the current unit }
{ this must be set later for interdependency }
{ current_module^.symtable:=psymtable(p); }
{ a unit compiled at command line must be inside the loaded_unit list }
if (compile_level=1) then
loaded_units.insert(current_module);
{ load default units, like the system unit }
loaddefaultunits;
{ reset }
make_ref:=true;
lexlevel:=0;
{ insert qualifier for the system unit (allows system.writeln) }
if not(cs_compilesystem in aktmoduleswitches) then
begin
{ insert the system unit }
{ it is allways the first }
systemunit^.next:=nil;
symtablestack:=systemunit;
refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
if token=_USES then
begin
unitst^.symtabletype:=unitsymtable;
@ -600,7 +617,6 @@ unit pmodules;
exit;
unitst^.symtabletype:=globalsymtable;
end;
{ ... but insert the symbol table later }
p^.next:=symtablestack;
symtablestack:=p;
@ -667,6 +683,7 @@ unit pmodules;
{ Read the implementation units }
parse_implementation_uses(unitst);
{ All units are read, now give them a number }
numberunits;
{ now we can change refsymtable }
@ -739,7 +756,7 @@ unit pmodules;
{ avoid self recursive destructor call !! PM }
aktprocsym^.definition^.localst:=nil;
{ unsed static symbols ? }
symtablestack^.allsymbolsused;
@ -850,12 +867,11 @@ unit pmodules;
{ insert after the unit symbol tables the static symbol table }
{ of the program }
st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
current_module^.symtable:=st;
{ necessary for browser }
loaded_units.insert(current_module);
{Generate a procsym.}
make_ref:=false;
{ this was missing !!
@ -875,12 +891,12 @@ unit pmodules;
refsymtable:=st;
{ load standard units (system,objpas unit) }
loaddefaultunits;
{Insert the symbols of the system unit into the stack of symbol
tables.}
symtablestack:=systemunit;
systemunit^.next:=nil;
refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
{ reset }
make_ref:=true;
lexlevel:=0;
{Load the units used by the program we compile.}
if token=_USES then
@ -926,7 +942,7 @@ unit pmodules;
{ avoid self recursive destructor call !! PM }
aktprocsym^.definition^.localst:=nil;
codegen_doneprocedure;
consume(POINT);
@ -968,7 +984,10 @@ unit pmodules;
end.
{
$Log$
Revision 1.53 1998-09-23 12:20:50 pierre
Revision 1.54 1998-09-24 23:49:12 peter
+ aktmodeswitches
Revision 1.53 1998/09/23 12:20:50 pierre
* main program tmodule had no symtable (crashed browser)
* unit symbols problem fixed !!

11
compiler/pp.pas
View File

@ -242,10 +242,8 @@ end;
begin
oldexit:=exitproc;
exitproc:=@myexit;
{$ifndef VER0_99_5}
{$ifndef TP}
heapblocks:=true;
{$endif}
{$ifndef TP}
heapblocks:=true;
{$endif}
{$ifdef UseOverlay}
InitOverlay;
@ -256,7 +254,10 @@ begin
end.
{
$Log$
Revision 1.29 1998-09-17 09:42:41 peter
Revision 1.30 1998-09-24 23:49:13 peter
+ aktmodeswitches
Revision 1.29 1998/09/17 09:42:41 peter
+ pass_2 for cg386
* Message() -> CGMessage() for pass_1/pass_2

16
compiler/ppu.pas
View File

@ -60,7 +60,7 @@ const
ibdbxcount = 9;
ibsymref = 10;
ibdefref = 11;
ibendsymtablebrowser = 12;
ibendsymtablebrowser = 12;
ibbeginsymtablebrowser = 13;
{syms}
ibtypesym = 20;
@ -112,7 +112,6 @@ type
ppureal=extended;
{$endif}
type
tppuerror=(ppuentrytoobig,ppuentryerror);
tppuheader=packed record
@ -194,8 +193,6 @@ type
implementation
uses
verbose;
{*****************************************************************************
Crc 32
*****************************************************************************}
@ -394,8 +391,6 @@ begin
blockread(f,buf^,ppubufsize,bufsize);
{$endif}
bufidx:=0;
if bufsize=0 then
Message(unit_f_ppu_read_unexpected_end);
end;
@ -530,7 +525,6 @@ begin
if change_endian then
getword:=swap(w)
else
getword:=w;
inc(entryidx,2);
end;
@ -552,7 +546,6 @@ begin
if change_endian then
getlongint:=swap(l shr 16) or (longint(swap(l and $ffff)) shl 16)
else
getlongint:=l;
inc(entryidx,4);
end;
@ -602,6 +595,7 @@ begin
skipuntilentry:=(b=untilb);
end;
{*****************************************************************************
TPPUFile Writing
*****************************************************************************}
@ -740,7 +734,6 @@ begin
end;
procedure tppufile.putbyte(b:byte);
begin
writedata(b,1);
@ -779,7 +772,10 @@ end;
end.
{
$Log$
Revision 1.15 1998-09-23 15:39:10 pierre
Revision 1.16 1998-09-24 23:49:14 peter
+ aktmodeswitches
Revision 1.15 1998/09/23 15:39:10 pierre
* browser bugfixes
was adding a reference when looking for the symbol
if -bSYM_NAME was used

7
compiler/pstatmnt.pas
View File

@ -1027,7 +1027,7 @@ unit pstatmnt;
begin
if (token=INTCONST) or
((token=ID) and
not((cs_delphi2_compatible in aktmoduleswitches) and
not((m_result in aktmodeswitches) and
(pattern='RESULT'))) then
begin
getsym(pattern,true);
@ -1226,7 +1226,10 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.40 1998-09-23 21:53:04 florian
Revision 1.41 1998-09-24 23:49:15 peter
+ aktmodeswitches
Revision 1.40 1998/09/23 21:53:04 florian
* the following doesn't work: on texception do, was a parser error, fixed
Revision 1.39 1998/09/21 10:26:07 peter

9
compiler/psystem.pas
View File

@ -196,8 +196,11 @@ procedure createconstdefs;
{
Create all default definitions for consts for the system unit
}
var
oldregisterdef : boolean;
begin
{ create definitions for constants }
oldregisterdef:=registerdef;
registerdef:=false;
voiddef:=new(porddef,init(uvoid,0,0));
u8bitdef:=new(porddef,init(u8bit,0,255));
@ -226,13 +229,17 @@ begin
{ some other definitions }
voidpointerdef:=new(ppointerdef,init(voiddef));
cfiledef:=new(pfiledef,init(ft_untyped,nil));
registerdef:=oldregisterdef;
end;
end.
{
$Log$
Revision 1.5 1998-08-10 14:50:19 peter
Revision 1.6 1998-09-24 23:49:17 peter
+ aktmodeswitches
Revision 1.5 1998/08/10 14:50:19 peter
+ localswitches, moduleswitches, globalswitches splitting
Revision 1.4 1998/06/25 14:04:24 peter

7
compiler/ptconst.pas
View File

@ -418,7 +418,7 @@ unit ptconst;
exit;
end
else
if not(cs_tp_compatible in aktmoduleswitches) then
if not(m_tp_procvar in aktmodeswitches) then
if token=KLAMMERAFFE then
consume(KLAMMERAFFE);
getsym(pattern,true);
@ -511,7 +511,10 @@ unit ptconst;
end.
{
$Log$
Revision 1.15 1998-09-07 18:46:11 peter
Revision 1.16 1998-09-24 23:49:18 peter
+ aktmodeswitches
Revision 1.15 1998/09/07 18:46:11 peter
* update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set

63
compiler/scandir.inc
View File

@ -35,7 +35,7 @@ type
_DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
_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_M,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,_DIR_MODE,
_DIR_NOTE,_DIR_NOTES,
_DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
_DIR_PACKENUM,_DIR_PACKRECORDS,
@ -61,7 +61,7 @@ const
'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
'IF','IFDEF','IFNDEF','IFOPT','INCLUDE','INFO',
'L','LINK','LINKLIB','LOCALSYMBOLS','LONGSTRINGS',
'M','MEMORY','MESSAGE','MINENUMSIZE','MMX',
'M','MEMORY','MESSAGE','MINENUMSIZE','MMX','MODE',
'NOTE','NOTES',
'OPENSTRINGS','OUTPUT_FORMAT','OVERFLOWCHECKS',
'PACKENUM','PACKRECORDS',
@ -603,6 +603,35 @@ const
end;
procedure dir_mode(t:tdirectivetoken);
begin
if not current_module^.in_global then
Message(scan_w_switch_is_global)
else
begin
current_scanner^.skipspace;
current_scanner^.readstring;
if pattern='DEFAULT' then
aktmodeswitches:=initmodeswitches
else
if pattern='DELPHI' then
aktmodeswitches:=delphimodeswitches
else
if pattern='TP' then
aktmodeswitches:=tpmodeswitches
else
if pattern='FPC' then
aktmodeswitches:=fpcmodeswitches
else
if pattern='OBJFPC' then
aktmodeswitches:=objfpcmodeswitches
else
if pattern='GPC' then
aktmodeswitches:=gpcmodeswitches;
end;
end;
procedure dir_packrecords(t:tdirectivetoken);
var
hs : string;
@ -742,16 +771,16 @@ const
if l>1024 then
heapsize:=l;
end;
if c=',' then
begin
current_scanner^.readchar;
current_scanner^.skipspace;
l:=current_scanner^.readval;
if l>1024 then
maxheapsize:=l;
end;
if heapsize>maxheapsize then
message(scan_w_illegal_switch);
if c=',' then
begin
current_scanner^.readchar;
current_scanner^.skipspace;
l:=current_scanner^.readval;
if l>1024 then
maxheapsize:=l;
end;
if heapsize>maxheapsize then
message(scan_w_illegal_switch);
end;
@ -814,6 +843,7 @@ const
{_DIR_MESSAGE} dir_message,
{_DIR_MINENUMSIZE} dir_packenum,
{_DIR_MMX} dir_localswitch,
{_DIR_MODE} dir_mode,
{_DIR_NOTE} dir_message,
{_DIR_NOTES} dir_setverbose,
{_DIR_OPENSTRINGS} dir_delphiswitch,
@ -867,9 +897,9 @@ const
hs:=current_scanner^.readid;
if (hs='') then
begin
if (c='$') and not(cs_tp_compatible in aktmoduleswitches) then
if (c='$') and (m_fpc in aktmodeswitches) then
begin
current_scanner^.readchar; { skip $ }
current_scanner^.readchar; { skip $ }
hs:=current_scanner^.readid;
end;
if (hs='') then
@ -905,7 +935,10 @@ const
{
$Log$
Revision 1.31 1998-09-18 16:03:44 florian
Revision 1.32 1998-09-24 23:49:19 peter
+ aktmodeswitches
Revision 1.31 1998/09/18 16:03:44 florian
* some changes to compile with Delphi
Revision 1.30 1998/09/16 16:41:47 peter

12
compiler/scanner.pas
View File

@ -523,11 +523,10 @@ implementation
procedure tscannerfile.dec_comment_level;
begin
if (cs_tp_compatible in aktmoduleswitches) or
(cs_delphi2_compatible in aktmoduleswitches) then
comment_level:=0
if (m_nested_comment in aktmodeswitches) then
dec(comment_level)
else
dec(comment_level);
comment_level:=0;
end;
@ -1510,7 +1509,10 @@ exit_label:
end.
{
$Log$
Revision 1.52 1998-09-18 16:03:45 florian
Revision 1.53 1998-09-24 23:49:20 peter
+ aktmodeswitches
Revision 1.52 1998/09/18 16:03:45 florian
* some changes to compile with Delphi
Revision 1.51 1998/09/16 16:41:49 peter

9
compiler/tccnv.pas
View File

@ -628,7 +628,7 @@ implementation
own resulttype. They will therefore always be incompatible with
a procvar. Because isconvertable cannot check for procedures we
use an extra check for them.}
if (cs_tp_compatible in aktmoduleswitches) and
if (m_tp_procvar in aktmodeswitches) and
((is_procsym_load(p^.left) or is_procsym_call(p^.left)) and
(p^.resulttype^.deftype=procvardef)) then
begin
@ -814,7 +814,7 @@ implementation
if (p^.left^.treetype=ordconstn) and is_ordinal(p^.resulttype) then
begin
{ perform range checking }
if not(p^.explizit and (cs_tp_compatible in aktmoduleswitches)) then
if not(p^.explizit and (m_tp in aktmodeswitches)) then
testrange(p^.resulttype,p^.left^.value);
hp:=genordinalconstnode(p^.left^.value,p^.resulttype);
disposetree(p);
@ -898,7 +898,10 @@ implementation
end.
{
$Log$
Revision 1.1 1998-09-23 20:42:24 peter
Revision 1.2 1998-09-24 23:49:22 peter
+ aktmodeswitches
Revision 1.1 1998/09/23 20:42:24 peter
* splitted pass_1
}

7
compiler/tcmem.pas
View File

@ -178,7 +178,7 @@ implementation
{ result is a procedure variable }
{ No, to be TP compatible, you must return a pointer to
the procedure that is stored in the procvar.}
if not(cs_tp_compatible in aktmoduleswitches) then
if not(m_tp_procvar in aktmodeswitches) then
begin
p^.resulttype:=new(pprocvardef,init);
@ -500,7 +500,10 @@ implementation
end.
{
$Log$
Revision 1.1 1998-09-23 20:42:24 peter
Revision 1.2 1998-09-24 23:49:24 peter
+ aktmodeswitches
Revision 1.1 1998/09/23 20:42:24 peter
* splitted pass_1
}