* va_list -> array of const

This commit is contained in:
peter 1998-11-10 10:09:08 +00:00
parent 2b9d08c912
commit 0353e61e9b
9 changed files with 284 additions and 160 deletions

View File

@ -152,8 +152,13 @@ implementation
getlabel(truelabel); getlabel(truelabel);
getlabel(falselabel); getlabel(falselabel);
secondpass(p^.left); secondpass(p^.left);
{ filter array constructor with c styled args }
if is_array_constructor(p^.left^.resulttype) and p^.left^.cargs then
begin
{ nothing, everything is already pushed }
end
{ in codegen.handleread.. defcoll^.data is set to nil } { in codegen.handleread.. defcoll^.data is set to nil }
if assigned(defcoll^.data) and else if assigned(defcoll^.data) and
(defcoll^.data^.deftype=formaldef) then (defcoll^.data^.deftype=formaldef) then
begin begin
{ allow @var } { allow @var }
@ -173,8 +178,7 @@ implementation
end end
else else
begin begin
if (defcoll^.paratyp<>vs_va_list) and if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
CGMessage(type_e_mismatch) CGMessage(type_e_mismatch)
else else
begin begin
@ -640,12 +644,7 @@ implementation
falselabel:=oflabel; falselabel:=oflabel;
{ push from right to left } { push from right to left }
if not push_from_left_to_right and assigned(p^.right) then if not push_from_left_to_right and assigned(p^.right) then
begin secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,inlined,para_offset);
if defcoll^.paratyp=vs_va_list then
secondcallparan(p^.right,defcoll,push_from_left_to_right,inlined,para_offset)
else
secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,inlined,para_offset);
end;
end; end;
@ -1521,7 +1520,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.39 1998-11-09 11:44:33 peter Revision 1.40 1998-11-10 10:09:08 peter
* va_list -> array of const
Revision 1.39 1998/11/09 11:44:33 peter
+ va_list for printf support + va_list for printf support
Revision 1.38 1998/10/21 15:12:49 pierre Revision 1.38 1998/10/21 15:12:49 pierre

View File

