From 3233d4aeb7e6635e9da0a1c2215b4bef8ceb58a5 Mon Sep 17 00:00:00 2001 From: florian Date: Fri, 1 May 1998 16:38:44 +0000 Subject: [PATCH] * handling of private and protected fixed + change_keywords_to_tp implemented to remove keywords which aren't supported by tp * break and continue are now symbols of the system unit + widestring, longstring and ansistring type released --- compiler/cgi386.pas | 27 +++++++++++------- compiler/cgi386ad.inc | 11 ++++++-- compiler/files.pas | 10 ++++++- compiler/innr.inc | 11 +++++++- compiler/parser.pas | 19 +++++++------ compiler/pass_1.pas | 52 ++++++++++++++--------------------- compiler/pexpr.pas | 36 ++++++++++++++++++++++-- compiler/pmodules.pas | 21 ++++++++------ compiler/pstatmnt.pas | 16 ++++++++--- compiler/scanner.pas | 64 +++++++++++++++++++++++++++++++++++++++---- compiler/todo.txt | 8 +++++- compiler/types.pas | 39 +++++++++++++++++++++++++- 12 files changed, 237 insertions(+), 77 deletions(-) diff --git a/compiler/cgi386.pas b/compiler/cgi386.pas index 0b9f18c5f7..ee9b4f3a33 100644 --- a/compiler/cgi386.pas +++ b/compiler/cgi386.pas @@ -1624,16 +1624,18 @@ implementation { call shortstring to ansistring conversion } { result is in register } del_reference(p^.left^.location.reference); + {!!!! copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len); + } ungetiftemp(p^.left^.location.reference); end - else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left.resulttype) then + else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then begin { call ansistring to shortstring conversion } { result is in mem } stringdispose(p^.location.reference.symbol); gettempofsizereference(p^.resulttype^.size,p^.location.reference); - if p^.left^.location.locin [LOC_MEM,LOC_REFERENCE] then + if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then del_reference(p^.left^.location.reference); copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len); ungetiftemp(p^.left^.location.reference); @@ -2296,11 +2298,10 @@ implementation {$ifdef UseAnsiString} if is_ansistring(p^.left^.resulttype) then begin - - { we do not need destination anymore } - del_reference(p^.left^.location.reference); - { only source if withresult is set } - del_reference(p^.right^.location.reference); + { the source and destinations are released + in loadansistring, because an ansi string can + also be in a register + } loadansistring(p); end else @@ -2309,7 +2310,6 @@ implementation begin { we do not need destination anymore } del_reference(p^.left^.location.reference); - { only source if withresult is set } del_reference(p^.right^.location.reference); loadstring(p); ungetiftemp(p^.right^.location.reference); @@ -3971,7 +3971,7 @@ implementation set_location(p^.location,p^.left^.location); { length in ansi strings is at offset -8 } {$ifdef UseAnsiString} - if is_ansistring(p^.left^.resultype)) then + if is_ansistring(p^.left^.resulttype) then dec(p^.location.reference.offset,8); {$endif UseAnsiString} end; @@ -6033,7 +6033,14 @@ do_jmp: end. { $Log$ - Revision 1.19 1998-04-30 15:59:39 pierre + Revision 1.20 1998-05-01 16:38:44 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.19 1998/04/30 15:59:39 pierre * GDB works again better : correct type info in one pass + UseTokenInfo for better source position diff --git a/compiler/cgi386ad.inc b/compiler/cgi386ad.inc index d1a51319a4..cbbad57905 100644 --- a/compiler/cgi386ad.inc +++ b/compiler/cgi386ad.inc @@ -223,7 +223,7 @@ { we do not need destination anymore } del_reference(p^.left^.location.reference); del_reference(p^.right^.location.reference); - concatansistring(p); + { concatansistring(p); } end; ltn,lten,gtn,gten, equaln,unequaln : @@ -1271,7 +1271,14 @@ { $Log$ - Revision 1.6 1998-04-30 15:59:40 pierre + Revision 1.7 1998-05-01 16:38:44 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.6 1998/04/30 15:59:40 pierre * GDB works again better : correct type info in one pass + UseTokenInfo for better source position diff --git a/compiler/files.pas b/compiler/files.pas index a72f2dfbd5..9ea77d203e 100644 --- a/compiler/files.pas +++ b/compiler/files.pas @@ -188,6 +188,7 @@ unit files; iblongstringdef = 32; ibansistringdef = 33; ibunitname = 34; + ibwidestringdef = 35; ibend = 255; { unit flags } @@ -630,7 +631,14 @@ unit files; end. { $Log$ - Revision 1.6 1998-05-01 07:43:53 florian + Revision 1.7 1998-05-01 16:38:44 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.6 1998/05/01 07:43:53 florian + basics for rtti implemented + switch $m (generate rtti for published sections) diff --git a/compiler/innr.inc b/compiler/innr.inc index 048452e76a..51467df837 100644 --- a/compiler/innr.inc +++ b/compiler/innr.inc @@ -53,10 +53,19 @@ const in_dec_x = 36; in_include_x_y = 37; in_exclude_x_y = 38; + in_break = 39; + in_continue = 40; { $Log$ - Revision 1.3 1998-04-14 23:27:03 florian + Revision 1.4 1998-05-01 16:38:44 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.3 1998/04/14 23:27:03 florian + exclude/include with constant second parameter added Revision 1.2 1998/04/08 16:58:02 pierre diff --git a/compiler/parser.pas b/compiler/parser.pas index f3166a4d5f..c16bdc769d 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -64,12 +64,9 @@ unit parser; s32bitdef:=porddef(globaldef('longint')); u32bitdef:=porddef(globaldef('ulong')); cstringdef:=pstringdef(globaldef('string')); -{$ifdef UseLongString} clongstringdef:=pstringdef(globaldef('longstring')); -{$endif UseLongString} -{$ifdef UseAnsiString} cansistringdef:=pstringdef(globaldef('ansistring')); -{$endif UseAnsiString} + cwidestringdef:=pstringdef(globaldef('widestring')); cchardef:=porddef(globaldef('char')); {$ifdef i386} c64floatdef:=pfloatdef(globaldef('s64real')); @@ -351,12 +348,9 @@ unit parser; u32bitdef:=new(porddef,init(u32bit,0,$ffffffff)); cstringdef:=new(pstringdef,init(255)); { should we give a length to the default long and ansi string definition ?? } -{$ifdef UseLongString} clongstringdef:=new(pstringdef,longinit(-1)); -{$endif UseLongString} -{$ifdef UseAnsiString} cansistringdef:=new(pstringdef,ansiinit(-1)); -{$endif UseAnsiString} + cwidestringdef:=new(pstringdef,wideinit(-1)); cchardef:=new(porddef,init(uchar,0,255)); {$ifdef i386} c64floatdef:=new(pfloatdef,init(s64real)); @@ -542,7 +536,14 @@ done: end. { $Log$ - Revision 1.10 1998-05-01 07:43:56 florian + Revision 1.11 1998-05-01 16:38:45 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.10 1998/05/01 07:43:56 florian + basics for rtti implemented + switch $m (generate rtti for published sections) diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas index 07c757ef74..b4d7b82209 100644 --- a/compiler/pass_1.pas +++ b/compiler/pass_1.pas @@ -525,13 +525,6 @@ unit pass_1; p^.registers32:=1; if p^.symtable^.symtabletype=withsymtable then p^.registers32:=1; - { check semantics of private } - if p^.symtable^.symtabletype=objectsymtable then - begin - if (pobjectdef(pvarsym(p^.symtableentry)^.owner^.defowner)^.owner^.symtabletype=unitsymtable) and - ((p^.vs^.properties and sp_private)<>0) then - Message(parser_e_cant_access_private_member); - end; { a class variable is a pointer !!! yes, but we have to resolve the reference in an @@ -1995,24 +1988,24 @@ unit pass_1; procedure first_string_chararray(var p : ptree); - begin - p^.registers32:=1; - p^.location.loc:=LOC_REGISTER; - end; + begin + p^.registers32:=1; + p^.location.loc:=LOC_REGISTER; + end; procedure first_string_string(var p : ptree); + begin + if pstringdef(p^.resulttype)^.string_typ<> + pstringdef(p^.left^.resulttype)^.string_typ then begin - if pstringdef(p^.resulttype)^.string_typ<> - pstringdef(p^.left^.resulttype)^.string_typ then - begin - { call shortstring_to_ansistring or ansistring_to_shortstring } - procinfo.flags:=procinfo.flags or pi_do_call; - end; - { for simplicity lets first keep all ansistrings - as LOC_MEM, could also become LOC_REGISTER } - p^.location.loc:=LOC_MEM; + { call shortstring_to_ansistring or ansistring_to_shortstring } + procinfo.flags:=procinfo.flags or pi_do_call; end; + { for simplicity lets first keep all ansistrings + as LOC_MEM, could also become LOC_REGISTER } + p^.location.loc:=LOC_MEM; + end; procedure first_char_to_string(var p : ptree); @@ -3856,16 +3849,6 @@ unit pass_1; {$ifdef SUPPORT_MMX} p^.registersmmx:=p^.left^.registersmmx; {$endif SUPPORT_MMX} - { check protected and private members } - if (p^.left^.resulttype^.deftype=objectdef) then - begin - if (pobjectdef(p^.vs^.owner^.defowner)^.owner^.symtabletype=unitsymtable) and - ((p^.vs^.properties and sp_private)<>0) then - Message(parser_e_cant_access_private_member); - if (pobjectdef(p^.left^.resulttype)^.owner^.symtabletype=unitsymtable) and - ((p^.vs^.properties and sp_protected)<>0) then - Message(parser_e_cant_access_protected_member); - end; { classes must be dereferenced implicit } if (p^.left^.resulttype^.deftype=objectdef) and pobjectdef(p^.left^.resulttype)^.isclass then @@ -4846,7 +4829,14 @@ unit pass_1; end. { $Log$ - Revision 1.15 1998-05-01 09:01:23 florian + Revision 1.16 1998-05-01 16:38:45 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.15 1998/05/01 09:01:23 florian + correct semantics of private and protected * small fix in variable scope: a id can be used in a parameter list of a method, even it is used in diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 8307dcb603..dcd05128ce 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -120,7 +120,7 @@ unit pexpr; prev_in_args:=in_args; Store_valid:=Must_be_valid; case l of - in_ord_x : + in_ord_x: begin consume(LKLAMMER); in_args:=true; @@ -133,6 +133,16 @@ unit pexpr; statement_syssym := p1; pd:=p1^.resulttype; end; + in_break: + begin + statement_syssym:=genzeronode(breakn); + pd:=voiddef; + end; + in_continue: + begin + statement_syssym:=genzeronode(continuen); + pd:=voiddef; + end; in_typeof_x : begin consume(LKLAMMER); in_args:=true; @@ -580,6 +590,13 @@ unit pexpr; else begin isclassref:=pd^.deftype=classrefdef; + { check protected and private members } + if ((sym^.properties and sp_private)<>0) and + (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then + Message(parser_e_cant_access_private_member); + if ((sym^.properties and sp_protected)<>0) and + (pobjectdef(pd)^.owner^.symtabletype=unitsymtable) then + Message(parser_e_cant_access_protected_member); { we assume, that only procsyms and varsyms are in an object } { symbol table, for classes, properties are allowed } case sym^.typ of @@ -938,6 +955,14 @@ unit pexpr; end else unit_specific:=false; + { check semantics of private } + if srsymtable^.symtabletype=objectsymtable then + begin + if ((srsym^.properties and sp_private)<>0) and + (pobjectdef(srsym^.owner^.defowner)^. + owner^.symtabletype=unitsymtable) then + Message(parser_e_cant_access_private_member); + end; case srsym^.typ of absolutesym: begin @@ -1640,7 +1665,14 @@ unit pexpr; end. { $Log$ - Revision 1.9 1998-04-29 10:33:58 pierre + Revision 1.10 1998-05-01 16:38:45 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.9 1998/04/29 10:33:58 pierre + added some code for ansistring (not complete nor working yet) * corrected operator overloading * corrected nasm output diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 286a100bb2..585a318821 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -82,6 +82,8 @@ unit pmodules; p^.insert(new(psyssym,init('SUCC',in_succ_x))); p^.insert(new(psyssym,init('EXCLUDE',in_exclude_x_y))); p^.insert(new(psyssym,init('INCLUDE',in_include_x_y))); + p^.insert(new(psyssym,init('BREAK',in_break))); + p^.insert(new(psyssym,init('CONTINUE',in_continue))); { for testing purpose } p^.insert(new(psyssym,init('DECI',in_dec_x))); @@ -112,12 +114,9 @@ unit pmodules; p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef))); p^.insert(new(ptypesym,init('byte',u8bitdef))); p^.insert(new(ptypesym,init('string',cstringdef))); -{$ifdef UseLongString} p^.insert(new(ptypesym,init('longstring',clongstringdef))); -{$endif UseLongString} -{$ifdef UseAnsiString} p^.insert(new(ptypesym,init('ansistring',cansistringdef))); -{$endif UseAnsiString} + p^.insert(new(ptypesym,init('widestring',cansistringdef))); p^.insert(new(ptypesym,init('word',u16bitdef))); p^.insert(new(ptypesym,init('boolean',booldef))); p^.insert(new(ptypesym,init('void_pointer',voidpointerdef))); @@ -145,12 +144,9 @@ unit pmodules; p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real))))); p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef))))); p^.insert(new(ptypesym,init('STRING',cstringdef))); -{$ifdef UseLongString} p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef))); -{$endif UseLongString} -{$ifdef UseAnsiString} p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef))); -{$endif UseAnsiString} + p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef))); p^.insert(new(ptypesym,init('BOOLEAN',new(porddef,init(bool8bit,0,1))))); p^.insert(new(ptypesym,init('CHAR',new(porddef,init(uchar,0,255))))); p^.insert(new(ptypesym,init('TEXT',new(pfiledef,init(ft_text,nil))))); @@ -955,7 +951,14 @@ unit pmodules; end. { $Log$ - Revision 1.8 1998-04-30 15:59:41 pierre + Revision 1.9 1998-05-01 16:38:45 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.8 1998/04/30 15:59:41 pierre * GDB works again better : correct type info in one pass + UseTokenInfo for better source position diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index ce3c142a60..1a6416f3b4 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -889,11 +889,13 @@ unit pstatmnt; consume(_FAIL); code:=genzeronode(failn); end; + { _BREAK: begin consume(_BREAK); code:=genzeronode(breakn); end; + } _EXIT : code:=exit_statement; _ASM : code:=_asm_statement; else @@ -928,9 +930,8 @@ unit pstatmnt; end; end; p:=expr; - if (p^.treetype<>calln) and - (p^.treetype<>assignn) and - (p^.treetype<>inlinen) then + if not(p^.treetype in [calln,assignn,breakn,inlinen, + continuen]) then Message(cg_e_illegal_expression); code:=p; end; @@ -1076,7 +1077,14 @@ unit pstatmnt; end. { $Log$ - Revision 1.6 1998-04-30 15:59:42 pierre + Revision 1.7 1998-05-01 16:38:46 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.6 1998/04/30 15:59:42 pierre * GDB works again better : correct type info in one pass + UseTokenInfo for better source position diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 283bf61441..25c586df0c 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -44,17 +44,24 @@ unit scanner; ident = string[id_len]; const - max_keywords = 71; + max_keywords = 69; anz_keywords : longint = max_keywords; + { the following keywords are no keywords in TP, they + are internal procedures + + CONTINUE, DISPOSE, EXIT, FAIL, FALSE, NEW, SELF + TRUE + } + { INLINE is a keyword in TP, but only an modifier in FPC } keyword : array[1..max_keywords] of ident = ( { 'ABSOLUTE',} 'AND', 'ARRAY','AS','ASM', { 'ASSEMBLER',} 'BEGIN', - 'BREAK','CASE','CLASS', - 'CONST','CONSTRUCTOR','CONTINUE', + 'CASE','CLASS', + 'CONST','CONSTRUCTOR', 'DESTRUCTOR','DISPOSE','DIV','DO','DOWNTO','ELSE','END', 'EXCEPT', 'EXIT', @@ -89,8 +96,8 @@ unit scanner; _ARRAY,_AS,_ASM, { _ASSEMBLER,} _BEGIN, - _BREAK,_CASE,_CLASS, - _CONST,_CONSTRUCTOR,_CONTINUE, + _CASE,_CLASS, + _CONST,_CONSTRUCTOR, _DESTRUCTOR,_DISPOSE,_DIV,_DO,_DOWNTO, _ELSE,_END,_EXCEPT, _EXIT, @@ -177,6 +184,8 @@ unit scanner; procedure InitScanner(const fn: string); procedure DoneScanner(testendif:boolean); + { changes to keywords to be tp compatible } + procedure change_to_tp_keywords; implementation @@ -1413,10 +1422,53 @@ unit scanner; end; end; + procedure change_to_tp_keywords; + + const + non_tp : array[0..13] of string[id_len] = ( + 'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS', + 'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY', + 'EXPORTS','LIBRARY'); + + var + i : longint; + + begin + for i:=0 to 13 do + remove_keyword(non_tp[i]); + end; + + procedure change_to_delphi_keywords; + + { + const + non_tp : array[0..13] of string[id_len] = ( + 'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS', + 'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY', + 'EXPORTS','LIBRARY'); + + var + i : longint; + } + + begin + { + for i:=0 to 13 do + remove_keyword(non_tp[i]); + } + end; + end. { $Log$ - Revision 1.14 1998-04-30 15:59:42 pierre + Revision 1.15 1998-05-01 16:38:46 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.14 1998/04/30 15:59:42 pierre * GDB works again better : correct type info in one pass + UseTokenInfo for better source position diff --git a/compiler/todo.txt b/compiler/todo.txt index 672360c660..8bc6a22015 100644 --- a/compiler/todo.txt +++ b/compiler/todo.txt @@ -18,8 +18,14 @@ compiler version and your short cut. - message qualifier - correct handling of constructor result type ............ 0.99.6 (FK) - rtti + - published - dynamic methods - - correct handling of access specifiers + - correct handling of access specifiers ........................ 0.99.7 (FK) + - interface +* rtti + - generation + - use when copying etc. +* AnsiString, LongString and WideString * MMX support by the compiler - unary minus .......................................... 0.99.1 (FK) - proper handling of fixed type ........................ 0.99.1 (FK) diff --git a/compiler/types.pas b/compiler/types.pas index f7086ea5fd..353eb5a0d1 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -40,6 +40,15 @@ unit types; { true if o is an ansi string def } function is_ansistring(p : pdef) : boolean; + { true if o is a long string def } + function is_longstring(p : pdef) : boolean; + + { true if o is a wide string def } + function is_widestring(p : pdef) : boolean; + + { true if o is a short string def } + function is_shortstring(p : pdef) : boolean; + { returns true, if def defines a signed data type (only for ordinal types) } function is_signed(def : pdef) : boolean; @@ -228,6 +237,27 @@ unit types; (pstringdef(p)^.string_typ=ansistring); end; + { true if o is an long string def } + function is_longstring(p : pdef) : boolean; + begin + is_longstring:=(p^.deftype=stringdef) and + (pstringdef(p)^.string_typ=longstring); + end; + + { true if o is an long string def } + function is_widestring(p : pdef) : boolean; + begin + is_widestring:=(p^.deftype=stringdef) and + (pstringdef(p)^.string_typ=widestring); + end; + + { true if o is an short string def } + function is_shortstring(p : pdef) : boolean; + begin + is_shortstring:=(p^.deftype=stringdef) and + (pstringdef(p)^.string_typ=shortstring); + end; + { true if the return value is in accumulator (EAX for i386), D0 for 68k } function ret_in_acc(def : pdef) : boolean; @@ -935,7 +965,14 @@ unit types; end. { $Log$ - Revision 1.10 1998-04-29 10:34:08 pierre + Revision 1.11 1998-05-01 16:38:46 florian + * handling of private and protected fixed + + change_keywords_to_tp implemented to remove + keywords which aren't supported by tp + * break and continue are now symbols of the system unit + + widestring, longstring and ansistring type released + + Revision 1.10 1998/04/29 10:34:08 pierre + added some code for ansistring (not complete nor working yet) * corrected operator overloading * corrected nasm output