mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-26 00:09:17 +02:00
* removed the tree dependency to types.pas
* long_fil.pas support (not fully tested yet)
This commit is contained in:
peter
parent
004da8b801
commit
12c40adc06
@ -134,7 +134,7 @@ unit files;
|
||||
{$else}
|
||||
function load_ppu(const unit_path,n,ext:string):boolean;
|
||||
{$endif}
|
||||
procedure search_unit(const n : string);
|
||||
function search_unit(const n : string):boolean;
|
||||
end;
|
||||
|
||||
pused_unit = ^tused_unit;
|
||||
@ -522,7 +522,7 @@ unit files;
|
||||
end;
|
||||
|
||||
|
||||
procedure tmodule.search_unit(const n : string);
|
||||
function tmodule.search_unit(const n : string):boolean;
|
||||
var
|
||||
ext : string[8];
|
||||
singlepathstring,
|
||||
@ -597,6 +597,7 @@ unit files;
|
||||
sources_avail:=false;
|
||||
end;
|
||||
until Found or (path='');
|
||||
search_unit:=Found;
|
||||
end;
|
||||
|
||||
{$else NEWPPU}
|
||||
@ -768,7 +769,7 @@ unit files;
|
||||
load_ppu:=true;
|
||||
end;
|
||||
|
||||
procedure tmodule.search_unit(const n : string);
|
||||
function tmodule.search_unit(const n : string):boolean;
|
||||
var
|
||||
ext : string[8];
|
||||
singlepathstring,
|
||||
@ -843,6 +844,7 @@ unit files;
|
||||
sources_avail:=false;
|
||||
end;
|
||||
until Found or (path='');
|
||||
search_unit:=Found;
|
||||
end;
|
||||
|
||||
{$endif NEWPPU}
|
||||
@ -895,7 +897,10 @@ unit files;
|
||||
flags:=flags or uf_smartlink;
|
||||
{ search the PPU file if it is an unit }
|
||||
if is_unit then
|
||||
search_unit(modulename^);
|
||||
begin
|
||||
if (not search_unit(modulename^)) and (length(modulename^)>8) then
|
||||
search_unit(copy(modulename^,1,8));
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor tmodule.special_done;
|
||||
@ -940,7 +945,11 @@ unit files;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 1998-06-12 10:32:26 pierre
|
||||
Revision 1.20 1998-06-12 14:50:48 peter
|
||||
* removed the tree dependency to types.pas
|
||||
* long_fil.pas support (not fully tested yet)
|
||||
|
||||
Revision 1.19 1998/06/12 10:32:26 pierre
|
||||
* column problem hopefully solved
|
||||
+ C vars declaration changed
|
||||
|
||||
|
||||
@ -289,6 +289,17 @@ unit tree;
|
||||
maxfirstpasscount : longint = 0;
|
||||
{$endif extdebug}
|
||||
|
||||
{ gibt den ordinalen Werten der Node zurueck oder falls sie }
|
||||
{ keinen ordinalen Wert hat, wird ein Fehler erzeugt }
|
||||
function get_ordinal_value(p : ptree) : longint;
|
||||
|
||||
{ true, if p is a pointer to a const int value }
|
||||
function is_constintnode(p : ptree) : boolean;
|
||||
{ like is_constintnode }
|
||||
function is_constboolnode(p : ptree) : boolean;
|
||||
function is_constrealnode(p : ptree) : boolean;
|
||||
function is_constcharnode(p : ptree) : boolean;
|
||||
|
||||
{$I innr.inc}
|
||||
|
||||
implementation
|
||||
@ -1537,10 +1548,61 @@ unit tree;
|
||||
destloc := sourceloc;
|
||||
sourceloc := swapl;
|
||||
end;
|
||||
|
||||
|
||||
function get_ordinal_value(p : ptree) : longint;
|
||||
begin
|
||||
if p^.treetype=ordconstn then
|
||||
get_ordinal_value:=p^.value
|
||||
else
|
||||
Message(parser_e_ordinal_expected);
|
||||
end;
|
||||
|
||||
|
||||
function is_constintnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
{DM: According to me, an orddef with anysize, is
|
||||
a correct constintnode. Anyway I commented changed s32bit check,
|
||||
because it caused problems with statements like a:=high(word).}
|
||||
is_constintnode:=((p^.treetype=ordconstn) and
|
||||
(p^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.resulttype)^.typ in [u8bit,s8bit,u16bit,s16bit,
|
||||
u32bit,s32bit,uauto]));
|
||||
end;
|
||||
|
||||
function is_constcharnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
is_constcharnode:=((p^.treetype=ordconstn) and
|
||||
(p^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.resulttype)^.typ=uchar));
|
||||
end;
|
||||
|
||||
function is_constrealnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
is_constrealnode:=(p^.treetype=realconstn);
|
||||
end;
|
||||
|
||||
function is_constboolnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
is_constboolnode:=((p^.treetype=ordconstn) and
|
||||
(p^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 1998-06-06 08:39:07 peter
|
||||
Revision 1.16 1998-06-12 14:50:49 peter
|
||||
* removed the tree dependency to types.pas
|
||||
* long_fil.pas support (not fully tested yet)
|
||||
|
||||
Revision 1.15 1998/06/06 08:39:07 peter
|
||||
* it needs types
|
||||
|
||||
Revision 1.14 1998/06/05 14:37:40 pierre
|
||||
|
||||
@ -25,7 +25,7 @@ unit types;
|
||||
interface
|
||||
|
||||
uses
|
||||
cobjects,globals,symtable,tree;
|
||||
cobjects,globals,symtable;
|
||||
|
||||
type
|
||||
tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
|
||||
@ -81,10 +81,6 @@ unit types;
|
||||
{ equal }
|
||||
function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
|
||||
|
||||
{ gibt den ordinalen Werten der Node zurueck oder falls sie }
|
||||
{ keinen ordinalen Wert hat, wird ein Fehler erzeugt }
|
||||
function get_ordinal_value(p : ptree) : longint;
|
||||
|
||||
{ if l isn't in the range of def a range check error is generated }
|
||||
procedure testrange(def : pdef;l : longint);
|
||||
|
||||
@ -94,14 +90,6 @@ unit types;
|
||||
{ generates a VMT for _class }
|
||||
procedure genvmt(_class : pobjectdef);
|
||||
|
||||
{ true, if p is a pointer to a const int value }
|
||||
function is_constintnode(p : ptree) : boolean;
|
||||
|
||||
{ like is_constintnode }
|
||||
function is_constboolnode(p : ptree) : boolean;
|
||||
function is_constrealnode(p : ptree) : boolean;
|
||||
function is_constcharnode(p : ptree) : boolean;
|
||||
|
||||
{ some type helper routines for MMX support }
|
||||
function is_mmx_able_array(p : pdef) : boolean;
|
||||
|
||||
@ -112,40 +100,6 @@ unit types;
|
||||
|
||||
uses verbose,aasm;
|
||||
|
||||
function is_constintnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
{DM: According to me, an orddef with anysize, is
|
||||
a correct constintnode. Anyway I commented changed s32bit check,
|
||||
because it caused problems with statements like a:=high(word).}
|
||||
is_constintnode:=((p^.treetype=ordconstn) and
|
||||
(p^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.resulttype)^.typ in [u8bit,s8bit,u16bit,s16bit,
|
||||
u32bit,s32bit,uauto]));
|
||||
end;
|
||||
|
||||
function is_constcharnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
is_constcharnode:=((p^.treetype=ordconstn) and
|
||||
(p^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.resulttype)^.typ=uchar));
|
||||
end;
|
||||
|
||||
function is_constrealnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
is_constrealnode:=(p^.treetype=realconstn);
|
||||
end;
|
||||
|
||||
function is_constboolnode(p : ptree) : boolean;
|
||||
|
||||
begin
|
||||
is_constboolnode:=((p^.treetype=ordconstn) and
|
||||
(p^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]));
|
||||
end;
|
||||
|
||||
function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
|
||||
|
||||
begin
|
||||
@ -223,86 +177,66 @@ unit types;
|
||||
|
||||
begin
|
||||
is_open_array:=(p^.deftype=arraydef) and
|
||||
(parraydef(p)^.lowrange=0) and
|
||||
(parraydef(p)^.highrange=-1);
|
||||
(parraydef(p)^.lowrange=0) and
|
||||
(parraydef(p)^.highrange=-1);
|
||||
end;
|
||||
|
||||
{ true if o is an ansi string def }
|
||||
function is_ansistring(p : pdef) : boolean;
|
||||
begin
|
||||
is_ansistring:=(p^.deftype=stringdef) and
|
||||
(pstringdef(p)^.string_typ=ansistring);
|
||||
(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);
|
||||
(pstringdef(p)^.string_typ=longstring);
|
||||
end;
|
||||
|
||||
{ true if o is an long string def }
|
||||
{ true if o is an wide string def }
|
||||
function is_widestring(p : pdef) : boolean;
|
||||
begin
|
||||
is_widestring:=(p^.deftype=stringdef) and
|
||||
(pstringdef(p)^.string_typ=widestring);
|
||||
(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);
|
||||
(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;
|
||||
|
||||
begin
|
||||
ret_in_acc:=(def^.deftype=orddef) or
|
||||
(def^.deftype=pointerdef) or
|
||||
(def^.deftype=enumdef) or
|
||||
((def^.deftype=procvardef) and
|
||||
((pprocvardef(def)^.options and pomethodpointer)=0)) or
|
||||
(def^.deftype=classrefdef) or
|
||||
((def^.deftype=objectdef) and
|
||||
pobjectdef(def)^.isclass
|
||||
) or
|
||||
((def^.deftype=setdef) and
|
||||
(psetdef(def)^.settype=smallset)) or
|
||||
((def^.deftype=floatdef) and
|
||||
(pfloatdef(def)^.typ=f32bit));
|
||||
ret_in_acc:=(def^.deftype in [orddef,pointerdef,enumdef,classrefdef]) or
|
||||
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)=0)) or
|
||||
((def^.deftype=objectdef) and pobjectdef(def)^.isclass) or
|
||||
((def^.deftype=setdef) and (psetdef(def)^.settype=smallset)) or
|
||||
((def^.deftype=floatdef) and (pfloatdef(def)^.typ=f32bit));
|
||||
end;
|
||||
|
||||
{ true if uses a parameter as return value }
|
||||
function ret_in_param(def : pdef) : boolean;
|
||||
|
||||
begin
|
||||
ret_in_param:=(def^.deftype=arraydef) or
|
||||
(def^.deftype=stringdef) or
|
||||
((def^.deftype=procvardef) and
|
||||
((pprocvardef(def)^.options and pomethodpointer)<>0)) or
|
||||
((def^.deftype=objectdef) and
|
||||
((pobjectdef(def)^.options and oois_class)=0)
|
||||
) or
|
||||
(def^.deftype=recorddef) or
|
||||
((def^.deftype=setdef) and
|
||||
(psetdef(def)^.settype<>smallset));
|
||||
ret_in_param:=(def^.deftype in [arraydef,recorddef,stringdef]) or
|
||||
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
|
||||
((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oois_class)=0)) or
|
||||
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
|
||||
end;
|
||||
|
||||
{ true if a const parameter is too large to copy }
|
||||
function dont_copy_const_param(def : pdef) : boolean;
|
||||
|
||||
begin
|
||||
dont_copy_const_param:=(def^.deftype=arraydef) or
|
||||
(def^.deftype=stringdef) or
|
||||
(def^.deftype=objectdef) or
|
||||
(def^.deftype=formaldef) or
|
||||
(def^.deftype=recorddef) or
|
||||
((def^.deftype=procvardef) and
|
||||
((pprocvardef(def)^.options and pomethodpointer)<>0)) or
|
||||
((def^.deftype=setdef) and
|
||||
(psetdef(def)^.settype<>smallset));
|
||||
dont_copy_const_param:=(def^.deftype in [arraydef,stringdef,objectdef,formaldef,recorddef]) or
|
||||
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
|
||||
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
|
||||
end;
|
||||
|
||||
procedure testrange(def : pdef;l : longint);
|
||||
@ -350,15 +284,6 @@ unit types;
|
||||
end;
|
||||
|
||||
|
||||
function get_ordinal_value(p : ptree) : longint;
|
||||
begin
|
||||
if p^.treetype=ordconstn then
|
||||
get_ordinal_value:=p^.value
|
||||
else
|
||||
Message(parser_e_ordinal_expected);
|
||||
end;
|
||||
|
||||
|
||||
function mmx_type(p : pdef) : tmmxtype;
|
||||
begin
|
||||
mmx_type:=mmxno;
|
||||
@ -928,7 +853,11 @@ unit types;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1998-06-03 22:49:07 peter
|
||||
Revision 1.14 1998-06-12 14:50:50 peter
|
||||
* removed the tree dependency to types.pas
|
||||
* long_fil.pas support (not fully tested yet)
|
||||
|
||||
Revision 1.13 1998/06/03 22:49:07 peter
|
||||
+ wordbool,longbool
|
||||
* rename bis,von -> high,low
|
||||
* moved some systemunit loading/creating to psystem.pas
|
||||
|
||||
Loading…
Reference in New Issue
Block a user