@ -49,7 +49,7 @@ implementation
cobjects,verbose,globals,systems, cobjects,verbose,globals,systems,
symtable,aasm,types, symtable,aasm,types,
hcodegen,temp_gen,pass_2, hcodegen,temp_gen,pass_2,
cgai386,tgeni386; cgai386,tgeni386,cg386cnv;
{***************************************************************************** {*****************************************************************************
SecondLoad SecondLoad
@ -585,6 +585,7 @@ implementation
LOC_CREGISTER : begin LOC_CREGISTER : begin
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L, exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
t.register,newreference(ref)))); t.register,newreference(ref))));
ungetregister32(t.register); { the register is not needed anymore }
end; end;
LOC_MEM, LOC_MEM,
LOC_REFERENCE : begin LOC_REFERENCE : begin
@ -598,6 +599,29 @@ implementation
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L, exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
R_EDI,newreference(ref)))); R_EDI,newreference(ref))));
end; end;
ungetiftemp(t.reference);
end;
else
internalerror(330);
end;
end;
procedure emit_push_loc(const t:tlocation);
begin
case t.loc of
LOC_REGISTER,
LOC_CREGISTER : begin
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,t.register)));
ungetregister32(t.register); { the register is not needed anymore }
end;
LOC_MEM,
LOC_REFERENCE : begin
if t.reference.isintvalue then
exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,t.reference.offset)))
else
exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(t.reference))));
ungetiftemp(t.reference);
end; end;
else else
internalerror(330); internalerror(330);
@ -622,7 +646,6 @@ implementation
end; end;
procedure emit_lea_loc_ref(const t:tlocation;const ref:treference); procedure emit_lea_loc_ref(const t:tlocation;const ref:treference);
begin begin
case t.loc of case t.loc of
@ -637,6 +660,28 @@ implementation
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L, exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
R_EDI,newreference(ref)))); R_EDI,newreference(ref))));
end; end;
ungetiftemp(t.reference);
end;
else
internalerror(332);
end;
end;
procedure emit_push_lea_loc(const t:tlocation);
begin
case t.loc of
LOC_MEM,
LOC_REFERENCE : begin
if t.reference.isintvalue then
internalerror(331)
else
begin
exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
newreference(t.reference),R_EDI)));
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
end;
ungetiftemp(t.reference);
end; end;
else else
internalerror(332); internalerror(332);
@ -652,10 +697,13 @@ implementation
vaddr : boolean; vaddr : boolean;
vtype : longint; vtype : longint;
begin begin
clear_reference(p^.location.reference); if not p^.cargs then
gettempofsizereference((parraydef(p^.resulttype)^.highrange+1)*8,p^.location.reference); begin
clear_reference(p^.location.reference);
gettempofsizereference((parraydef(p^.resulttype)^.highrange+1)*8,p^.location.reference);
href:=p^.location.reference;
end;
hp:=p; hp:=p;
href:=p^.location.reference;
while assigned(hp) do while assigned(hp) do
begin begin
secondpass(hp^.left); secondpass(hp^.left);
@ -706,19 +754,33 @@ implementation
end; end;
if vtype=$ff then if vtype=$ff then
internalerror(14357); internalerror(14357);
{ update href to the vtype field and write it } { write C style pushes or an pascal array }
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L, if p^.cargs then
vtype,newreference(href))));
inc(href.offset,4);
{ write changing field update href to the next element }
if vaddr then
begin begin
emit_to_reference(hp^.left); if vaddr then
emit_lea_loc_ref(hp^.left^.location,href) begin
emit_to_reference(hp^.left);
emit_push_lea_loc(hp^.left^.location);
end
else
emit_push_loc(hp^.left^.location);
end end
else else
emit_mov_loc_ref(hp^.left^.location,href); begin
inc(href.offset,4); { update href to the vtype field and write it }
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,
vtype,newreference(href))));
inc(href.offset,4);
{ write changing field update href to the next element }
if vaddr then
begin
emit_to_reference(hp^.left);
emit_lea_loc_ref(hp^.left^.location,href);
end
else
emit_mov_loc_ref(hp^.left^.location,href);
inc(href.offset,4);
end;
{ load next entry } { load next entry }
hp:=hp^.right; hp:=hp^.right;
end; end;
@ -728,7 +790,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.25 1998-11-05 12:02:35 peter Revision 1.26 1998-11-10 10:09:10 peter
* va_list -> array of const
Revision 1.25 1998/11/05 12:02:35 peter
* released useansistring * released useansistring
* removed -Sv, its now available in fpc modes * removed -Sv, its now available in fpc modes

View File

