From a47afc3857012b0e9a8741193be9955d19e29ae5 Mon Sep 17 00:00:00 2001 From: peter Date: Thu, 13 May 1999 21:59:19 +0000 Subject: [PATCH] * removed oldppu code * warning if objpas is loaded from uses * first things for new deref writing --- compiler/assemble.pas | 12 +- compiler/browcol.pas | 18 +- compiler/cg386flw.pas | 11 +- compiler/files.pas | 15 +- compiler/globals.pas | 13 +- compiler/hcgdata.pas | 13 +- compiler/msgidx.inc | 1 + compiler/msgtxt.inc | 262 +++++----- compiler/pdecl.pas | 45 +- compiler/pmodules.pas | 45 +- compiler/ppu.pas | 21 +- compiler/pstatmnt.pas | 19 +- compiler/ra386.pas | 9 +- compiler/symdef.inc | 134 +---- compiler/symdefh.inc | 16 +- compiler/symppu.inc | 114 +++- compiler/symsym.inc | 71 +-- compiler/symsymh.inc | 23 +- compiler/symtable.pas | 1144 ++++++----------------------------------- compiler/tccal.pas | 11 +- compiler/tccnv.pas | 11 +- 21 files changed, 537 insertions(+), 1471 deletions(-) diff --git a/compiler/assemble.pas b/compiler/assemble.pas index 9e9fee39c2..480decd879 100644 --- a/compiler/assemble.pas +++ b/compiler/assemble.pas @@ -459,6 +459,7 @@ var {$endif} begin case aktoutputformat of + as_none : ; {$ifdef i386} {$ifndef NoAg386Bin} as_i386_dbg, @@ -524,7 +525,11 @@ begin {$endif NoAg68kMpw} {$endif} else +{$ifdef TP} + exit; +{$else} Message(asmw_f_assembler_output_not_supported); +{$endif} end; a^.AsmCreate; a^.WriteAsmList; @@ -548,7 +553,12 @@ end; end. { $Log$ - Revision 1.46 1999-05-05 22:21:48 peter + Revision 1.47 1999-05-13 21:59:19 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.46 1999/05/05 22:21:48 peter * updated messages Revision 1.45 1999/05/04 21:44:33 florian diff --git a/compiler/browcol.pas b/compiler/browcol.pas index f1242dedf6..7acda9481b 100644 --- a/compiler/browcol.pas +++ b/compiler/browcol.pas @@ -927,18 +927,9 @@ procedure CreateBrowserCol; Exit; if Owner=nil then Owner:=New(PSortedSymbolCollection, Init(10,50)); -{$ifdef OLDPPU} - defcount:=Table^.number_defs; - symcount:=Table^.number_symbols; - for I:=1 to symcount do - begin - Sym:=Table^.GetsymNr(I); - if Sym=nil then Continue; -{$else} sym:=psym(Table^.symindex^.first); while assigned(sym) do begin -{$endif} ParamCount:=0; New(Symbol, Init(Sym^.Name,Sym^.Typ,'',nil)); case Sym^.Typ of @@ -1057,9 +1048,7 @@ procedure CreateBrowserCol; end; if Assigned(Symbol) then Owner^.Insert(Symbol); -{$ifndef OLDPPU} sym:=psym(sym^.next); -{$endif} end; end; @@ -1241,7 +1230,12 @@ begin end. { $Log$ - Revision 1.15 1999-04-29 09:36:55 peter + Revision 1.16 1999-05-13 21:59:20 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.15 1999/04/29 09:36:55 peter * fixed crash * check if localbrowser is set diff --git a/compiler/cg386flw.pas b/compiler/cg386flw.pas index 8f13b35f9f..1de7c387a3 100644 --- a/compiler/cg386flw.pas +++ b/compiler/cg386flw.pas @@ -710,11 +710,7 @@ do_jmp: { what a hack ! } if assigned(p^.exceptsymtable) then -{$ifndef OLDPPU} pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset; -{$else} - pvarsym(p^.exceptsymtable^.searchroot)^.address:=ref.offset; -{$endif} exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L, R_EAX,newreference(ref)))); @@ -802,7 +798,12 @@ do_jmp: end. { $Log$ - Revision 1.35 1999-05-01 13:24:07 peter + Revision 1.36 1999-05-13 21:59:21 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.35 1999/05/01 13:24:07 peter * merged nasm compiler * old asm moved to oldasm/ diff --git a/compiler/files.pas b/compiler/files.pas index 4e9d6955aa..71cff4a427 100644 --- a/compiler/files.pas +++ b/compiler/files.pas @@ -751,16 +751,12 @@ uses { Load values to be access easier } flags:=ppufile^.header.flags; crc:=ppufile^.header.checksum; -{$ifndef OLDPPU} interface_crc:=ppufile^.header.interface_checksum; -{$endif} { Show Debug info } Message1(unit_u_ppu_time,filetimestring(ppufiletime)); Message1(unit_u_ppu_flags,tostr(flags)); Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum)); -{$ifndef OLDPPU} Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)'); -{$endif} { check the object and assembler file to see if we need only to assemble, only if it's not in a library } do_compile:=false; @@ -933,10 +929,8 @@ uses procedure tmodule.reset; -{$ifndef OLDPPU} var pm : pdependent_unit; -{$endif} begin if assigned(scanner) then pscannerfile(scanner)^.invalid:=true; @@ -969,7 +963,6 @@ uses used_units.done; used_units.init; { all units that depend on this one must be recompiled ! } -{$ifndef OLDPPU} pm:=pdependent_unit(dependent_units.first); while assigned(pm) do begin @@ -982,7 +975,6 @@ uses end; pm:=pdependent_unit(pm^.next); end; -{$endif OLDPPU} dependent_units.done; dependent_units.init; resourcefiles.done; @@ -1194,7 +1186,12 @@ uses end. { $Log$ - Revision 1.94 1999-05-04 21:44:42 florian + Revision 1.95 1999-05-13 21:59:25 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.94 1999/05/04 21:44:42 florian * changes to compile it with Delphi 4.0 Revision 1.93 1999/04/26 13:31:29 peter diff --git a/compiler/globals.pas b/compiler/globals.pas index 58fc0f8f55..d5553a6d34 100644 --- a/compiler/globals.pas +++ b/compiler/globals.pas @@ -62,7 +62,7 @@ unit globals; [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar, m_pointer_2_procedure,m_autoderef]; fpcmodeswitches : tmodeswitches= - [m_fpc,m_all,m_class,m_string_pchar,m_nested_comment,m_repeat_forward, + [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward, m_cvar_support]; objfpcmodeswitches : tmodeswitches= [m_fpc,m_all,m_objpas,m_class,m_result,m_string_pchar,m_nested_comment, @@ -1161,7 +1161,7 @@ unit globals; {$ifdef i386} initoptprocessor:=Class386; initlocalswitches:=[]; - initmoduleswitches:=[cs_extsyntax{$ifndef OLDPPU},cs_browser{$endif}]; + initmoduleswitches:=[cs_extsyntax,cs_browser]; initglobalswitches:=[cs_check_unit_name]; initmodeswitches:=fpcmodeswitches; initpackenum:=4; @@ -1173,7 +1173,7 @@ unit globals; {$ifdef m68k} initoptprocessor:=MC68000; initlocalswitches:=[]; - initmoduleswitches:=[cs_extsyntax{$ifndef OLDPPU},cs_browser{$endif},cs_fp_emulation]; + initmoduleswitches:=[cs_extsyntax,cs_browser,cs_fp_emulation]; initglobalswitches:=[cs_check_unit_name]; initmodeswitches:=fpcmodeswitches; initpackenum:=4; @@ -1203,7 +1203,12 @@ begin end. { $Log$ - Revision 1.6 1999-05-05 10:05:50 florian + Revision 1.7 1999-05-13 21:59:26 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.6 1999/05/05 10:05:50 florian * a delphi compiled compiler recompiles ppc Revision 1.5 1999/05/04 21:44:43 florian diff --git a/compiler/hcgdata.pas b/compiler/hcgdata.pas index a04db41a83..7cb0353354 100644 --- a/compiler/hcgdata.pas +++ b/compiler/hcgdata.pas @@ -93,7 +93,7 @@ implementation dispose(p); end; - procedure insertmsgstr(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} + procedure insertmsgstr(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC} var hp : pprocdef; @@ -141,7 +141,7 @@ implementation end; end; - procedure insertmsgint(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} + procedure insertmsgint(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC} var hp : pprocdef; @@ -288,7 +288,7 @@ implementation _c : pobjectdef; has_constructor,has_virtual_method : boolean; - procedure eachsym(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} + procedure eachsym(sym : pnamedindexobject);{$ifndef FPC}far;{$endif FPC} var procdefcoll : pprocdefcoll; @@ -566,7 +566,12 @@ implementation end. { $Log$ - Revision 1.3 1999-04-26 13:31:34 peter + Revision 1.4 1999-05-13 21:59:27 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.3 1999/04/26 13:31:34 peter * release storenumber,double_checksum Revision 1.2 1999/04/21 09:43:37 peter diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index f97aa99716..f3c875e684 100644 --- a/compiler/msgidx.inc +++ b/compiler/msgidx.inc @@ -198,6 +198,7 @@ type tmsgconst=( parser_e_self_in_non_message_handler, parser_e_threadvars_only_sg, parser_f_direct_assembler_not_allowed, + parser_w_no_objpas_use_mode, parser_e_no_object_override, type_e_mismatch, type_e_incompatible_types, diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index c2b8b8144a..154c0515e0 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -1,8 +1,4 @@ -{$ifdef Delphi} -const msgtxt : array[0..000094] of string[240]=( -{$else Delphi} -const msgtxt : array[0..000094,1..240] of char=( -{$endif Delphi} +const msgtxt : array[0..00094,1..240] of char=(+ 'T_Compiler: $1'#000+ 'D_Compiler OS: $1'#000+ 'I_Target OS: $1'#000+ @@ -145,7 +141,7 @@ const msgtxt : array[0..000094,1..240] of char=( 'E_Procedures can'#039't return a value'#000+ 'E_constructors and destructors must be methods'#000+ 'E_Operator is not overloaded'#000+ - 'E_Re-raise isn'#039't possible there'#000, + 'E_Re-raise isn'#039't possible there'#000,+ 'E_The extended syntax of new or dispose isn'#039't allowed for a class'#000+ 'E_Assembler incompatible with function return type'#000+ 'E_Procedure overloading is switched off'#000+ @@ -209,423 +205,425 @@ const msgtxt : array[0..000094,1..240] of char=( 'E_Duplicate message label: %1'#000+ 'E_Self can be only an explicit parameter in message handlers',#000+ 'E_Threadvars can be only static or global'#000+ - 'F_Direct assembler not supported for output format'#000+ + 'F_Direct assembler not supported for binary output format'#000+ + 'W_Don'#039't load OBJPAS unit manual, use {$mode objfpc} or {$mode delp'+ + 'hi} instead'#000+ 'E_OVERRIDE can'#039't be used in objects'#000+ 'E_Type mismatch'#000+ - 'E_Incompatible types: got $1 expected $2'#000+ + 'E_Incompa','tible types: got $1 expected $2'#000+ 'E_Integer expression expected'#000+ - 'E_Ordinal expression ex','pected'#000+ + 'E_Ordinal expression expected'#000+ 'E_Type identifier expected'#000+ 'E_Variable identifier expected'#000+ 'E_pointer type expected'#000+ 'E_class type expected'#000+ 'E_Variable or type indentifier expected'#000+ - 'E_Can'#039't evaluate constant expression'#000+ + 'E_Ca','n'#039't evaluate constant expression'#000+ 'E_Set elements are not compatible'#000+ - 'E_Operation not im','plemented for sets'#000+ + 'E_Operation not implemented for sets'#000+ 'W_Automatic type conversion from floating type to COMP which is an int'+ 'eger type'#000+ 'H_use DIV instead to get an integer result'#000+ - 'E_string types doesn'#039't match, because of $V+ mode'#000+ - 'E_succ or pred on enums with assignments not pos','sible'#000+ + 'E_string type','s doesn'#039't match, because of $V+ mode'#000+ + 'E_succ or pred on enums with assignments not possible'#000+ 'E_Can'#039't read or write variables of this type'#000+ 'E_Type conflict between set elements'#000+ 'W_lo/hi(longint/dword) returns the upper/lower word'#000+ - 'E_Integer or real expression expected'#000+ + 'E_Integer or re','al expression expected'#000+ 'E_Wrong type in array constructor'#000+ - 'E_Incompatible type for arg ','#$1: Got $2, expected $3'#000+ + 'E_Incompatible type for arg #$1: Got $2, expected $3'#000+ 'E_Identifier not found $1'#000+ 'F_Internal Error in SymTableStack()'#000+ 'E_Duplicate identifier $1'#000+ - 'H_Identifier already defined in $1 at line $2'#000+ + 'H_Identifier already defined in $1 at line',' $2'#000+ 'E_Unknown identifier $1'#000+ 'E_Forward declaration not solved $1'#000+ - 'F_Identifier type alr','eady defined as type'#000+ + 'F_Identifier type already defined as type'#000+ 'E_Error in type definition'#000+ 'E_Type identifier not defined'#000+ 'E_Forward type not resolved $1'#000+ - 'E_Only static variables can be used in static methods or outside metho'+ - 'ds'#000+ + 'E_Only static variables can be used in static ','methods or outside met'+ + 'hods'#000+ 'E_Invalid call to tvarsym.mangledname()'#000+ - 'F_record or class ','type expected'#000+ + 'F_record or class type expected'#000+ 'E_Instances of classes or objects with an abstract method are not allo'+ 'wed'#000+ 'W_Label not defined $1'#000+ 'E_Illegal label declaration'#000+ - 'E_GOTO und LABEL are not supported (use switch -Sg)'#000+ + 'E_GOTO und LABEL',' are not supported (use switch -Sg)'#000+ 'E_Label not found'#000+ 'E_identifier isn'#039't a label'#000+ - 'E_la','bel already defined'#000+ + 'E_label already defined'#000+ 'E_illegal type declaration of set elements'#000+ 'E_Forward class definition not resolved $1'#000+ 'H_Parameter not used $1'#000+ - 'N_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 record fi','eld identifier $1'#000+ + 'E_Unknown record field identifier $1'#000+ 'W_Local variable $1 does not seem to be initialized'#000+ 'E_identifier idents no member $1'#000+ 'B_Found declaration: $1'#000+ 'E_BREAK not allowed'#000+ - 'E_CONTINUE not allowed'#000+ + 'E_CONTIN','UE not allowed'#000+ 'E_Expression too complicated - FPU stack overflow'#000+ - 'E_Illegal expression',#000+ + 'E_Illegal expression'#000+ 'E_Invalid integer expression'#000+ 'E_Illegal qualifier'#000+ 'E_High range limit < low range limit'#000+ 'E_Illegal counter variable'#000+ - 'E_Can'#039't determine which overloaded function to call'#000+ + 'E_Can'#039't determine which overloaded functi','on to call'#000+ 'E_Parameter list size exceeds 65535 bytes'#000+ 'E_Illegal type conversion'#000+ - 'E_File',' types must be var parameters'#000+ + 'E_File types must be var parameters'#000+ 'E_The use of a far pointer isn'#039't allowed there'#000+ 'E_illegal call by reference parameters'#000+ - 'E_EXPORT declared functions can'#039't be called'#000+ + 'E_EXPORT declared functions can'#039't be ca','lled'#000+ 'W_Possible illegal call of constructor or destructor (doesn'#039't matc'+ - 'h to this cont','ext)'#000+ + 'h to this context)'#000+ 'N_Inefficient code'#000+ 'W_unreachable code'#000+ 'E_procedure call with stackframe ESP/SP'#000+ 'E_Abstract methods can'#039't be called directly'#000+ - 'F_Internal Error in getfloatreg(), allocation failure'#000+ + 'F_Internal Error in getfloat','reg(), allocation failure'#000+ 'F_Unknown float type'#000+ 'F_SecondVecn() base defined twice'#000+ - 'F_Ex','tended cg68k not supported'#000+ + 'F_Extended cg68k not supported'#000+ 'F_32-bit unsigned not supported in MC68000 mode'#000+ 'F_Internal Error in secondinline()'#000+ 'D_Register $1 weight $2 $3'#000+ - 'E_Stack limit excedeed in local routine'#000+ + 'E_Stack limit exce','deed in local routine'#000+ 'D_Stack frame is omitted'#000+ - 'E_Object or class methods can'#039't be inl','ine.'#000+ + 'E_Object or class methods can'#039't be inline.'#000+ 'E_Procvar calls can'#039't be inline.'#000+ 'E_No code for inline procedure stored'#000+ 'E_Element zero of an ansi/wide- or longstring can'#039't be accessed, u'+ - 'se (set)length instead'#000+ + 'se (set)lengt','h instead'#000+ 'E_Include and exclude not implemented in this case'#000+ - 'W_Probably illegal const','ant passed to internal math function'#000+ + 'W_Probably illegal constant passed to internal math function'#000+ 'E_Constructors or destructors can not be called inside a '#039'with'#039+ ' clause'#000+ 'E_Cannot call message handler method directly'#000+ - 'D_Starting $1 styled assembler parsing'#000+ + 'D','_Starting $1 styled assembler parsing'#000+ 'D_Finished $1 styled assembler parsing'#000+ - 'E_Non-la','bel pattern contains @'#000+ + 'E_Non-label pattern contains @'#000+ 'W_Override operator not supported'#000+ 'E_Error building record offset'#000+ 'E_OFFSET used without identifier'#000+ - 'E_Cannot use local variable or parameters here'#000+ + 'E_Cannot use local variable or par','ameters here'#000+ 'E_need to use OFFSET here'#000+ 'E_Cannot use multiple relocatable symbols'#000+ - 'E_Re','locatable symbol can only be added'#000+ + 'E_Relocatable symbol can only be added'#000+ 'E_Invalid constant expression'#000+ 'E_Relocatable symbol is not allowed'#000+ 'E_Invalid reference syntax'#000+ - 'E_Local symbols not allowed as references'#000+ + 'E_Local symbols not allowed',' as references'#000+ 'E_Invalid base and index register usage'#000+ - 'E_Wrong scale factor specified',#000+ + 'E_Wrong scale factor specified'#000+ 'E_Multiple index register usage'#000+ 'E_Invalid operand type'#000+ 'E_Invalid string as opcode operand: $1'#000+ 'W_@CODE and @DATA not supported'#000+ - 'E_Null label references are not allowed'#000+ + 'E_Null label references are ','not allowed'#000+ 'F_Divide by zero in asm evaluator'#000+ 'F_Evaluator stack overflow'#000+ - 'F_Evaluator ','stack underflow'#000+ + 'F_Evaluator stack underflow'#000+ 'F_Invalid numeric format in asm evaluator'#000+ 'F_Invalid Operator in asm evaluator'#000+ 'E_escape sequence ignored: $1'#000+ 'E_Invalid symbol reference'#000+ - 'W_Fwait can cause emulation problems with emu387'#000+ - 'W_Calling an overload function in assemb','ler'#000+ + 'W_Fw','ait can cause emulation problems with emu387'#000+ + 'W_Calling an overload function in assembler'#000+ 'E_Unsupported symbol type for operand'#000+ 'E_Constant value out of bounds'#000+ 'E_Error converting decimal $1'#000+ 'E_Error converting octal $1'#000+ - 'E_Error converting binary $1'#000+ + 'E_Error converting binar','y $1'#000+ 'E_Error converting hexadecimal $1'#000+ 'H_$1 translated to $2'#000+ - 'W_$1 is associated to an',' overloaded function'#000+ + 'W_$1 is associated to an overloaded function'#000+ 'E_Cannot use SELF outside a method'#000+ 'E_Cannot use __SELF outside a method'#000+ 'E_Cannot use __OLDEBP outside a nested procedure'#000+ - 'W_Functions with void return value can'#039't return any value in asm c'+ - 'ode'#000+ + 'W_Functions w','ith void return value can'#039't return any value in asm'+ + ' code'#000+ 'E_SEG not supported'#000+ - 'E_Size s','uffix and destination or source size do not match'#000+ + 'E_Size suffix and destination or source size do not match'#000+ 'W_Size suffix and destination or source size do not match'#000+ 'E_Assembler syntax error'#000+ - 'E_Invalid combination of opcode and operands'#000+ + 'E_Invalid combination ','of opcode and operands'#000+ 'E_Assemler syntax error in operand'#000+ - 'E_Assemler syntax error in ','constant'#000+ + 'E_Assemler syntax error in constant'#000+ 'E_Invalid String expression'#000+ '32bit constant created for address'#000+ 'E_Invalid or missing opcode'#000+ 'E_Invalid combination of prefix and opcode: $1'#000+ - 'E_Invalid combination of override and opcode: $1'#000+ + 'E_Invali','d combination of override and opcode: $1'#000+ 'E_Too many operands on line'#000+ 'W_NEAR ignored'#000+ - 'W','_FAR ignored'#000+ + 'W_FAR ignored'#000+ 'E_Duplicate local symbol $1'#000+ 'E_Undefined local symbol $1'#000+ 'E_Unknown label identifier $1'#000+ 'E_Invalid floating point register name'#000+ - 'E_NOR not supported'#000+ + 'E_NOR not support','ed'#000+ 'W_Modulo not supported'#000+ 'E_Invalid floating point constant $1'#000+ - 'E_Invalid floating poi','nt expression'#000+ + 'E_Invalid floating point expression'#000+ 'E_Wrong symbol type'#000+ 'E_Cannot index a local var or parameter with a register'#000+ 'E_Invalid segment override expression'#000+ - 'W_Identifier $1 supposed external'#000+ + 'W_Identifier $1 supposed ex','ternal'#000+ 'E_Strings not allowed as constants'#000+ 'No type of variable specified'#000+ - 'E_assembler c','ode not returned to text section'#000+ + 'E_assembler code not returned to text section'#000+ 'E_Not a directive or local symbol $1'#000+ 'E_Using a defined name as a local label'#000+ 'F_Too many assembler files'#000+ - 'F_Selected assembler output not supported'#000+ + 'F_Selected assembl','er output not supported'#000+ 'F_Comp not supported'#000+ - 'F_Direct not support for binary writers'#000, + 'F_Direct not support for binary writers'#000+ 'E_Allocating of data is only allowed in bss section'#000+ 'F_No binary writer selected'#000+ 'E_Asm: Opcode $1 not in table'#000+ - 'E_Asm: $1 invalid combination of opcode and operands'#000+ + 'E_Asm: $1 invalid combination of opcode and o','perands'#000+ 'E_Asm: 16 Bit references not supported'#000+ 'E_Asm: Invalid effective address'#000+ - 'E_Asm',': Immediate or reference expected'#000+ + 'E_Asm: Immediate or reference expected'#000+ 'E_Asm: $1 value exceeds bounds $2'#000+ 'E_Asm: Short jump is out of range $1'#000+ 'W_Source operating system redefined'#000+ - 'I_Assembling (pipe) $1'#000+ + 'I_Assembling (','pipe) $1'#000+ 'E_Can'#039't create assember file $1'#000+ - 'W_Assembler $1 not found, switching to exter','nal assembling'#000+ + 'W_Assembler $1 not found, switching to external assembling'#000+ 'T_Using assembler: $1'#000+ 'W_Error while assembling exitcode $1'#000+ 'W_Can'#039't call the assembler, error $1 switching to external assembl'+ 'ing'#000+ - 'I_Assembling $1'#000+ + 'I_Assemblin','g $1'#000+ 'W_Linker $1 not found, switching to external linking'#000+ 'T_Using linker: $1'#000+ - 'W_Object',' $1 not found, Linking may fail !'#000+ + 'W_Object $1 not found, Linking may fail !'#000+ 'W_Library $1 not found, Linking may fail !'#000+ 'W_Error while linking'#000+ 'W_Can'#039't call the linker, switching to external linking'#000+ - 'I_Linking $1'#000+ + 'I','_Linking $1'#000+ 'W_binder not found, switching to external binding'#000+ - 'W_ar not found, switchi','ng to external ar'#000+ + 'W_ar not found, switching to external ar'#000+ 'E_Dynamic Libraries not supported'#000+ 'I_Closing script $1'#000+ 'W_resource compiler not found, switching to external mode'#000+ 'I_Compiling resource $1'#000+ - 'F_Can'#039't post process executable $1'#000+ + 'F','_Can'#039't post process executable $1'#000+ 'F_Can'#039't open executable $1'#000+ - 'X_Size of Code: $1 bytes',#000+ + 'X_Size of Code: $1 bytes'#000+ 'X_Size of initialized data: $1 bytes'#000+ 'X_Size of uninitialized data: $1 bytes'#000+ 'X_Stack space reserved: $1 bytes'#000+ 'X_Stack space commited: $1 bytes'#000+ - 'T_Unitsearch: $1'#000+ + 'T_Unitsearch',': $1'#000+ 'T_PPU Loading $1'#000+ 'U_PPU Name: $1'#000+ 'U_PPU Flags: $1'#000+ 'U_PPU Crc: $1'#000+ 'U_PPU Time: $1'#000+ - 'U_P','PU File too short'#000+ + 'U_PPU File too short'#000+ 'U_PPU Invalid Header (no PPU at the begin)'#000+ 'U_PPU Invalid Version $1'#000+ 'U_PPU is compiled for an other processor'#000+ - 'U_PPU is compiled for an other target'#000+ + 'U_PPU is compiled for an oth','er target'#000+ 'U_PPU Source: $1'#000+ 'U_Writing $1'#000+ 'F_Can'#039't Write PPU-File'#000+ 'F_reading PPU-File'#000+ - 'F_u','nexpected end of PPU-File'#000+ + 'F_unexpected end of PPU-File'#000+ 'F_Invalid PPU-File entry: $1'#000+ 'F_PPU Dbx count problem'#000+ 'E_Illegal unit name: $1'#000+ 'F_Too much units'#000+ - 'F_Circular unit reference between $1 and $2'#000+ + 'F_Circular unit reference between $','1 and $2'#000+ 'F_Can'#039't compile unit $1, no sources available'#000+ - 'W_Compiling the system unit re','quires the -Us switch'#000+ + 'W_Compiling the system unit requires the -Us switch'#000+ 'F_There were $1 errors compiling module, stopping'#000+ 'U_Load from $1 ($2) unit $3'#000+ 'U_Recompiling $1, checksum changed for $2'#000+ - 'U_Recompiling $1, source found only'#000+ + 'U_Recompiling',' $1, source found only'#000+ 'U_Recompiling unit, static lib is older than ppufile'#000+ - 'U_Recompi','ling unit, shared lib is older than ppufile'#000+ + 'U_Recompiling unit, shared lib is older than ppufile'#000+ 'U_Recompiling unit, obj and asm are older than ppufile'#000+ 'U_Recompiling unit, obj is older than asm'#000+ - 'U_Parsing interface of $1'#000+ + 'U_Parsing inte','rface of $1'#000+ 'U_Parsing implementation of $1'#000+ 'U_Second load for unit $1'#000+ - 'U_PPU Check file',' $1 time $2'#000+ + 'U_PPU Check file $1 time $2'#000+ '$1 [options] [options]'#000+ 'W_Only one source file supported'#000+ 'W_DEF file can be created only for OS/2'#000+ - 'E_nested response files are not supported'#000+ + 'E_nested response files are not sup','ported'#000+ 'F_No source file name in command line'#000+ 'E_Illegal parameter: $1'#000+ - 'H_-? writes help',' pages'#000+ + 'H_-? writes help pages'#000+ 'F_Too many config files nested'#000+ 'F_Unable to open file $1'#000+ 'N_Reading further options from $1'#000+ 'W_Target is already set to: $1'#000+ - 'W_Shared libs not supported on DOS platform, reverting to static'#000+ + 'W_Shared libs not supported',' on DOS platform, reverting to static'#000+ 'F_too many IF(N)DEFs'#000+ 'F_too many ENDIFs'#000+ - 'F_open c','onditional at the end of the file'#000+ + 'F_open conditional at the end of the file'#000+ 'W_Debug information generation is not supported by this executable'#000+ 'H_Try recompiling with -dGDB'#000+ - 'W_You are using the obsolete switch $1'#000+ + 'W_You are using the obsol','ete switch $1'#000+ 'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+ - 'Copyrigh','t (c) 1993-98 by Florian Klaempfl'#000+ + 'Copyright (c) 1993-98 by Florian Klaempfl'#000+ 'Free Pascal Compiler version $FPCVER'#000+ #000+ 'Compiler Date : $FPCDATE'#000+ 'Compiler Target: $FPCTARGET'#000+ #000+ - 'This program comes under the GNU General Public Licence'#000+ + 'This program comes under the',' GNU General Public Licence'#000+ 'For more information read COPYING.FPC'#000+ #000+ - 'Report bugs,sugges','tions etc to:'#000+ + 'Report bugs,suggestions etc to:'#000+ ' fpc-devel@vekoll.saturnus.vein.hu'#000+ '**0*_put + after a boolean switch option to enable it, - to disable it'+ #000+ - '**1a_the compiler doesn'#039't delete the generated assembler file'#000+ - '**2al_list sourcecode lines in assembler f','ile'#000+ + '**1a_the compiler d','oesn'#039't delete the generated assembler file'#000+ + '**2al_list sourcecode lines in assembler file'#000+ '**1b_generate browser info'#000+ '**2bl_generate local symbol info'#000+ '**1B_build all modules'#000+ '**1C_code generation options:'#000+ '3*2CD_create dynamic library'#000+ - '**2Ch_ bytes heap (between 1023 and 67107840)'#000+ + '**2Ch<','n>_ bytes heap (between 1023 and 67107840)'#000+ '**2Ci_IO-checking'#000+ - '**2Cn_omit linking st','age'#000+ + '**2Cn_omit linking stage'#000+ '**2Co_check overflow of integer operations'#000+ '**2Cr_range checking'#000+ '**2Cs_set stack size to '#000+ '**2Ct_stack checking'#000+ '3*2CS_create static library'#000+ - '3*2Cx_use smartlinking'#000+ + '3*2Cx_u','se smartlinking'#000+ '**1d_defines the symbol '#000+ '*O1D_generate a DEF file'#000+ - '*O2Dd_set ','description to '#000+ + '*O2Dd_set description to '#000+ '*O2Dw_PM application'#000+ '**1e_set path to executable'#000+ '**1E_same as -Cn'#000+ '**1F_set file names and paths:'#000+ - '**2FD_sets the directory where to search for compiler utilities'#000+ + '**2FD_sets the directory where',' to search for compiler utilities'#000+ '**2Fe_redirect error output to '#000+ - '**2FE_set ','exe/unit output path to '#000+ + '**2FE_set exe/unit output path to '#000+ '*L2Fg_same as -Fl'#000+ '**2Fi_adds to include path'#000+ '**2Fl_adds to library path'#000+ '*L2FL_uses as dynamic linker'#000+ - '**2Fo_adds to object path'#000+ + '**','2Fo_adds to object path'#000+ '**2Fr_load error message file '#000+ - '**2Fu_adds ',' to unit path'#000+ + '**2Fu_adds to unit path'#000+ '**2FU_set unit output path to , overrides -FE'#000+ '*g1g_generate debugger information:'#000+ '*g2gg_use gsym'#000+ '*g2gd_use dbx'#000+ - '*g2gh_use heap trace unit'#000+ + '*g2gh_use heap trace ','unit'#000+ '**1i_information'#000+ '**2iD_return compiler date'#000+ '**2iV_return compiler version'#000+ - '**2iSO','_return compiler OS'#000+ + '**2iSO_return compiler OS'#000+ '**2iSP_return compiler processor'#000+ '**2iTO_return target OS'#000+ '**2iTP_return target processor'#000+ '**1I_adds to include path'#000+ - '**1k_Pass to the linker'#000+ + '**1k_Pass <','x> to the linker'#000+ '**1l_write logo'#000+ '**1n_don'#039't read the default config file'#000+ - '**1o_chan','ge the name of the executable produced to '#000+ + '**1o_change the name of the executable produced to '#000+ '**1pg_generate profile code for gprof'#000+ '*L1P_use pipes instead of creating temporary assembler files'#000+ - '**1S_syntax options:'#000+ + '**1S_sy','ntax options:'#000+ '**2S2_switch some Delphi 2 extensions on'#000+ - '**2Sc_supports operators like ','C (*=,+=,/= and -=)'#000+ + '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+ '**2Sd_tries to be Delphi compatible'#000+ '**2Se_compiler stops after the first error'#000+ '**2Sg_allow LABEL and GOTO'#000+ '**2Sh_Use ansistrings'#000+ - '**2Si_support C++ styled INLINE'#000+ + '**2Si_s','upport C++ styled INLINE'#000+ '**2Sm_support macros like C (global)'#000+ - '**2So_tries to be TP/BP',' 7.0 compatible'#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+ - '**1s_don'#039't call assembler and linker (only with -a)'#000+ + '**1s_d','on'#039't call assembler and linker (only with -a)'#000+ '**1u_undefines the symbol '#000+ - '**1U_u','nit options:'#000+ + '**1U_unit options:'#000+ '**2Un_don'#039't check the unit name'#000+ '**2Up_same as -Fu'#000+ '**2Us_compile a system unit'#000+ - '**1v_Be verbose. is a combination of the following letters:'#000+ + '**1v_Be verbose. is a combination of the following ','letters:'#000+ '**2*_e : Show errors (default) d : Show debug info'#000+ - '**2*_w : Show warni','ngs u : Show unit info'#000+ + '**2*_w : Show warnings u : Show unit info'#000+ '**2*_n : Show notes t : Show tried/used files'#000+ - '**2*_h : Show hints m : Show defined macros'#000+ + '**2*_h : Show hints m : Show defined m','acros'#000+ '**2*_i : Show general info p : Show compiled procedures'#000+ - '**2*_l : Show',' linenumbers c : Show conditionals'#000+ + '**2*_l : Show linenumbers c : Show conditionals'#000+ '**2*_a : Show everything 0 : Show nothing (except errors)'#000+ - '**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#000+ - '**2*_ declarations if an error x : Executable in','fo (Win32 only'+ - ')'#000+ + '**2*_b : Show all procedure r ',': Rhide/GCC compatibility mod'+ + 'e'#000+ + '**2*_ declarations if an error x : Executable info (Win32 only)'#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 executable'#000+ - '**2XS_link with static libraries (defines FPC_LINK_S','TATIC)'#000+ + '**2Xs_s','trip 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*2Anasmelf_elf32 (Linux) fil','e using Nasm'#000+ '3*2Anasmobj_obj file using Nasm'#000+ - '3*2Amasm_obj file using Masm (Mircosoft)',#000+ + '3*2Amasm_obj file using Masm (Mircosoft)'#000+ '3*2Atasm_obj file 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*2Rdirect_','copy assembler text directly to assembler file'#000+ '3*1O_optimizations:'#000+ - '3*2Og_generate ','smaller code'#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*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*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 target processor to PPro/PII/c6x86/K6 (tm',')'#000+ + '3*3Op2_set target proc','essor to Pentium/PentiumMMX (tm)'#000+ + '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+ '3*1T_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*2TOS2_OS/2 2.x'#000+ + '3*2TOS2_','OS/2 2.x'#000+ '3*2TWin32_Windows 32 Bit'#000+ '6*1A_output format'#000+ - '6*2Ao_Unix o-file using GNU A','S'#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*2Oa_turn on the optimizer'#000+ - '6*2Og_generate smaller code'#000+ + '6*2Og_gen','erate smaller code'#000+ '6*2OG_generate faster code (default)'#000+ - '6*2Ox_optimize maximum (still',' BUGGY!!!)'#000+ + '6*2Ox_optimize maximum (still BUGGY!!!)'#000+ '6*2O2_set target processor to a MC68020+'#000+ '6*1R_assembler reading style:'#000+ '6*2RMOT_read motorola style assembler'#000+ - '6*1T_Target operating system:'#000+ + '6*1T_Target operating system:',#000+ '6*2TAMIGA_Commodore Amiga'#000+ '6*2TATARI_Atari ST/STe/TT'#000+ '6*2TMACOS_Macintosh m68k'#000+ - '6*2TLIN','UX_Linux-68k'#000+ + '6*2TLINUX_Linux-68k'#000+ '**1*_'#000+ '**1?_shows this help'#000+ '**1h_shows this help without waiting'#000 diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 79a76f2368..8625ab03e7 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -80,7 +80,7 @@ unit pdecl; function read_type(const name : stringid) : pdef;forward; { search in symtablestack used, but not defined type } - procedure testforward_type(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif} + procedure testforward_type(p : pnamedindexobject);{$ifndef FPC}far;{$endif} var reaktvarsymtable : psymtable; oldaktfilepos : tfileposinfo; @@ -1615,12 +1615,6 @@ unit pdecl; genvmt(aktclass); end; -{$ifdef OLDPPU} - { number symbols and defs } - symtablestack^.number_defs; - symtablestack^.number_symbols; -{$endif} - { restore old state } symtablestack:=symtablestack^.next; procinfo._class:=nil; @@ -1655,12 +1649,6 @@ unit pdecl; consume(_END); typecanbeforward:=storetypeforwardsallowed; -{$ifdef OLDPPU} - { number symbols and defs } - symtablestack^.number_defs; - symtablestack^.number_symbols; -{$endif} - symtablestack:=symtable^.next; record_dec:=new(precdef,init(symtable)); end; @@ -2091,7 +2079,6 @@ unit pdecl; getsym(typename,false); sym:=srsym; newtype:=nil; -{$ifndef OLDPPU} { found a symbol with this name? } if assigned(sym) then begin @@ -2122,29 +2109,6 @@ unit pdecl; newtype:=new(ptypesym,init(typename,read_type(typename))); newtype:=ptypesym(symtablestack^.insert(newtype)); end; -{$else} - { check if it is the definition of a forward defined class } - if assigned(srsym) and - (token=_CLASS) and - (srsym^.typ=typesym) and - (assigned(ptypesym(srsym)^.definition)) and - (ptypesym(srsym)^.definition^.deftype=objectdef) and - ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_isforward)<>0) and - ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_is_class)<>0) then - begin - { we can ignore the result } - { the definition is modified } - object_dec(typename,pobjectdef(ptypesym(srsym)^.definition)); - newtype:=ptypesym(srsym); - end - else - begin - newtype:=new(ptypesym,init(typename,read_type(typename))); - { load newtype with the new pointer to the inserted type - because it can be an already defined forwarded type !! } - newtype:=ptypesym(symtablestack^.insert(newtype)); - end; -{$endif} end; consume(SEMICOLON); if assigned(newtype^.definition) and (newtype^.definition^.deftype=procvardef) then @@ -2266,7 +2230,12 @@ unit pdecl; end. { $Log$ - Revision 1.115 1999-05-07 10:36:09 peter + Revision 1.116 1999-05-13 21:59:34 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.115 1999/05/07 10:36:09 peter * fixed crash Revision 1.114 1999/05/04 21:44:54 florian diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 2066857fdd..56fe461dc8 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -318,15 +318,6 @@ unit pmodules; end; { ok, now load the unit } current_module^.globalsymtable:=new(punitsymtable,loadasunit); - { if this is the system unit insert the intern symbols } -{$ifdef OLDPPU} - if compile_system then - begin - make_ref:=false; - insertinternsyms(psymtable(current_module^.globalsymtable)); - make_ref:=true; - end; -{$endif} { now only read the implementation part } current_module^.in_implementation:=true; { load the used units from implementation } @@ -341,10 +332,8 @@ unit pmodules; { register unit in used units } pu^.u:=loaded_unit; pu^.loaded:=true; -{$ifndef OLDPPU} { need to recompile the current unit ? } if loaded_unit^.crc<>pu^.checksum then -{ if (loaded_unit^.interface_crc<>pu^.interface_checksum) then } begin Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^); current_module^.do_compile:=true; @@ -352,7 +341,6 @@ unit pmodules; current_module^.map:=nil; exit; end; -{$endif OLDPPU} { setup the map entry for deref } {$ifndef NEWMAP} current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable; @@ -450,11 +438,9 @@ unit pmodules; begin if hp^.modulename^=s then begin -{$ifndef OLDPPU} { forced to reload ? } if hp^.do_reload then break; -{$endif} { the unit is already registered } { and this means that the unit } { is already compiled } @@ -493,7 +479,7 @@ unit pmodules; loaded_units.remove(hp); scanner:=hp^.scanner; hp^.reset; -{$ifndef OLDPPU} + { now reload all dependent units } hp2:=pmodule(loaded_units.first); while assigned(hp2) do begin @@ -504,7 +490,6 @@ unit pmodules; end; hp2:=pmodule(hp2^.next); end; -{$endif} hp^.scanner:=scanner; { try to reopen ppu } hp^.search_unit(s,false); @@ -629,6 +614,9 @@ unit pmodules; repeat s:=pattern; consume(ID); + { Give a warning if objpas is loaded } + if s='OBJPAS' then + Message(parser_w_no_objpas_use_mode); { check if the unit is already used } pu:=pused_unit(current_module^.used_units.first); while assigned(pu) do @@ -769,23 +757,17 @@ unit pmodules; procedure gen_main_procsym(const name:string;options:longint;st:psymtable); -{$ifndef OLDPPU} var stt : psymtable; -{$endif} begin {Generate a procsym for main} make_ref:=false; aktprocsym:=new(Pprocsym,init(name)); -{$ifndef OLDPPU} {Try to insert in in static symtable ! } stt:=symtablestack; symtablestack:=st; -{$endif} aktprocsym^.definition:=new(Pprocdef,init); -{$ifndef OLDPPU} symtablestack:=stt; -{$endif} aktprocsym^.definition^.options:=aktprocsym^.definition^.options or options; aktprocsym^.definition^.setmangledname(target_os.cprefix+name); aktprocsym^.definition^.forwarddef:=false; @@ -972,12 +954,10 @@ unit pmodules; write_gdb_info; {$endIf Def New_GDB} -{$ifndef OLDPPU} {$ifdef Test_Double_checksum} if (Errorcount=0) then writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true); {$endif Test_Double_checksum} -{$endif OLDPPU} { Parse the implementation section } consume(_IMPLEMENTATION); @@ -994,12 +974,6 @@ unit pmodules; { to reinsert it after loading the implementation units } symtablestack:=unitst^.next; -{$ifdef OLDPPU} - { number the definitions, so a deref from other units works } - refsymtable^.number_defs; - refsymtable^.number_symbols; -{$endif} - { we don't want implementation units symbols in unitsymtable !! PM } refsymtable:=st; @@ -1146,21 +1120,17 @@ unit pmodules; if cs_local_browser in aktmoduleswitches then current_module^.localsymtable:=refsymtable; { Write out the ppufile } -{$ifndef OLDPPU} {$ifdef Test_Double_checksum} store_crc:=current_module^.interface_crc; {$endif Test_Double_checksum} -{$endif} if (Errorcount=0) then writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false); -{$ifndef OLDPPU} {$ifdef Test_Double_checksum} if store_crc<>current_module^.interface_crc then Def_comment(V_Warning,current_module^.ppufilename^+' CRC changed '+ tostr(store_crc)+'<>'+tostr(current_module^.interface_crc)); {$endif def Test_Double_checksum} -{$endif OLDPPU} { must be done only after local symtable ref stores !! } closecurrentppu; {$ifdef GDB} @@ -1372,7 +1342,12 @@ unit pmodules; end. { $Log$ - Revision 1.119 1999-05-09 11:38:08 peter + Revision 1.120 1999-05-13 21:59:35 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.119 1999/05/09 11:38:08 peter * don't write .o and link if errors occure during assembling Revision 1.118 1999/05/03 18:03:28 peter diff --git a/compiler/ppu.pas b/compiler/ppu.pas index a0ff8c9deb..97dabdba86 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -37,11 +37,7 @@ type {$endif Test_Double_checksum} const -{$ifdef OLDPPU} - CurrentPPUVersion=15; -{$else} CurrentPPUVersion=16; -{$endif} { buffer sizes } maxentrysize = 1024; @@ -142,10 +138,8 @@ type flags : longint; size : longint; { size of the ppufile without header } checksum : longint; { checksum for this ppufile } -{$ifndef OLDPPU} interface_checksum : longint; future : array[0..2] of longint; -{$endif} end; tppuentry=packed record @@ -389,11 +383,7 @@ begin Id[3]:='U'; Ver[1]:='0'; Ver[2]:='1'; -{$ifdef OLDPPU} - Ver[3]:='5'; -{$else} Ver[3]:='6'; -{$endif} end; end; @@ -806,7 +796,6 @@ begin if do_crc then begin crc:=UpdateCrc32(crc,b,len); -{$ifndef OLDPPU} if do_interface_crc then begin interface_crc:=UpdateCrc32(interface_crc,b,len); @@ -834,9 +823,6 @@ begin end; end; if not crc_only then -{$else} - end; -{$endif OLDPPU} writedata(b,len); inc(entryidx,len); end; @@ -882,7 +868,12 @@ end; end. { $Log$ - Revision 1.32 1999-05-05 09:19:15 florian + Revision 1.33 1999-05-13 21:59:36 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.32 1999/05/05 09:19:15 florian * more fixes to get it with delphi running Revision 1.31 1999/05/04 21:44:59 florian diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index b5d61296b8..1e90b0f7a5 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -373,11 +373,7 @@ unit pstatmnt; objectdef : begin obj:=pobjectdef(p^.resulttype); withsymtable:=new(pwithsymtable,init); -{$ifndef OLDPPU} withsymtable^.symsearch:=obj^.publicsyms^.symsearch; -{$else} - withsymtable^.searchroot:=obj^.publicsyms^.searchroot; -{$endif} withsymtable^.defowner:=obj; symtab:=withsymtable; {$ifndef NODIRECTWITH} @@ -393,11 +389,7 @@ unit pstatmnt; begin symtab^.next:=new(pwithsymtable,init); symtab:=symtab^.next; -{$ifndef OLDPPU} symtab^.symsearch:=obj^.publicsyms^.symsearch; -{$else} - symtab^.searchroot:=obj^.publicsyms^.searchroot; -{$endif} {$ifndef NODIRECTWITH} if (p^.treetype=loadn) and (p^.symtable=aktprocsym^.definition^.localst) then @@ -416,11 +408,7 @@ unit pstatmnt; symtab:=precdef(p^.resulttype)^.symtable; levelcount:=1; withsymtable:=new(pwithsymtable,init); -{$ifndef OLDPPU} withsymtable^.symsearch:=symtab^.symsearch; -{$else} - withsymtable^.searchroot:=symtab^.searchroot; -{$endif} withsymtable^.next:=symtablestack; {$ifndef NODIRECTWITH} if (p^.treetype=loadn) and @@ -1285,7 +1273,12 @@ unit pstatmnt; end. { $Log$ - Revision 1.83 1999-05-05 22:21:58 peter + Revision 1.84 1999-05-13 21:59:38 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.83 1999/05/05 22:21:58 peter * updated messages Revision 1.82 1999/05/01 13:24:35 peter diff --git a/compiler/ra386.pas b/compiler/ra386.pas index 7078e7b025..df8bf903b4 100644 --- a/compiler/ra386.pas +++ b/compiler/ra386.pas @@ -238,7 +238,7 @@ begin end; end; end; - A_IN,A_OUT : + A_OUT : opsize:=operands[1].size; else opsize:=operands[2].size; @@ -393,7 +393,12 @@ end; end. { $Log$ - Revision 1.4 1999-05-12 00:19:55 peter + Revision 1.5 1999-05-13 21:59:40 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.4 1999/05/12 00:19:55 peter * removed R_DEFAULT_SEG * uniform float names diff --git a/compiler/symdef.inc b/compiler/symdef.inc index c6cfe2ac7d..908d85e299 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -67,12 +67,7 @@ constructor tdef.init; begin -{$ifndef OLDPPU} inherited init; -{$else} - indexnb := 0; - next := nil; -{$endif} deftype:=abstractdef; owner := nil; sym := nil; @@ -124,13 +119,8 @@ lastglobaldef := @self; nextglobal := nil; { load } -{$ifndef OLDPPU} indexnr:=readword; sym:=ptypesym(readsymref); -{$else} - indexnb := 0; - sym:=nil; -{$endif} end; @@ -170,13 +160,7 @@ if assigned(owner) and (owner^.symtabletype in [recordsymtable,objectsymtable]) then begin -{$ifndef OLDPPU} owner^.defindex^.deleteindex(@self); -{$else} - { no other definition - has been inserted !! (PM) } - owner^.rootdef:=next; -{$endif} st:=owner; while (st^.symtabletype in [recordsymtable,objectsymtable]) do st:=st^.next; @@ -223,10 +207,8 @@ procedure tdef.write; begin -{$ifndef OLDPPU} writeword(indexnr); writesymref(sym); -{$endif} {$ifdef GDB} if globalnb = 0 then begin @@ -1402,8 +1384,12 @@ constructor tclassrefdef.load; begin - inherited load; + { be careful, tclassdefref inherits from tpointerdef } + tdef.load; deftype:=classrefdef; + definition:=readdefref; + is_far:=false; + savesize:=target_os.size_of_pointer; end; @@ -1412,7 +1398,6 @@ { be careful, tclassdefref inherits from tpointerdef } tdef.write; writedefref(definition); - writebyte(byte(is_far)); current_ppu^.writeentry(ibclassrefdef); end; @@ -1776,7 +1761,7 @@ var binittable : boolean; - procedure check_rec_inittable(s : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure check_rec_inittable(s : pnamedindexobject); begin if (psym(s)^.typ=varsym) and @@ -1804,28 +1789,12 @@ procedure trecdef.deref; var -{$ifdef OLDPPU} - hp : pdef; -{$endif} oldrecsyms : psymtable; begin oldrecsyms:=aktrecordsymtable; aktrecordsymtable:=symtable; { now dereference the definitions } -{$ifndef OLDPPU} symtable^.deref; -{$else} - hp:=symtable^.rootdef; - while assigned(hp) do - begin - hp^.deref; - { set owner } - hp^.owner:=symtable; - hp:=pdef(hp^.next); - end; - - symtable^.foreach({$ifdef fpc}@{$endif}derefsym); -{$endif} aktrecordsymtable:=oldrecsyms; end; @@ -1849,7 +1818,7 @@ StabRecSize : longint = 0; RecOffset : Longint = 0; - procedure addname(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure addname(p : pnamedindexobject); var news, newrec : pchar; spec : string[2]; @@ -1893,9 +1862,6 @@ function trecdef.stabstring : pchar; Var oldrec : pchar; oldsize : longint; -{$ifdef OLDPPU} - cur : psym; -{$endif} begin oldrec := stabrecstring; oldsize:=stabrecsize; @@ -1903,16 +1869,7 @@ stabrecsize:=memsizeinc; strpcopy(stabRecString,'s'+tostr(savesize)); RecOffset := 0; -{$ifndef OLDPPU} symtable^.foreach({$ifdef fpc}@{$endif}addname); -{$else} - cur:=symtable^.searchroot; - while assigned(cur) do - begin - addname(cur); - cur:=cur^.nextsym; - end; -{$endif} { FPC doesn't want to convert a char to a pchar} { is this a bug ? } strpcopy(strend(StabRecString),';'); @@ -1934,7 +1891,7 @@ var count : longint; - procedure count_inittable_fields(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} + procedure count_inittable_fields(sym : pnamedindexobject);{$ifndef fpc}far;{$endif} begin if (psym(sym)^.typ=varsym) and (pvarsym(sym)^.definition^.needs_inittable) then @@ -1942,13 +1899,13 @@ end; - procedure count_fields(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} + procedure count_fields(sym : pnamedindexobject);{$ifndef fpc}far;{$endif} begin inc(count); end; - procedure write_field_inittable(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} + procedure write_field_inittable(sym : pnamedindexobject);{$ifndef fpc}far;{$endif} begin if (psym(sym)^.typ=varsym) and pvarsym(sym)^.definition^.needs_inittable then @@ -1959,14 +1916,14 @@ end; - procedure write_field_rtti(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} + procedure write_field_rtti(sym : pnamedindexobject);{$ifndef fpc}far;{$endif} begin rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.definition^.get_rtti_label))); rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address))); end; - procedure generate_child_inittable(sym:{$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} + procedure generate_child_inittable(sym:pnamedindexobject);{$ifndef fpc}far;{$endif} begin if (psym(sym)^.typ=varsym) and pvarsym(sym)^.definition^.needs_inittable then @@ -1975,7 +1932,7 @@ end; - procedure generate_child_rtti(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} + procedure generate_child_rtti(sym : pnamedindexobject);{$ifndef fpc}far;{$endif} begin pvarsym(sym)^.definition^.get_rtti_label; end; @@ -2147,13 +2104,8 @@ begin inherited write; writedefref(retdef); -{$ifndef OLDPPU} current_ppu^.do_interface_crc:=false; -{$endif} writebyte(fpu_used); -{$ifdef OLDPPU} - current_ppu^.do_interface_crc:=true; -{$endif} writelong(options); hp:=para1; count:=0; @@ -2503,9 +2455,7 @@ Const local_symtable_index : longint = $8001; procedure tprocdef.write; begin inherited write; -{$ifndef OLDPPU} current_ppu^.do_interface_crc:=false; -{$endif} {$ifdef i386} writebyte(usedregisters); {$endif i386} @@ -2517,9 +2467,7 @@ Const local_symtable_index : longint = $8001; writelong(usedregisters_fpu); {$endif alpha} writestring(mangledname); -{$ifndef OLDPPU} current_ppu^.do_interface_crc:=true; -{$endif} writelong(extnumber); if (options and pooperator) = 0 then writedefref(nextoverloaded) @@ -2550,11 +2498,7 @@ Const local_symtable_index : longint = $8001; function tprocdef.haspara:boolean; begin -{$ifndef OLDPPU} haspara:=assigned(aktprocsym^.definition^.parast^.symindex^.first); -{$else} - haspara:=assigned(aktprocsym^.definition^.parast^.searchroot); -{$endif} end; @@ -2981,28 +2925,12 @@ Const local_symtable_index : longint = $8001; procedure tobjectdef.deref; var -{$ifdef OLDPPU} - hp : pdef; -{$endif} oldrecsyms : psymtable; begin resolvedef(pdef(childof)); oldrecsyms:=aktrecordsymtable; aktrecordsymtable:=publicsyms; - -{$ifndef OLDPPU} publicsyms^.deref; -{$else} - hp:=publicsyms^.rootdef; - while assigned(hp) do - begin - hp^.deref; - { set owner } - hp^.owner:=publicsyms; - hp:=pdef(hp^.next); - end; - publicsyms^.foreach({$ifdef fpc}@{$endif}derefsym); -{$endif} aktrecordsymtable:=oldrecsyms; end; @@ -3071,7 +2999,7 @@ Const local_symtable_index : longint = $8001; {$ifdef GDB} - procedure addprocname(p :{$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure addprocname(p :pnamedindexobject); var virtualind,argnames : string; news, newrec : pchar; pd,ipd : pprocdef; @@ -3163,9 +3091,6 @@ Const local_symtable_index : longint = $8001; oldrec : pchar; oldrecsize : longint; str_end : string; -{$ifdef OLDPPU} - cur : psym; -{$endif} begin oldrec := stabrecstring; oldrecsize:=stabrecsize; @@ -3178,40 +3103,22 @@ Const local_symtable_index : longint = $8001; strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';'); {virtual table to implement yet} RecOffset := 0; -{$ifndef OLDPPU} {$ifdef tp} publicsyms^.foreach(addname); {$else} publicsyms^.foreach(@addname); {$endif} -{$else} - cur:=publicsyms^.searchroot; - while assigned(cur) do - begin - addname(cur); - cur:=psym(cur)^.nextsym; - end; -{$endif} if (options and oo_hasvmt) <> 0 then if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then begin strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray') +','+tostr(vmt_offset*8)+';'); end; -{$ifndef OLDPPU} {$ifdef tp} publicsyms^.foreach(addprocname); {$else} publicsyms^.foreach(@addprocname); {$endif tp } -{$else} - cur:=publicsyms^.searchroot; - while assigned(cur) do - begin - addprocname(cur); - cur:=psym(cur)^.nextsym; - end; -{$endif} if (options and oo_hasvmt) <> 0 then begin anc := @self; @@ -3270,7 +3177,7 @@ Const local_symtable_index : longint = $8001; end; - procedure count_published_properties(sym:{$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure count_published_properties(sym:pnamedindexobject); {$ifndef fpc}far;{$endif} begin if (psym(sym)^.typ=propertysym) and ((psym(sym)^.properties and sp_published)<>0) then @@ -3278,7 +3185,7 @@ Const local_symtable_index : longint = $8001; end; - procedure write_property_info(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} + procedure write_property_info(sym : pnamedindexobject);{$ifndef fpc}far;{$endif} var proctypesinfo : byte; @@ -3346,7 +3253,7 @@ Const local_symtable_index : longint = $8001; end; - procedure generate_published_child_rtti(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure generate_published_child_rtti(sym : pnamedindexobject); {$ifndef fpc}far;{$endif} begin if (psym(sym)^.typ=propertysym) and @@ -3473,7 +3380,12 @@ Const local_symtable_index : longint = $8001; { $Log$ - Revision 1.113 1999-05-12 00:19:58 peter + Revision 1.114 1999-05-13 21:59:41 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.113 1999/05/12 00:19:58 peter * removed R_DEFAULT_SEG * uniform float names diff --git a/compiler/symdefh.inc b/compiler/symdefh.inc index b164002496..ac2e25309a 100644 --- a/compiler/symdefh.inc +++ b/compiler/symdefh.inc @@ -31,16 +31,9 @@ classrefdef); pdef = ^tdef; -{$ifndef OLDPPU} - tdef = object(tnamedindexobject) -{$else} - tdef = object - indexnb : longint; - next : pdef; -{$endif} + tdef = object(tsymtableentry) deftype : tdeftype; savesize : longint; - owner : psymtable; sym : ptypesym; { which type the definition was generated this def } has_inittable : boolean; @@ -510,7 +503,12 @@ { $Log$ - Revision 1.26 1999-05-12 00:19:59 peter + Revision 1.27 1999-05-13 21:59:42 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.26 1999/05/12 00:19:59 peter * removed R_DEFAULT_SEG * uniform float names diff --git a/compiler/symppu.inc b/compiler/symppu.inc index a3cec0a263..e5e5a961de 100644 --- a/compiler/symppu.inc +++ b/compiler/symppu.inc @@ -103,6 +103,57 @@ end; +{$ifndef OLDDEREF} + procedure writederef(p : psymtableentry); + begin + if p=nil then + current_ppu^.putbyte(ord(derefnil)) + else + begin + { Static symtable ? } + if p^.owner^.symtabletype=staticsymtable then + begin + current_ppu^.putbyte(ord(derefaktstatic)); + current_ppu^.putword(p^.indexnr); + end + { Local record/object symtable ? } + else if (p^.owner=aktrecordsymtable) then + begin + current_ppu^.putbyte(ord(derefaktrecord)); + current_ppu^.putword(p^.indexnr); + end + else +{ else if p^.owner^.unitid>$8000 then + current_ppu^.putword(p^.owner^.unitid) } + begin + current_ppu^.putbyte(ord(dereflocal)); + current_ppu^.putword(p^.indexnr); + { Current unit symtable ? } + repeat + if not assigned(p) then + internalerror(556655); + case p^.owner^.symtabletype of + unitsymtable : + begin + current_ppu^.putbyte(ord(derefunit)); + current_ppu^.putword(p^.owner^.unitid); + break; + end; + objectsymtable, + recordsymtable : + begin + current_ppu^.putbyte(ord(derefrecord)); + current_ppu^.putword(p^.indexnr); + p:=p^.owner^.defowner; + end; + else + internalerror(556656); + end; + until false; + end; + end; + end; +{$else} procedure writedefref(p : pdef); begin if p=nil then @@ -117,15 +168,10 @@ current_ppu^.putword(p^.owner^.unitid) else current_ppu^.putword(p^.owner^.unitid); -{$ifndef OLDPPU} current_ppu^.putword(p^.indexnr); -{$else} - current_ppu^.putword(p^.indexnb); -{$endif} end; end; - procedure writesymref(p : psym); begin if p=nil then @@ -140,13 +186,11 @@ current_ppu^.putword(p^.owner^.unitid) else current_ppu^.putword(p^.owner^.unitid); -{$ifndef OLDPPU} current_ppu^.putword(p^.indexnr); -{$else} - current_ppu^.putword(p^.indexnb); -{$endif} end; end; +{$endif} + procedure writesourcefiles; @@ -180,9 +224,7 @@ { the checksum should not affect the crc of this unit ! (PFV) } current_ppu^.do_crc:=false; current_ppu^.putlongint(hp^.checksum); -{$ifndef OLDPPU} current_ppu^.putlongint(hp^.interface_checksum); -{$endif} current_ppu^.do_crc:=true; current_ppu^.putbyte(byte(hp^.in_interface)); hp:=pused_unit(hp^.next); @@ -254,9 +296,7 @@ { create and write header } current_ppu^.header.size:=current_ppu^.size; current_ppu^.header.checksum:=current_ppu^.crc; -{$ifndef OLDPPU} current_ppu^.header.interface_checksum:=current_ppu^.interface_crc; -{$endif} current_ppu^.header.compiler:=wordversion; current_ppu^.header.cpu:=word(target_cpu); current_ppu^.header.target:=word(target_info.target); @@ -359,6 +399,42 @@ end; +{$ifndef OLDDEREF} + function readderef : pderef; + var + hp,p : pderef; + b : tdereftype; + begin + p:=nil; + repeat + hp:=p; + b:=tdereftype(current_ppu^.getbyte); + case b of + derefnil : + break; + derefunit, + derefaktrecord, + derefaktstatic : + begin + new(p); + p^.dereftype:=b; + p^.index:=current_ppu^.getword; + p^.next:=hp; + break; + end; + dereflocal, + derefrecord : + begin + new(p); + p^.dereftype:=derefrecord; + p^.index:=current_ppu^.getword; + p^.next:=hp; + end; + end; + until false; + readderef:=p; + end; +{$else} function readdefref : pdef; var hd : pdef; @@ -377,6 +453,7 @@ longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16); readsymref:=hd; end; +{$endif} procedure readsourcefiles; @@ -472,11 +549,7 @@ begin hs:=current_ppu^.getstring; checksum:=current_ppu^.getlongint; -{$ifndef OLDPPU} intfchecksum:=current_ppu^.getlongint; -{$else} - intfchecksum:=0; -{$endif} in_interface:=(current_ppu^.getbyte<>0); current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,intfchecksum,in_interface))); end; @@ -510,7 +583,12 @@ { $Log$ - Revision 1.39 1999-05-04 21:45:06 florian + Revision 1.40 1999-05-13 21:59:44 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.39 1999/05/04 21:45:06 florian * changes to compile it with Delphi 4.0 Revision 1.38 1999/04/26 13:31:51 peter diff --git a/compiler/symsym.inc b/compiler/symsym.inc index 6e58a0db5c..17318e4fb7 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -26,17 +26,7 @@ constructor tsym.init(const n : string); begin -{$ifndef OLDPPU} inherited initname(n); -{$else} - left:=nil; - right:=nil; - setname(n); - indexnb:=0; - {$ifdef nextfield} - nextsym:=nil; - {$endif nextfield} -{$endif} typ:=abstractsym; properties:=current_object_option; {$ifdef GDB} @@ -57,17 +47,12 @@ constructor tsym.load; begin -{$ifndef OLDPPU} inherited init; indexnr:=readword; -{$else} - left:=nil; - right:=nil; -{$endif} setname(readstring); typ:=abstractsym; - fillchar(fileinfo,sizeof(fileinfo),0); properties:=symprop(readbyte); + readposinfo(fileinfo); lastref:=nil; defref:=nil; lastwritten:=nil; @@ -161,28 +146,16 @@ begin if assigned(defref) then dispose(defref,done); -{$ifndef OLDPPU} inherited done; -{$else} - {$ifdef tp} - if not(use_big) then - {$endif tp} - strdispose(_name); - if assigned(left) then - dispose(left,done); - if assigned(right) then - dispose(right,done); -{$endif} end; procedure tsym.write; begin -{$ifndef OLDPPU} writeword(indexnr); -{$endif} writestring(name); writebyte(byte(properties)); + writeposinfo(fileinfo); end; @@ -191,37 +164,6 @@ end; -{$ifdef OLDPPU} - function tsym.name : string; - {$ifdef tp} - var - s : string; - b : byte; - {$endif} - begin - {$ifdef tp} - if use_big then - begin - symbolstream.seek(longint(_name)); - symbolstream.read(b,1); - symbolstream.read(s[1],b); - s[0]:=chr(b); - name:=s; - end - else - {$endif} - if assigned(_name) then - name:=strpas(_name) - else - name:=''; - end; - - procedure tsym.setname(const s : string); - begin - setstring(_name,s); - end; -{$endif} - function tsym.mangledname : string; begin mangledname:=name; @@ -1981,11 +1923,9 @@ procedure tsyssym.write; begin -{$ifndef OLDPPU} tsym.write; writelong(number); current_ppu^.writeentry(ibsyssym); -{$endif} end; {$ifdef GDB} @@ -2018,7 +1958,12 @@ { $Log$ - Revision 1.88 1999-05-10 09:01:43 peter + Revision 1.89 1999-05-13 21:59:45 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.88 1999/05/10 09:01:43 peter * small message fixes Revision 1.87 1999/05/08 19:52:38 peter diff --git a/compiler/symsymh.inc b/compiler/symsymh.inc index cf0e9c8dc8..f3ea0b1dd8 100644 --- a/compiler/symsymh.inc +++ b/compiler/symsymh.inc @@ -34,19 +34,9 @@ { this object is the base for all symbol objects } psym = ^tsym; -{$ifndef OLDPPU} - tsym = object(tnamedindexobject) -{$else} - tsym = object - indexnb : longint; - _name : pchar; - left,right : psym; - speedvalue : longint; - nextsym : psym; -{$endif} + tsym = object(tsymtableentry) typ : tsymtyp; properties : symprop; - owner : psymtable; fileinfo : tfileposinfo; {$ifdef GDB} isstabwritten : boolean; @@ -60,10 +50,6 @@ destructor done;virtual; procedure write;virtual; procedure deref;virtual; -{$ifdef OLDPPU} - function name : string; - procedure setname(const s : string); -{$endif} function mangledname : string;virtual; procedure insert_in_data;virtual; {$ifdef GDB} @@ -344,7 +330,12 @@ { $Log$ - Revision 1.22 1999-04-26 13:31:53 peter + Revision 1.23 1999-05-13 21:59:47 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.22 1999/04/26 13:31:53 peter * release storenumber,double_checksum Revision 1.21 1999/04/25 22:38:40 pierre diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 8603b6dd1c..69415b960f 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -24,6 +24,8 @@ {$endif} unit symtable; +{$define OLDDEREF} + interface uses @@ -51,25 +53,17 @@ unit symtable; {$endif} ; -{$ifdef OLDPPU} - {define NOLOCALBROWSER if you have problems with -bl option } -{$endif} - {************************************************ Some internal constants ************************************************} const hasharraysize = 256; -{$ifndef OLDPPU} {$ifdef TP} indexgrowsize = 256; {$else} indexgrowsize = 1024; {$endif} -{$else} - defhasharraysize = 16000; -{$endif} {************************************************ @@ -102,6 +96,21 @@ unit symtable; destructor done; virtual; end; + { Deref entry options } + tdereftype = (derefnil,derefaktrecord,derefaktstatic,derefunit,derefrecord,dereflocal); + + pderef = ^tderef; + tderef = record + dereftype : tdereftype; + index : word; + next : pderef; + end; + + psymtableentry = ^tsymtableentry; + tsymtableentry = object(tnamedindexobject) + owner : psymtable; + end; + {************************************************ TDef ************************************************} @@ -130,35 +139,17 @@ unit symtable; tcallback = procedure(p : psym); -{$ifdef OLDPPU} - tnamedindexcallback = procedure(p : psym); -{$endif} - tsearchhasharray = array[0..hasharraysize-1] of psym; psearchhasharray = ^tsearchhasharray; -{$ifdef OLDPPU} - tdefhasharray = array[0..defhasharraysize-1] of pdef; - pdefhasharray = ^tdefhasharray; -{$endif} - tsymtable = object symtabletype : tsymtabletype; unitid : word; { each symtable gets a number } name : pstring; datasize : longint; -{$ifndef OLDPPU} symindex, defindex : pindexarray; symsearch : pdictionary; -{$else} - searchroot : psym; - searchhasharray : psearchhasharray; - lastsym : psym; - rootdef : pdef; - defhasharraysize : longint; - defhasharray : pdefhasharray; -{$endif} next : psymtable; defowner : pdef; { for records and objects } { alignment used in this symtable } @@ -172,12 +163,6 @@ unit symtable; constructor init(t : tsymtabletype); destructor done;virtual; { access } -{$ifdef OLDPPU} - { indexes all defs from 0 to num and return num + 1 } - function number_defs:longint; - { indexes all symbols from 1 to num and return num } - function number_symbols:longint; -{$endif} function getdefnr(l : longint) : pdef; function getsymnr(l : longint) : psym; { load/write } @@ -189,9 +174,7 @@ unit symtable; procedure loadsyms; procedure writedefs; procedure writesyms; -{$ifndef OLDPPU} procedure deref; -{$endif} procedure clear; function rename(const olds,news : stringid):psym; procedure foreach(proc2call : tnamedindexcallback); @@ -235,9 +218,6 @@ unit symtable; destructor done;virtual; procedure writeasunit; {$ifdef GDB} -{$ifdef OLDPPU} - procedure orderdefs; -{$endif} procedure concattypestabto(asmlist : paasmoutput); {$endif GDB} procedure load_symtable_refs; @@ -664,6 +644,122 @@ const localsymtablestack : psymtable = nil; find_local_symtable:=p; end; +{$ifndef OLDDEREF} + function resolvedef(var p:pderef):pdef; + var + st : psymtable; + idx : longint; + hp : pderef; + pd : pdef; + begin + st:=nil; + idx:=-1; + while assigned(p) do + begin + case p^.dereftype of + derefaktrecord : + begin + st:=aktrecordsymtable; + idx:=p^.index; + end; + derefaktstatic : + begin + st:=aktstaticsymtable; + idx:=p^.index + end; + derefunit : + begin +{$ifdef NEWMAP} + st:=psymtable(current_module^.map^[p^.index]^.globalsymtable); +{$else NEWMAP} + st:=psymtable(current_module^.map^[p^.index]); +{$endif NEWMAP} + end; + derefrecord : + begin + pd:=st^.getdefnr(p^.index); + case pd^.deftype of + recorddef : + st:=precdef(pd)^.symtable; + objectdef : + st:=pobjectdef(pd)^.publicsyms; + else + internalerror(556658); + end; + end; + dereflocal : + begin + idx:=p^.index; + end; + end; + hp:=p; + p:=p^.next; + dispose(hp); + end; + if assigned(st) then + resolvedef:=st^.getdefnr(idx) + else + resolvedef:=nil; + end; + + + function resolvesym(var p:pderef):psym; + var + st : psymtable; + idx : longint; + hp : pderef; + pd : pdef; + begin + st:=nil; + idx:=-1; + while assigned(p) do + begin + case p^.dereftype of + derefaktrecord : + begin + st:=aktrecordsymtable; + idx:=p^.index; + end; + derefaktstatic : + begin + st:=aktstaticsymtable; + idx:=p^.index + end; + derefunit : + begin +{$ifdef NEWMAP} + st:=psymtable(current_module^.map^[p^.index]^.globalsymtable); +{$else NEWMAP} + st:=psymtable(current_module^.map^[p^.index]); +{$endif NEWMAP} + end; + derefrecord : + begin + pd:=st^.getdefnr(p^.index); + case pd^.deftype of + recorddef : + st:=precdef(pd)^.symtable; + objectdef : + st:=pobjectdef(pd)^.publicsyms; + else + internalerror(556658); + end; + end; + dereflocal : + begin + idx:=p^.index; + end; + end; + hp:=p; + p:=p^.next; + dispose(hp); + end; + if assigned(st) then + resolvesym:=st^.getsymnr(idx) + else + resolvesym:=nil; + end; +{$else} procedure resolvesym(var d : psym); begin if longint(d)=-1 then @@ -707,31 +803,25 @@ const localsymtablestack : psymtable = nil; {$endif NEWMAP} end; end; +{$endif} {***************************************************************************** Symbol Call Back Functions *****************************************************************************} -{$ifdef OLDPPU} - procedure writesym(p : psym); - begin - p^.write; - end; -{$endif} - - procedure derefsym(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure derefsym(p : pnamedindexobject); begin psym(p)^.deref; end; - procedure derefsymsdelayed(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure derefsymsdelayed(p : pnamedindexobject); begin if psym(p)^.typ in [absolutesym,propertysym] then psym(p)^.deref; end; - procedure check_procsym_forward(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure check_procsym_forward(sym : pnamedindexobject); begin if psym(sym)^.typ=procsym then pprocsym(sym)^.check_forward @@ -745,21 +835,21 @@ const localsymtablestack : psymtable = nil; pobjectdef(ptypesym(sym)^.definition)^.check_forwards; end; - procedure labeldefined(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure labeldefined(p : pnamedindexobject); begin if (psym(p)^.typ=labelsym) and not(plabelsym(p)^.defined) then Message1(sym_w_label_not_defined,p^.name); end; - procedure unitsymbolused(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure unitsymbolused(p : pnamedindexobject); begin if (psym(p)^.typ=unitsym) and (punitsym(p)^.refs=0) then comment(V_info,'Unit '+p^.name+' is not used'); end; - procedure varsymbolused(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure varsymbolused(p : pnamedindexobject); begin if (psym(p)^.typ=varsym) and ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then @@ -781,13 +871,13 @@ const localsymtablestack : psymtable = nil; end; {$ifdef GDB} - procedure concatstab(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure concatstab(p : pnamedindexobject); begin if psym(p)^.typ <> procsym then psym(p)^.concatstabto(asmoutput); end; - procedure concattypestab(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure concattypestab(p : pnamedindexobject); begin if psym(p)^.typ = typesym then begin @@ -836,7 +926,7 @@ const localsymtablestack : psymtable = nil; end; {$endif} - procedure write_refs(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif}); + procedure write_refs(sym : pnamedindexobject); begin psym(sym)^.write_references; end; @@ -988,7 +1078,6 @@ const localsymtablestack : psymtable = nil; name:=nil; address_fixup:=0; datasize:=0; -{$ifndef OLDPPU} new(symindex,init(indexgrowsize)); new(defindex,init(indexgrowsize)); if symtabletype<>withsymtable then @@ -998,29 +1087,13 @@ const localsymtablestack : psymtable = nil; end else symsearch:=nil; -{$else} - lastsym:=nil; - rootdef:=nil; - defhasharray:=nil; - defhasharraysize:=0; - searchroot:=nil; - searchhasharray:=nil; -{$endif} alignment:=def_alignment; end; destructor tsymtable.done; -{$ifdef OLDPPU} - var - hp : pdef; - {$ifdef GDB} - last : pdef; - {$endif GDB} -{$endif} begin stringdispose(name); -{$ifndef OLDPPU} dispose(symindex,done); dispose(defindex,done); { symsearch can already be disposed or set to nil for withsymtable } @@ -1029,39 +1102,6 @@ const localsymtablestack : psymtable = nil; dispose(symsearch,done); symsearch:=nil; end; -{$else} - if assigned(defhasharray) then - begin - freemem(defhasharray,sizeof(pdef)*defhasharraysize); - defhasharray:=nil; - end; - { clear all entries, pprocsyms have still the definitions left } - clear; - {$ifdef GDB} - last := Nil; - {$endif GDB} - hp:=rootdef; - while assigned(hp) do - begin - {$ifdef GDB} - if hp^.owner=@self then - begin - if assigned(last) then - last^.next := hp^.next; - {$endif GDB} - rootdef:=hp^.next; - dispose(hp,done); - {$ifdef GDB} - end - else - begin - last := hp; - rootdef:=hp^.next; - end; - {$endif GDB} - hp:=rootdef; - end; -{$endif} end; @@ -1078,9 +1118,7 @@ const localsymtablestack : psymtable = nil; destructor twithsymtable.done; begin -{$ifndef OLDPPU} symsearch:=nil; -{$endif} inherited done; end; @@ -1097,100 +1135,17 @@ const localsymtablestack : psymtable = nil; procedure tsymtable.registerdef(p : pdef); begin -{$ifndef OLDPPU} defindex^.insert(p); -{$else} - p^.next:=rootdef; - rootdef:=p; -{$endif} { set def owner and indexnb } p^.owner:=@self; end; -{$ifndef OLDPPU} procedure tsymtable.foreach(proc2call : tnamedindexcallback); begin symindex^.foreach(proc2call); end; -{$else} - - procedure tsymtable.foreach(proc2call : tnamedindexcallback); - - procedure a(p : psym); - { must be preorder, because it's used by reading in } - { a PPU file } - { what does this mean ? I need to index - so proc2call must be after left and before right !! PM } - begin - proc2call(p); - if assigned(p^.left) then - a(p^.left); - if assigned(p^.right) then - a(p^.right); - end; - - var - i : longint; - begin - if assigned(searchhasharray) then - begin - for i:=0 to hasharraysize-1 do - if assigned(searchhasharray^[i]) then - a(searchhasharray^[i]); - end - else - if assigned(searchroot) then - a(searchroot); - end; - -{$endif} - -{$ifdef OLDPPU} - - function tsymtable.number_defs:longint; - var - pd : pdef; - counter : longint; - begin - counter:=0; - pd:=rootdef; - while assigned(pd) do - begin - pd^.indexnb:=counter; - inc(counter); - pd:=pd^.next; - end; - number_defs:=counter; - end; - - - var symtable_index : longint; - - procedure numbersym(p : psym); - - begin - p^.indexnb:=symtable_index; - inc(symtable_index); - end; - - - function tsymtable.number_symbols:longint; - var old_nr : longint; - begin - old_nr:=symtable_index; - symtable_index:=1; - {$ifdef tp} - foreach(numbersym); - {$else} - foreach(@numbersym); - {$endif} - number_symbols:=symtable_index-1; - symtable_index:=old_nr; - end; -{$endif} - {*********************************************** LOAD / WRITE SYMTABLE FROM PPU @@ -1198,31 +1153,14 @@ const localsymtablestack : psymtable = nil; procedure tsymtable.loaddefs; var -{$ifdef OLDPPU} - counter : longint; - last : pdef; -{$endif} hp : pdef; b : byte; begin { load start of definition section, which holds the amount of defs } if current_ppu^.readentry<>ibstartdefs then Message(unit_f_ppu_read_error); -{$ifdef OLDPPU} - if symtabletype=unitsymtable then - begin - defhasharraysize:=current_ppu^.getlongint; - getmem(defhasharray,sizeof(pdef)*defhasharraysize); - fillchar(defhasharray^,sizeof(pdef)*defhasharraysize,0); - end - else -{$endif} - current_ppu^.getlongint; + current_ppu^.getlongint; { read definitions } -{$ifdef OLDPPU} - counter:=0; - rootdef:=nil; -{$endif} repeat b:=current_ppu^.readentry; case b of @@ -1248,35 +1186,9 @@ const localsymtablestack : psymtable = nil; else Message1(unit_f_ppu_invalid_entry,tostr(b)); end; -{$ifndef OLDPPU} hp^.owner:=@self; defindex^.insert(hp); -{$else} - { each def gets a number } - hp^.indexnb:=counter; - if counter=0 then - begin - rootdef:=hp; - last:=hp; - end - else - begin - last^.next:=hp; - last:=hp; - end; - if assigned(defhasharray) then - begin - if counterl) then - break - else - hp:=searchhasharray^[i]; - end - else - hp:=searchroot; - { hp has an index that is <= l } - { if hp's index = l we found } - { if hp^.right exists and is also <= l } - { the sym is in the right branch } - { else in the left } - while assigned(hp) do - begin - if hp^.indexnb=l then - begin - getsymnr:=hp; - exit; - end - else if assigned(hp^.right) and (hp^.right^.indexnb<=l) then - hp:=hp^.right - else - hp:=hp^.left; - end; - InternalError(10999); - end; - - - function tsymtable.getdefnr(l : longint) : pdef; - var - hp : pdef; - begin - if assigned(defhasharray) and - (ll) do - hp:=hp^.next; - if assigned(defhasharray) and - (ldefhasharray^[l]) then - InternalError(10998); -{$endif debug} - end; - if assigned(hp) then - getdefnr:=hp - else - InternalError(10998); - end; - -{$endif} {*********************************************** Table Access ***********************************************} -{$ifndef OLDPPU} - procedure tsymtable.clear; begin { remove no entry from a withsymtable as it is only a pointer to the @@ -1899,450 +1620,6 @@ const localsymtablestack : psymtable = nil; rename:=psym(symsearch^.rename(olds,news)); end; -{$else} - - - procedure tsymtable.clear; - var - w : longint; - begin - { remove no entry from a withsymtable as it is only a pointer to the - recorddef or objectdef symtable } - if symtabletype=withsymtable then - exit; - { remove all entry from a symbol table } - if assigned(searchroot) then - begin - dispose(searchroot,done); - searchroot:=nil; - end; - if assigned(searchhasharray) then - begin - for w:=0 to hasharraysize-1 do - if assigned(searchhasharray^[w]) then - begin - dispose(searchhasharray^[w],done); - searchhasharray^[w]:=nil; - end; - dispose(searchhasharray); - searchhasharray:=nil; - end; - end; - - - function tsymtable.insert(sym:psym):psym; - var - ref : pref; - - function _insert(var osym : psym):psym; - {To prevent TP from allocating temp space for temp strings, we allocate - some temp strings manually. We can use two temp strings, plus a third - one that TP adds, where TP alone needs five temp strings!. Storing - these on the heap saves even more, totally 1016 bytes per recursion!} - var - s1,s2:^string; - lasthfp,hfp : pforwardpointer; - begin - if osym=nil then - begin - osym:=sym; - _insert:=osym; -{$ifndef nonextfield} - if assigned(lastsym) then - lastsym^.nextsym:=sym; - lastsym:=sym; -{$endif} - end - - { first check speedvalue, to allow a fast insert } - else - if osym^.speedvalue>sym^.speedvalue then - _insert:=_insert(psym(osym^.right)) - else - if osym^.speedvalues2^ then - begin - dispose(s2); - dispose(s1); - _insert:=_insert(psym(osym^.right)); - end - else - if s1^typesym) then - Message(sym_f_id_already_typed); - { - if (ptypesym(sym)^.definition^.deftype<>recorddef) and - (ptypesym(sym)^.definition^.deftype<>objectdef) then - Message(sym_f_type_must_be_rec_or_class); - } - ptypesym(osym)^.definition:=ptypesym(sym)^.definition; - osym^.properties:=sp_public; - { resolve the definition right now !! } - {forward types have two defref chained - the first corresponding to the location - of the - ptype = ^ttype; - and the second - to the line - ttype = record } - if cs_browser in aktmoduleswitches then - begin - new(ref,init(nil,@sym^.fileinfo)); - ref^.nextref:=osym^.defref; - osym^.defref:=ref; - end; - - { update all forwardpointers to this definition } - hfp:=ptypesym(osym)^.forwardpointer; - while assigned(hfp) do - begin - lasthfp:=hfp; - hfp^.def^.definition:=ptypesym(osym)^.definition; - hfp:=hfp^.next; - dispose(lasthfp); - end; - - if ptypesym(osym)^.definition^.sym = ptypesym(sym) then - ptypesym(osym)^.definition^.sym := ptypesym(osym); -{$ifdef GDB} - ptypesym(osym)^.isusedinstab := true; - if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) then - osym^.concatstabto(debuglist); -{$endif GDB} - { don't do a done on sym - because it also disposes left and right !! - sym is new so it has no left nor right } - dispose(sym,done); - _insert:=osym; - end - else - begin - DuplicateSym(sym); - _insert:=osym; - end; - end; - end; - end; - - var - hp : psymtable; - hsym : psym; - begin - { set owner and sym indexnb } - sym^.owner:=@self; -{$ifdef CHAINPROCSYMS} - { set the nextprocsym field } - if sym^.typ=procsym then - chainprocsym(sym); -{$endif CHAINPROCSYMS} - { writes the symbol in data segment if required } - { also sets the datasize of owner } - if not in_loading then - sym^.insert_in_data; - if (symtabletype in [staticsymtable,globalsymtable]) then - begin - hp:=symtablestack; - while assigned(hp) do - begin - if hp^.symtabletype in [staticsymtable,globalsymtable] then - begin - hsym:=hp^.search(sym^.name); - if (assigned(hsym)) and - (hsym^.properties and sp_forwarddef=0) then - DuplicateSym(hsym); - end; - hp:=hp^.next; - end; - end; - - { check for duplicate id in local and parsymtable symtable } - if (symtabletype=localsymtable) then - { to be on the sure side: } - begin - if assigned(next) and - (next^.symtabletype=parasymtable) then - begin - hsym:=next^.search(sym^.name); - if assigned(hsym) then - DuplicateSym(hsym); - end - else if (current_module^.flags and uf_local_browser)=0 then - internalerror(43789); - end; - - { check for duplicate id in local symtable of methods } - if (symtabletype=localsymtable) and - assigned(next) and - assigned(next^.next) and - { funcretsym is allowed !! } - (sym^.typ <> funcretsym) and - (next^.next^.symtabletype=objectsymtable) then - begin - hsym:=search_class_member(pobjectdef(next^.next^.defowner),sym^.name); - { but private ids can be reused } - if assigned(hsym) and - ((hsym^.properties<>sp_private) or - (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then - DuplicateSym(hsym); - end; - { check for duplicate field id in inherited classes } - if (sym^.typ=varsym) and - (symtabletype=objectsymtable) and - assigned(defowner) then - begin - hsym:=search_class_member(pobjectdef(defowner),sym^.name); - { but private ids can be reused } - if assigned(hsym) and - ((hsym^.properties<>sp_private) or - (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then - DuplicateSym(hsym); - end; - - if sym^.typ = typesym then - if assigned(ptypesym(sym)^.definition) then - begin - if not assigned(ptypesym(sym)^.definition^.owner) then - registerdef(ptypesym(sym)^.definition); -{$ifdef GDB} - if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) - and (symtabletype in [globalsymtable,staticsymtable]) then - begin - ptypesym(sym)^.isusedinstab := true; - sym^.concatstabto(debuglist); - end; -{$endif GDB} - end; - sym^.speedvalue:=getspeedvalue(sym^.name); - if assigned(searchhasharray) then - insert:=_insert(searchhasharray^[sym^.speedvalue mod hasharraysize]) - else - insert:=_insert(searchroot); - { store the sym also in the index, must be after the insert the table - because } - end; - - - function tsymtable.search(const s : stringid) : psym; - begin - search:=speedsearch(s,getspeedvalue(s)); - end; - - - function tsymtable.speedsearch(const s : stringid;speedvalue : longint) : psym; - var - hp : psym; - begin - if assigned(searchhasharray) then - hp:=searchhasharray^[speedvalue mod hasharraysize] - else - hp:=searchroot; - while assigned(hp) do - begin - if speedvalue>hp^.speedvalue then - hp:=hp^.left - else - if speedvalue0)} then - Message(sym_e_only_static_in_static); - if (symtabletype=unitsymtable) and - assigned(punitsymtable(@self)^.unitsym) then - inc(punitsymtable(@self)^.unitsym^.refs); - { unitsym are only loaded for browsing PM } - { this was buggy anyway because we could use } - { unitsyms from other units in _USES !! } - if (symtabletype=unitsymtable) and (hp^.typ=unitsym) and - assigned(current_module) and (current_module^.globalsymtable<>@self) then - hp:=nil; - if assigned(hp) and - (cs_browser in aktmoduleswitches) and make_ref then - begin - hp^.lastref:=new(pref,init(hp^.lastref,@tokenpos)); - { for symbols that are in tables without - browser info or syssyms (PM) } - if hp^.refcount=0 then - hp^.defref:=hp^.lastref; - inc(hp^.refcount); - end; - speedsearch:=hp; - exit; - end - else - if s>hp^.name then - hp:=hp^.left - else - hp:=hp^.right; - end; - end; - speedsearch:=nil; - end; - - - function tsymtable.rename(const olds,news : stringid):psym; - var - spdval : longint; - lasthp, - hp,hp2,hp3 : psym; - - function _insert(var osym:psym):psym; - var - s1,s2:^string; - begin - if osym=nil then - begin - osym:=hp; - _insert:=osym; - end - { first check speedvalue, to allow a fast insert } - else - if osym^.speedvalue>hp^.speedvalue then - _insert:=_insert(osym^.right) - else - if osym^.speedvalues2^ then - begin - dispose(s2); - dispose(s1); - _insert:=_insert(osym^.right); - end - else - if s1^hp^.speedvalue then - begin - lasthp:=hp; - hp:=hp^.left - end - else - if spdvalhp^.name then - begin - lasthp:=hp; - hp:=hp^.left - end - else - begin - lasthp:=hp; - hp:=hp^.right; - end; - end; - end; - end; - -{$endif} - {*********************************************** Browser @@ -2354,6 +1631,9 @@ const localsymtablestack : psymtable = nil; sym : psym; prdef : pdef; oldrecsyms : psymtable; +{$ifndef OLDDEREF} + p : pderef; +{$endif} begin if symtabletype in [recordsymtable,objectsymtable, parasymtable,localsymtable] then @@ -2370,14 +1650,24 @@ const localsymtablestack : psymtable = nil; b:=current_ppu^.readentry; case b of ibsymref : begin +{$ifndef OLDDEREF} + p:=readderef; + sym:=resolvesym(p); +{$else} sym:=readsymref; resolvesym(sym); +{$endif} if assigned(sym) then sym^.load_references; end; ibdefref : begin +{$ifndef OLDDEREF} + p:=readderef; + prdef:=resolvedef(p); +{$else} prdef:=readdefref; resolvedef(prdef); +{$endif} if assigned(prdef) then begin if prdef^.deftype<>procdef then @@ -2482,17 +1772,9 @@ const localsymtablestack : psymtable = nil; { this can not be done if there is an hasharray ! } alignment:=_alignment; - if (symtabletype<>parasymtable) -{$ifdef OLDPPU} - or assigned(searchhasharray) -{$endif} - then + if (symtabletype<>parasymtable) then internalerror(1111); -{$ifndef OLDPPU} sym:=pvarsym(symindex^.first); -{$else} - sym:=pvarsym(searchroot); -{$endif} datasize:=0; { there can be only varsyms } while assigned(sym) do @@ -2500,11 +1782,7 @@ const localsymtablestack : psymtable = nil; l:=sym^.getpushsize; sym^.address:=datasize; datasize:=align(datasize+l,alignment); -{$ifndef OLDPPU} sym:=pvarsym(sym^.next); -{$else} - sym:=pvarsym(sym^.nextsym); -{$endif} end; end; @@ -2515,17 +1793,9 @@ const localsymtablestack : psymtable = nil; find_at_offset:=nil; { this can not be done if there is an hasharray ! } - if (symtabletype<>parasymtable) -{$ifdef OLDPPU} - or assigned(searchhasharray) -{$endif} - then + if (symtabletype<>parasymtable) then internalerror(1111); -{$ifndef OLDPPU} sym:=pvarsym(symindex^.first); -{$else} - sym:=pvarsym(searchroot); -{$endif} while assigned(sym) do begin if sym^.address+address_fixup=l then @@ -2533,11 +1803,7 @@ const localsymtablestack : psymtable = nil; find_at_offset:=sym; exit; end; -{$ifndef OLDPPU} sym:=pvarsym(sym^.next); -{$else} - sym:=pvarsym(sym^.nextsym); -{$endif} end; end; @@ -2593,13 +1859,7 @@ const localsymtablestack : psymtable = nil; name:=stringdup(upper(n)); unitid:=0; unitsym:=nil; -{$ifndef OLDPPU} symsearch^.usehash; -{$else} - { create a hasharray } - new(searchhasharray); - fillchar(searchhasharray^,sizeof(searchhasharray^),0); -{$endif} { reset GDB things } {$ifdef GDB} if t = globalsymtable then @@ -2677,16 +1937,12 @@ const localsymtablestack : psymtable = nil; end; inherited done; end; - + procedure tunitsymtable.load_symtable_refs; var b : byte; unitindex : word; begin -{$ifdef OLDPPU} - number_defs; - number_symbols; -{$endif} if ((current_module^.flags and uf_local_browser)<>0) then begin current_module^.localsymtable:=new(psymtable,loadas(staticppusymtable)); @@ -2804,71 +2060,6 @@ const localsymtablestack : psymtable = nil; {$ifdef GDB} - {$ifdef OLDPPU} - procedure tunitsymtable.orderdefs; - var - firstd, last, nonum, pd, cur, prev, lnext : pdef; - - begin - pd:=rootdef; - firstd:=nil; - last:=nil; - nonum:=nil; - while assigned(pd) do - begin - lnext:=pd^.next; - if pd^.globalnb > 0 then - if firstd = nil then - begin - firstd:=pd; - last:=pd; - last^.next:=nil; - end - else - begin - cur:=firstd; - prev:=nil; - while assigned(cur) and - (prev <> last) and - (cur^.globalnb>0) and - (cur^.globalnb0) then _defaultprop:=ppropertysym(p); @@ -3238,7 +2429,12 @@ const localsymtablestack : psymtable = nil; end. { $Log$ - Revision 1.12 1999-05-10 22:34:59 pierre + Revision 1.13 1999-05-13 21:59:48 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.12 1999/05/10 22:34:59 pierre * one more unitsym problem fix Revision 1.11 1999/05/10 15:02:51 pierre diff --git a/compiler/tccal.pas b/compiler/tccal.pas index ddf52b2dca..8c57727719 100644 --- a/compiler/tccal.pas +++ b/compiler/tccal.pas @@ -687,15 +687,11 @@ implementation if ((parsing_para_level=0) or (p^.left<>nil)) and (nextprocsym=nil) then begin -{$ifndef OLDPPU} if (not assigned(lastparatype)) and (not assigned(pt^.resulttype)) then internalerror(39393) else CGMessage3(type_e_wrong_parameter_type,tostr(lastpara), pt^.resulttype^.typename,lastparatype^.typename); -{$else} - CGMessage1(parser_e_wrong_parameter_type,tostr(lastpara)); -{$endif} aktcallprocsym^.write_parameter_lists; goto errorexit; end @@ -1153,7 +1149,12 @@ implementation end. { $Log$ - Revision 1.40 1999-05-10 09:01:45 peter + Revision 1.41 1999-05-13 21:59:50 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.40 1999/05/10 09:01:45 peter * small message fixes Revision 1.39 1999/05/02 09:35:46 florian diff --git a/compiler/tccnv.pas b/compiler/tccnv.pas index 7244b6f9c4..8179e523a5 100644 --- a/compiler/tccnv.pas +++ b/compiler/tccnv.pas @@ -832,11 +832,7 @@ implementation CGMessage(cg_e_illegal_type_conversion); end else -{$ifndef OLDPPU} CGMessage2(type_e_incompatible_types,p^.left^.resulttype^.typename,p^.resulttype^.typename); -{$else} - CGMessage(type_e_mismatch); -{$endif} end end; { ordinal contants can be directly converted } @@ -933,7 +929,12 @@ implementation end. { $Log$ - Revision 1.30 1999-05-12 00:20:00 peter + Revision 1.31 1999-05-13 21:59:52 peter + * removed oldppu code + * warning if objpas is loaded from uses + * first things for new deref writing + + Revision 1.30 1999/05/12 00:20:00 peter * removed R_DEFAULT_SEG * uniform float names