* Message system uses open arrays internally

* Bugfix for string handling in array constructor node
  * Micro code reductions in pdecl.pas
This commit is contained in:
daniel 2004-02-20 19:49:21 +00:00
parent 7b3a982819
commit 4e89e4be76
4 changed files with 100 additions and 123 deletions

View File

@ -53,11 +53,7 @@ type
procedure ClearIdx;
procedure CreateIdx;
function GetPChar(nr:longint):pchar;
function Get(nr:longint):string;
function Get4(nr:longint;const s1,s2,s3,s4:string):string;
function Get3(nr:longint;const s1,s2,s3:string):string;
function Get2(nr:longint;const s1,s2:string):string;
function Get1(nr:longint;const s1:string):string;
function Get(nr:longint;const args:array of string):string;
end;
{ this will read a line until #10 or #0 and also increase p }
@ -75,43 +71,33 @@ uses
{$endif DELPHI}
function MsgReplace(const s,s1,s2,s3,s4:string):string;
var
last,
i : longint;
hs : string;
begin
if s='' then
begin
MsgReplace:='';
exit;
end;
hs:='';
i:=0;
last:=0;
while (i<length(s)-1) do
begin
inc(i);
if (s[i]='$') and
(s[i+1] in ['1'..'4']) then
begin
hs:=hs+copy(s,last+1,i-last-1);
case s[i+1] of
'1' :
hs:=hs+s1;
'2' :
hs:=hs+s2;
'3' :
hs:=hs+s3;
'4' :
hs:=hs+s4;
end;
inc(i);
last:=i;
end;
end;
MsgReplace:=hs+copy(s,last+1,length(s)-last);;
end;
function MsgReplace(const s:string;const args:array of string):string;
var
last,
i : longint;
hs : string;
begin
if s='' then
begin
MsgReplace:='';
exit;
end;
hs:='';
i:=0;
last:=0;
while (i<length(s)-1) do
begin
inc(i);
if (s[i]='$') and (s[i+1] in ['1'..'9']) then
begin
hs:=hs+copy(s,last+1,i-last-1)+args[byte(s[i+1])-byte('1')];
inc(i);
last:=i;
end;
end;
MsgReplace:=hs+copy(s,last+1,length(s)-last);;
end;
@ -418,50 +404,26 @@ begin
end;
function TMessage.Get(nr:longint):string;
function TMessage.Get(nr:longint;const args:array of string):string;
var
s : string[16];
hp : pchar;
begin
hp:=msgidx[nr div 1000]^[nr mod 1000];
if hp=nil then
begin
Str(nr,s);
Get:='msg nr '+s;
end
Get:='msg nr '+tostr(nr)
else
Get:=StrPas(hp);
Get:=MsgReplace(strpas(hp),args);
end;
function TMessage.Get4(nr:longint;const s1,s2,s3,s4:string):string;
begin
Get4:=MsgReplace(Get(nr),s1,s2,s3,s4);
end;
function TMessage.Get3(nr:longint;const s1,s2,s3:string):string;
begin
Get3:=MsgReplace(Get(nr),s1,s2,s3,'');
end;
function TMessage.Get2(nr:longint;const s1,s2:string):string;
begin
Get2:=MsgReplace(Get(nr),s1,s2,'','');
end;
function TMessage.Get1(nr:longint;const s1:string):string;
begin
Get1:=MsgReplace(Get(nr),s1,'','','');
end;
end.
{
$Log$
Revision 1.9 2004-01-28 15:36:46 florian
Revision 1.10 2004-02-20 19:49:21 daniel
* Message system uses open arrays internally
* Bugfix for string handling in array constructor node
* Micro code reductions in pdecl.pas
Revision 1.9 2004/01/28 15:36:46 florian
* fixed another couple of arm bugs
Revision 1.8 2003/05/10 23:57:23 florian

View File

@ -868,7 +868,11 @@ implementation
LOC_CREFERENCE :
begin
location_release(exprasmlist,hp.left.location);
cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
if is_shortstring(hp.left.resulttype.def) then
cg.g_copyshortstring(exprasmlist,hp.left.location.reference,href,
Tstringdef(hp.left.resulttype.def).len,freetemp,false)
else
cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
end;
else
begin
@ -899,7 +903,12 @@ begin
end.
{
$Log$
Revision 1.108 2004-02-08 17:45:53 jonas
Revision 1.109 2004-02-20 19:49:21 daniel
* Message system uses open arrays internally
* Bugfix for string handling in array constructor node
* Micro code reductions in pdecl.pas
Revision 1.108 2004/02/08 17:45:53 jonas
* fixed regvars
Revision 1.107 2004/02/05 01:24:08 florian

View File

@ -428,13 +428,7 @@ implementation
consume(_ID);
consume(_EQUAL);
{ support 'ttype=type word' syntax }
if token=_TYPE then
begin
Consume(_TYPE);
unique:=true;
end
else
unique:=false;
unique:=try_to_consume(_TYPE);
{ is the type already defined? }
searchsym(typename,sym,srsymtable);
newtype:=nil;
@ -551,28 +545,29 @@ implementation
it can contain a reference to that data (PFV)
This is not for forward classes }
if (tt.def.deftype=objectdef) then
begin
if not(oo_is_forward in tobjectdef(tt.def).objectoptions) then
begin
ch:=cclassheader.create(tobjectdef(tt.def));
{ generate and check virtual methods, must be done
before RTTI is written }
ch.genvmt;
{ Generate RTTI for class }
generate_rtti(newtype);
if is_interface(tobjectdef(tt.def)) then
ch.writeinterfaceids;
if (oo_has_vmt in tobjectdef(tt.def).objectoptions) then
ch.writevmt;
ch.free;
end;
end
with Tobjectdef(tt.def) do
begin
if not(oo_is_forward in objectoptions) then
begin
ch:=cclassheader.create(tobjectdef(tt.def));
{ generate and check virtual methods, must be done
before RTTI is written }
ch.genvmt;
{ Generate RTTI for class }
generate_rtti(newtype);
if is_interface(tobjectdef(tt.def)) then
ch.writeinterfaceids;
if (oo_has_vmt in objectoptions) then
ch.writevmt;
ch.free;
end;
end
else
begin
{ Always generate RTTI info for all types. This is to have typeinfo() return
the same pointer }
generate_rtti(newtype);
end;
begin
{ Always generate RTTI info for all types. This is to have typeinfo() return
the same pointer }
generate_rtti(newtype);
end;
aktfilepos:=oldfilepos;
end;
@ -658,11 +653,12 @@ implementation
Message(cg_e_illegal_expression);
end;
stringconstn:
begin
getmem(sp,tstringconstnode(p).len+1);
move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,tstringconstnode(p).len));
end;
with Tstringconstnode(p) do
begin
getmem(sp,len+1);
move(value_str^,sp^,len+1);
symtablestack.insert(tconstsym.create_string(orgname,constresourcestring,sp,len));
end;
else
Message(cg_e_illegal_expression);
end;
@ -679,7 +675,12 @@ implementation
end.
{
$Log$
Revision 1.81 2004-02-17 19:37:16 daniel
Revision 1.82 2004-02-20 19:49:21 daniel
* Message system uses open arrays internally
* Bugfix for string handling in array constructor node
* Micro code reductions in pdecl.pas
Revision 1.81 2004/02/17 19:37:16 daniel
* No longer treat threadvar is normakl var if threading off
Revision 1.80 2004/02/17 17:38:11 daniel

View File

@ -289,7 +289,7 @@ var
s : string;
idx : longint;
begin
s:=msg^.get(w);
s:=msg^.get(w,[]);
idx:=pos('_',s);
if idx>0 then
Loadprefix:=Copy(s,idx+1,255)
@ -579,35 +579,35 @@ var
procedure Message(w:longint);
begin
MaybeLoadMessageFile;
Msg2Comment(msg^.Get(w));
Msg2Comment(msg^.Get(w,[]));
end;
procedure Message1(w:longint;const s1:string);
begin
MaybeLoadMessageFile;
Msg2Comment(msg^.Get1(w,s1));
Msg2Comment(msg^.Get(w,[s1]));
end;
procedure Message2(w:longint;const s1,s2:string);
begin
MaybeLoadMessageFile;
Msg2Comment(msg^.Get2(w,s1,s2));
Msg2Comment(msg^.Get(w,[s1,s2]));
end;
procedure Message3(w:longint;const s1,s2,s3:string);
begin
MaybeLoadMessageFile;
Msg2Comment(msg^.Get3(w,s1,s2,s3));
Msg2Comment(msg^.Get(w,[s1,s2,s3]));
end;
procedure Message4(w:longint;const s1,s2,s3,s4:string);
begin
MaybeLoadMessageFile;
Msg2Comment(msg^.Get4(w,s1,s2,s3,s4));
Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]));
end;
@ -618,7 +618,7 @@ var
oldpos:=aktfilepos;
aktfilepos:=pos;
MaybeLoadMessageFile;
Msg2Comment(msg^.Get(w));
Msg2Comment(msg^.Get(w,[]));
aktfilepos:=oldpos;
end;
@ -630,7 +630,7 @@ var
oldpos:=aktfilepos;
aktfilepos:=pos;
MaybeLoadMessageFile;
Msg2Comment(msg^.Get1(w,s1));
Msg2Comment(msg^.Get(w,[s1]));
aktfilepos:=oldpos;
end;
@ -642,7 +642,7 @@ var
oldpos:=aktfilepos;
aktfilepos:=pos;
MaybeLoadMessageFile;
Msg2Comment(msg^.Get2(w,s1,s2));
Msg2Comment(msg^.Get(w,[s1,s2]));
aktfilepos:=oldpos;
end;
@ -654,7 +654,7 @@ var
oldpos:=aktfilepos;
aktfilepos:=pos;
MaybeLoadMessageFile;
Msg2Comment(msg^.Get3(w,s1,s2,s3));
Msg2Comment(msg^.Get(w,[s1,s2,s3]));
aktfilepos:=oldpos;
end;
@ -666,7 +666,7 @@ var
oldpos:=aktfilepos;
aktfilepos:=pos;
MaybeLoadMessageFile;
Msg2Comment(msg^.Get4(w,s1,s2,s3,s4));
Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]));
aktfilepos:=oldpos;
end;
@ -823,7 +823,12 @@ finalization
end.
{
$Log$
Revision 1.29 2004-02-15 12:17:59 peter
Revision 1.30 2004-02-20 19:49:21 daniel
* Message system uses open arrays internally
* Bugfix for string handling in array constructor node
* Micro code reductions in pdecl.pas
Revision 1.29 2004/02/15 12:17:59 peter
* reset compiling_module, fixes crash in ide with second compile
Revision 1.28 2003/10/08 19:17:43 peter