@ -157,7 +157,7 @@ unit parser;
oldaktoutputformat : tasm; oldaktoutputformat : tasm;
oldaktoptprocessor : tprocessors; oldaktoptprocessor : tprocessors;
oldaktasmmode : tasmmode; oldaktasmmode : tasmmode;
oldaktmodeswitches : tmodeswitches;
{$ifdef USEEXCEPT} {$ifdef USEEXCEPT}
recoverpos : jmp_buf; recoverpos : jmp_buf;
oldrecoverpos : pjmp_buf; oldrecoverpos : pjmp_buf;
@ -209,6 +209,7 @@ unit parser;
oldaktoptprocessor:=aktoptprocessor; oldaktoptprocessor:=aktoptprocessor;
oldaktasmmode:=aktasmmode; oldaktasmmode:=aktasmmode;
oldaktfilepos:=aktfilepos; oldaktfilepos:=aktfilepos;
oldaktmodeswitches:=aktmodeswitches;
{ show info } { show info }
Message1(parser_i_compiling,filename); Message1(parser_i_compiling,filename);
@ -371,6 +372,7 @@ unit parser;
aktoptprocessor:=oldaktoptprocessor; aktoptprocessor:=oldaktoptprocessor;
aktasmmode:=oldaktasmmode; aktasmmode:=oldaktasmmode;
aktfilepos:=oldaktfilepos; aktfilepos:=oldaktfilepos;
aktmodeswitches:=oldaktmodeswitches;
end; end;
{ Shut down things when the last file is compiled } { Shut down things when the last file is compiled }
if (compile_level=1) then if (compile_level=1) then
@ -422,7 +424,10 @@ unit parser;
end. end.
{ {
$Log$ $Log$
Revision 1.60 1998-10-28 18:26:14 pierre Revision 1.61 1998-11-10 10:09:11 peter
* va_list -> array of const
Revision 1.60 1998/10/28 18:26:14 pierre
* removed some erros after other errors (introduced by useexcept) * removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !) * stabs works again correctly (for how long !)

View File

@ -94,7 +94,7 @@
targconvtyp = (act_convertable,act_equal,act_exact); targconvtyp = (act_convertable,act_equal,act_exact);
tvarspez = (vs_value,vs_const,vs_var,vs_va_list); tvarspez = (vs_value,vs_const,vs_var);
pdefcoll = ^tdefcoll; pdefcoll = ^tdefcoll;
tdefcoll = record tdefcoll = record
@ -483,7 +483,10 @@
{ {
$Log$ $Log$
Revision 1.8 1998-11-09 11:44:37 peter Revision 1.9 1998-11-10 10:09:14 peter
* va_list -> array of const
Revision 1.8 1998/11/09 11:44:37 peter
+ va_list for printf support + va_list for printf support
Revision 1.7 1998/11/05 12:02:59 peter Revision 1.7 1998/11/05 12:02:59 peter

View File

@ -66,12 +66,7 @@ implementation
if defcoll=nil then if defcoll=nil then
firstcallparan(p^.right,nil) firstcallparan(p^.right,nil)
else else
begin firstcallparan(p^.right,defcoll^.next);
if defcoll^.paratyp=vs_va_list then
firstcallparan(p^.right,defcoll)
else
firstcallparan(p^.right,defcoll^.next);
end;
p^.registers32:=p^.right^.registers32; p^.registers32:=p^.right^.registers32;
p^.registersfpu:=p^.right^.registersfpu; p^.registersfpu:=p^.right^.registersfpu;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
@ -97,12 +92,12 @@ implementation
{ conversions are inserted } { conversions are inserted }
else else
begin begin
if count_ref then if count_ref then
begin begin
store_valid:=must_be_valid; store_valid:=must_be_valid;
if (defcoll^.paratyp=vs_var) then if (defcoll^.paratyp=vs_var) then
test_protected(p^.left); test_protected(p^.left);
if not(defcoll^.paratyp in [vs_var,vs_va_list]) then if (defcoll^.paratyp<>vs_var) then
must_be_valid:=true must_be_valid:=true
else else
must_be_valid:=false; must_be_valid:=false;
@ -158,10 +153,22 @@ implementation
) and ) and
not(is_equal(p^.left^.resulttype,defcoll^.data))) then not(is_equal(p^.left^.resulttype,defcoll^.data))) then
CGMessage(parser_e_call_by_ref_without_typeconv); CGMessage(parser_e_call_by_ref_without_typeconv);
{ process cargs arrayconstructor }
if is_array_constructor(p^.left^.resulttype) and
(aktcallprocsym^.definition^.options and pocdecl<>0) and
(aktcallprocsym^.definition^.options and poexternal<>0) then
begin
p^.left^.cargs:=true;
old_array_constructor:=allow_array_constructor;
allow_array_constructor:=true;
firstpass(p^.left);
allow_array_constructor:=old_array_constructor;
end;
{ don't generate an type conversion for open arrays } { don't generate an type conversion for open arrays }
{ else we loss the ranges } { else we loss the ranges }
if is_open_array(defcoll^.data) then if is_open_array(defcoll^.data) then
begin begin
{ insert type conv but hold the ranges of the array }
oldtype:=p^.left^.resulttype; oldtype:=p^.left^.resulttype;
p^.left:=gentypeconvnode(p^.left,defcoll^.data); p^.left:=gentypeconvnode(p^.left,defcoll^.data);
firstpass(p^.left); firstpass(p^.left);
@ -185,15 +192,8 @@ implementation
(defcoll^.paratyp=vs_var) and (defcoll^.paratyp=vs_var) and
not(is_equal(p^.left^.resulttype,defcoll^.data)) then not(is_equal(p^.left^.resulttype,defcoll^.data)) then
CGMessage(type_e_strict_var_string_violation); CGMessage(type_e_strict_var_string_violation);
{ va_list always uses pchars } { Variablen for call by reference may not be copied }
if (defcoll^.paratyp=vs_va_list) and { into a register }
is_shortstring(p^.left^.resulttype) then
begin
p^.left:=gentypeconvnode(p^.left,charpointerdef);
firstpass(p^.left);
end;
{ Variablen, die call by reference <20>bergeben werden, }
{ k”nnen nicht in ein Register kopiert werden }
{ is this usefull here ? } { is this usefull here ? }
{ this was missing in formal parameter list } { this was missing in formal parameter list }
if defcoll^.paratyp=vs_var then if defcoll^.paratyp=vs_var then
@ -202,8 +202,7 @@ implementation
make_not_regable(p^.left); make_not_regable(p^.left);
end; end;
if defcoll^.paratyp<>vs_va_list then p^.resulttype:=defcoll^.data;
p^.resulttype:=defcoll^.data;
end; end;
if p^.left^.registers32>p^.registers32 then if p^.left^.registers32>p^.registers32 then
p^.registers32:=p^.left^.registers32; p^.registers32:=p^.left^.registers32;
@ -233,7 +232,7 @@ implementation
var var
hp,procs,hp2 : pprocdefcoll; hp,procs,hp2 : pprocdefcoll;
pd : pprocdef; pd : pprocdef;
actprocsym : pprocsym; oldcallprocsym : pprocsym;
nextprocsym : pprocsym; nextprocsym : pprocsym;
def_from,def_to,conv_to : pdef; def_from,def_to,conv_to : pdef;
pt,inlinecode : ptree; pt,inlinecode : ptree;
@ -300,6 +299,9 @@ implementation
store_valid:=must_be_valid; store_valid:=must_be_valid;
must_be_valid:=false; must_be_valid:=false;
oldcallprocsym:=aktcallprocsym;
aktcallprocsym:=nil;
inlined:=false; inlined:=false;
if assigned(p^.procdefinition) and if assigned(p^.procdefinition) and
((p^.procdefinition^.options and poinline)<>0) then ((p^.procdefinition^.options and poinline)<>0) then
@ -381,10 +383,11 @@ implementation
exit; exit;
end; end;
aktcallprocsym:=pprocsym(p^.symtableprocentry);
{ do we know the procedure to call ? } { do we know the procedure to call ? }
if not(assigned(p^.procdefinition)) then if not(assigned(p^.procdefinition)) then
begin begin
actprocsym:=pprocsym(p^.symtableprocentry);
{$ifdef TEST_PROCSYMS} {$ifdef TEST_PROCSYMS}
if (p^.unit_specific) or if (p^.unit_specific) or
assigned(p^.methodpointer) then assigned(p^.methodpointer) then
@ -422,7 +425,7 @@ implementation
end; end;
{ link all procedures which have the same # of parameters } { link all procedures which have the same # of parameters }
pd:=actprocsym^.definition; pd:=aktcallprocsym^.definition;
while assigned(pd) do while assigned(pd) do
begin begin
{ we should also check that the overloaded function { we should also check that the overloaded function
@ -447,7 +450,7 @@ implementation
pdc:=pdc^.next; pdc:=pdc^.next;
end; end;
{ only when the # of parameter are equal } { only when the # of parameter are equal }
if (l=paralength) or ((l=1) and (pd^.para1^.paratyp=vs_va_list)) then if (l=paralength) then
begin begin
new(hp); new(hp);
hp^.data:=pd; hp^.data:=pd;
@ -467,102 +470,97 @@ implementation
(nextprocsym=nil) then (nextprocsym=nil) then
begin begin
CGMessage(parser_e_wrong_parameter_size); CGMessage(parser_e_wrong_parameter_size);
actprocsym^.write_parameter_lists; aktcallprocsym^.write_parameter_lists;
exit; exit;
end; end;
{ now we can compare parameter after parameter } { now we can compare parameter after parameter }
if assigned(procs) and pt:=p^.left;
(not assigned(procs^.nextpara) or while assigned(pt) do
(procs^.nextpara^.paratyp<>vs_va_list)) then begin
begin { matches a parameter of one procedure exact ? }
pt:=p^.left; exactmatch:=false;
while assigned(pt) do hp:=procs;
begin while assigned(hp) do
{ matches a parameter of one procedure exact ? } begin
exactmatch:=false; if is_equal(hp^.nextpara^.data,pt^.resulttype) then
hp:=procs; begin
while assigned(hp) do if hp^.nextpara^.data=pt^.resulttype then
begin begin
if is_equal(hp^.nextpara^.data,pt^.resulttype) then pt^.exact_match_found:=true;
begin hp^.nextpara^.argconvtyp:=act_exact;
if hp^.nextpara^.data=pt^.resulttype then end
begin else
pt^.exact_match_found:=true; hp^.nextpara^.argconvtyp:=act_equal;
hp^.nextpara^.argconvtyp:=act_exact; exactmatch:=true;
end end
else else
hp^.nextpara^.argconvtyp:=act_equal; hp^.nextpara^.argconvtyp:=act_convertable;
exactmatch:=true; hp:=hp^.next;
end end;
else
hp^.nextpara^.argconvtyp:=act_convertable;
hp:=hp^.next;
end;
{ .... if yes, del all the other procedures } { .... if yes, del all the other procedures }
if exactmatch then if exactmatch then
begin begin
{ the first .... } { the first .... }
while (assigned(procs)) and not(is_equal(procs^.nextpara^.data,pt^.resulttype)) do while (assigned(procs)) and not(is_equal(procs^.nextpara^.data,pt^.resulttype)) do
begin begin
hp:=procs^.next; hp:=procs^.next;
dispose(procs); dispose(procs);
procs:=hp; procs:=hp;
end; end;
{ and the others } { and the others }
hp:=procs; hp:=procs;
while (assigned(hp)) and assigned(hp^.next) do while (assigned(hp)) and assigned(hp^.next) do
begin begin
if not(is_equal(hp^.next^.nextpara^.data,pt^.resulttype)) then if not(is_equal(hp^.next^.nextpara^.data,pt^.resulttype)) then
begin begin
hp2:=hp^.next^.next; hp2:=hp^.next^.next;
dispose(hp^.next); dispose(hp^.next);
hp^.next:=hp2; hp^.next:=hp2;
end end
else else
hp:=hp^.next; hp:=hp^.next;
end; end;
end end
{ when a parameter matches exact, remove all procs { when a parameter matches exact, remove all procs
which need typeconvs } which need typeconvs }
else else
begin begin
{ the first... } { the first... }
while (assigned(procs)) and while (assigned(procs)) and
not(isconvertable(pt^.resulttype,procs^.nextpara^.data, not(isconvertable(pt^.resulttype,procs^.nextpara^.data,
hcvt,pt^.left^.treetype,false)) do hcvt,pt^.left^.treetype,false)) do
begin begin
hp:=procs^.next; hp:=procs^.next;
dispose(procs); dispose(procs);
procs:=hp; procs:=hp;
end; end;
{ and the others } { and the others }
hp:=procs; hp:=procs;
while (assigned(hp)) and assigned(hp^.next) do while (assigned(hp)) and assigned(hp^.next) do
begin begin
if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data, if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data,
hcvt,pt^.left^.treetype,false)) then hcvt,pt^.left^.treetype,false)) then
begin begin
hp2:=hp^.next^.next; hp2:=hp^.next^.next;
dispose(hp^.next); dispose(hp^.next);
hp^.next:=hp2; hp^.next:=hp2;
end end
else else
hp:=hp^.next; hp:=hp^.next;
end; end;
end; end;
{ update nextpara for all procedures } { update nextpara for all procedures }
hp:=procs; hp:=procs;
while assigned(hp) do while assigned(hp) do
begin begin
hp^.nextpara:=hp^.nextpara^.next; hp^.nextpara:=hp^.nextpara^.next;
hp:=hp^.next; hp:=hp^.next;
end; end;
{ load next parameter } { load next parameter }
pt:=pt^.right; pt:=pt^.right;
end; end;
end;
if not assigned(procs) then if not assigned(procs) then
begin begin
@ -572,7 +570,7 @@ implementation
(nextprocsym=nil) then (nextprocsym=nil) then
begin begin
CGMessage(parser_e_wrong_parameter_type); CGMessage(parser_e_wrong_parameter_type);
actprocsym^.write_parameter_lists; aktcallprocsym^.write_parameter_lists;
exit; exit;
end end
else else
@ -698,7 +696,7 @@ implementation
if assigned(procs^.next) then if assigned(procs^.next) then
begin begin
CGMessage(cg_e_cant_choose_overload_function); CGMessage(cg_e_cant_choose_overload_function);
actprocsym^.write_parameter_lists; aktcallprocsym^.write_parameter_lists;
end; end;
{$ifdef TEST_PROCSYMS} {$ifdef TEST_PROCSYMS}
if (procs=nil) and assigned(nextprocsym) then if (procs=nil) and assigned(nextprocsym) then
@ -736,7 +734,7 @@ implementation
p^.methodpointer:=nil; p^.methodpointer:=nil;
end; end;
{$endif CHAINPROCSYMS} {$endif CHAINPROCSYMS}
end;{ end of procedure to call determination } end; { end of procedure to call determination }
is_const:=((p^.procdefinition^.options and pointernconst)<>0) and is_const:=((p^.procdefinition^.options and pointernconst)<>0) and
((block_type=bt_const) or ((block_type=bt_const) or
@ -923,6 +921,7 @@ implementation
end; end;
if assigned(procs) then if assigned(procs) then
dispose(procs); dispose(procs);
aktcallprocsym:=oldcallprocsym;
must_be_valid:=store_valid; must_be_valid:=store_valid;
end; end;
@ -942,7 +941,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.10 1998-11-09 11:44:41 peter Revision 1.11 1998-11-10 10:09:17 peter
* va_list -> array of const
Revision 1.10 1998/11/09 11:44:41 peter
+ va_list for printf support + va_list for printf support
Revision 1.9 1998/10/28 18:26:22 pierre Revision 1.9 1998/10/28 18:26:22 pierre

View File

@ -340,6 +340,8 @@ implementation
procedure firstarrayconstruct(var p : ptree); procedure firstarrayconstruct(var p : ptree);
var var
pd : pdef; pd : pdef;
thp,
chp,
hp : ptree; hp : ptree;
len : longint; len : longint;
varia : boolean; varia : boolean;
@ -366,6 +368,13 @@ implementation
hp^.left:=gentypeconvnode(hp^.left,s80floatdef); hp^.left:=gentypeconvnode(hp^.left,s80floatdef);
firstpass(hp^.left); firstpass(hp^.left);
end; end;
stringdef : begin
if p^.cargs then
begin
hp^.left:=gentypeconvnode(hp^.left,charpointerdef);
firstpass(hp^.left);
end;
end;
end; end;
if (pd=nil) then if (pd=nil) then
pd:=hp^.left^.resulttype pd:=hp^.left^.resulttype
@ -375,6 +384,22 @@ implementation
inc(len); inc(len);
hp:=hp^.right; hp:=hp^.right;
end; end;
{ swap the tree for cargs }
if p^.cargs and (not p^.cargswap) then
begin
chp:=nil;
hp:=p;
while assigned(hp) do
begin
thp:=hp^.right;
hp^.right:=chp;
chp:=hp;
hp:=thp;
end;
p:=chp;
p^.cargs:=true;
p^.cargswap:=true;
end;
end; end;
calcregisters(p,0,0,0); calcregisters(p,0,0,0);
p^.resulttype:=new(parraydef,init(0,len-1,pd)); p^.resulttype:=new(parraydef,init(0,len-1,pd));
@ -398,7 +423,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.7 1998-11-05 14:26:48 peter Revision 1.8 1998-11-10 10:09:18 peter
* va_list -> array of const
Revision 1.7 1998/11/05 14:26:48 peter
* fixed variant warning with was sometimes said with sets * fixed variant warning with was sometimes said with sets
Revision 1.6 1998/10/19 08:55:12 pierre Revision 1.6 1998/10/19 08:55:12 pierre

View File

@ -149,7 +149,6 @@ type
_LIBRARY, _LIBRARY,
_PRIVATE, _PRIVATE,
_PROGRAM, _PROGRAM,
_VA_LIST,
_VIRTUAL, _VIRTUAL,
_ABSOLUTE, _ABSOLUTE,
_ABSTRACT, _ABSTRACT,
@ -308,7 +307,6 @@ const
(str:'LIBRARY' ;special:false;keyword:m_all), (str:'LIBRARY' ;special:false;keyword:m_all),
(str:'PRIVATE' ;special:false;keyword:m_none), (str:'PRIVATE' ;special:false;keyword:m_none),
(str:'PROGRAM' ;special:false;keyword:m_all), (str:'PROGRAM' ;special:false;keyword:m_all),
(str:'VA_LIST' ;special:false;keyword:m_fpc),
(str:'VIRTUAL' ;special:false;keyword:m_none), (str:'VIRTUAL' ;special:false;keyword:m_none),
(str:'ABSOLUTE' ;special:false;keyword:m_none), (str:'ABSOLUTE' ;special:false;keyword:m_none),
(str:'ABSTRACT' ;special:false;keyword:m_none), (str:'ABSTRACT' ;special:false;keyword:m_none),
@ -336,7 +334,10 @@ const
{ {
$Log$ $Log$
Revision 1.4 1998-11-09 11:44:42 peter Revision 1.5 1998-11-10 10:09:19 peter
* va_list -> array of const
Revision 1.4 1998/11/09 11:44:42 peter
+ va_list for printf support + va_list for printf support
Revision 1.3 1998/10/16 14:21:05 daniel Revision 1.3 1998/10/16 14:21:05 daniel

View File

@ -228,6 +228,7 @@ unit tree;
labeln,goton : (labelnr : plabel); labeln,goton : (labelnr : plabel);
withn : (withsymtable : psymtable;tablecount : longint); withn : (withsymtable : psymtable;tablecount : longint);
onn : (exceptsymtable : psymtable;excepttype : pobjectdef); onn : (exceptsymtable : psymtable;excepttype : pobjectdef);
arrayconstructn : (cargs,cargswap: boolean);
end; end;
function gennode(t : ttreetyp;l,r : ptree) : ptree; function gennode(t : ttreetyp;l,r : ptree) : ptree;
@ -1601,7 +1602,10 @@ unit tree;
end. end.
{ {
$Log$ $Log$
Revision 1.49 1998-11-05 12:03:07 peter Revision 1.50 1998-11-10 10:09:20 peter
* va_list -> array of const
Revision 1.49 1998/11/05 12:03:07 peter
* released useansistring * released useansistring
* removed -Sv, its now available in fpc modes * removed -Sv, its now available in fpc modes

View File

@ -49,22 +49,25 @@ unit types;
{ true if p points to an open array def } { true if p points to an open array def }
function is_open_array(p : pdef) : boolean; function is_open_array(p : pdef) : boolean;
{ true if o is an ansi string def } { true, if p points to an array of const def }
function is_array_constructor(p : pdef) : boolean;
{ true if p is an ansi string def }
function is_ansistring(p : pdef) : boolean; function is_ansistring(p : pdef) : boolean;
{ true if o is a long string def } { true if p is a long string def }
function is_longstring(p : pdef) : boolean; function is_longstring(p : pdef) : boolean;
{ true if o is a wide string def } { true if p is a wide string def }
function is_widestring(p : pdef) : boolean; function is_widestring(p : pdef) : boolean;
{ true if o is a short string def } { true if p is a short string def }
function is_shortstring(p : pdef) : boolean; function is_shortstring(p : pdef) : boolean;
{ true if p is a char array def } { true if p is a char array def }
function is_chararray(p : pdef) : boolean; function is_chararray(p : pdef) : boolean;
{ true if o is a pchar def } { true if p is a pchar def }
function is_pchar(p : pdef) : boolean; function is_pchar(p : pdef) : boolean;
{ returns true, if def defines a signed data type (only for ordinal types) } { returns true, if def defines a signed data type (only for ordinal types) }
@ -259,6 +262,14 @@ unit types;
end; end;
{ true, if p points to an array of const def }
function is_array_constructor(p : pdef) : boolean;
begin
is_array_constructor:=(p^.deftype=arraydef) and
(parraydef(p)^.IsConstructor);
end;
{ true if p is an ansi string def } { true if p is an ansi string def }
function is_ansistring(p : pdef) : boolean; function is_ansistring(p : pdef) : boolean;
begin begin
@ -982,7 +993,10 @@ unit types;
end. end.
{ {
$Log$ $Log$
Revision 1.35 1998-10-19 08:55:13 pierre Revision 1.36 1998-11-10 10:09:21 peter
* va_list -> array of const
Revision 1.35 1998/10/19 08:55:13 pierre
* wrong stabs info corrected once again !! * wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required + variable vmt offset with vmt field only if required
implemented now !!! implemented now !!!