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

* handling of private and protected fixed

Browse Source 
+ 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
This commit is contained in:
florian 1998-05-01 16:38:44 +00:00
parent 258d6968af
commit 3233d4aeb7
12 changed files with 237 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/cgi386.pas
View File

@ -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

11
compiler/cgi386ad.inc
View File

@ -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

10
compiler/files.pas
View File

@ -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)

11
compiler/innr.inc
View File

@ -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

19
compiler/parser.pas
View File

@ -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)

52
compiler/pass_1.pas
View File

@ -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

36
compiler/pexpr.pas
View File

@ -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

21
compiler/pmodules.pas
View File

@ -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

16
compiler/pstatmnt.pas
View File

@ -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

64
compiler/scanner.pas
View File

@ -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

8
compiler/todo.txt
View File

@ -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)

39
compiler/types.pas
View File

@ -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