mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 07:43:04 +01:00
* fixed array of const
* generic platform independent high() support
This commit is contained in:
peter
parent
0cfc4c8f6b
commit
4517f917fd
@ -26,10 +26,6 @@ interface
|
||||
uses
|
||||
symtable,tree;
|
||||
|
||||
{ save the size of pushed parameter }
|
||||
var
|
||||
pushedparasize : longint;
|
||||
|
||||
procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
|
||||
push_from_left_to_right,inlined : boolean;para_offset : longint);
|
||||
procedure secondcalln(var p : ptree);
|
||||
@ -52,28 +48,39 @@ implementation
|
||||
SecondCallParaN
|
||||
*****************************************************************************}
|
||||
|
||||
|
||||
procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
|
||||
push_from_left_to_right,inlined : boolean;para_offset : longint);
|
||||
|
||||
procedure maybe_push_high;
|
||||
{$ifdef OLDHIGH}
|
||||
var
|
||||
r : preference;
|
||||
hreg : tregister;
|
||||
href : treference;
|
||||
len : longint;
|
||||
{$endif}
|
||||
begin
|
||||
{ open array ? }
|
||||
{ defcoll^.data can be nil for read/write }
|
||||
if assigned(defcoll^.data) and
|
||||
(is_open_array(defcoll^.data) or
|
||||
is_open_string(defcoll^.data)) then
|
||||
push_high_param(defcoll^.data) then
|
||||
begin
|
||||
{ push high }
|
||||
{$ifndef OLDHIGH}
|
||||
if assigned(p^.hightree) then
|
||||
begin
|
||||
secondpass(p^.hightree);
|
||||
push_value_para(p^.hightree,inlined,para_offset);
|
||||
end
|
||||
else
|
||||
internalerror(432645);
|
||||
{$else}
|
||||
{ push high }
|
||||
case p^.left^.resulttype^.deftype of
|
||||
arraydef : begin
|
||||
if is_open_array(p^.left^.resulttype) then
|
||||
begin
|
||||
p^.location.reference.base:=procinfo.framepointer;
|
||||
p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
|
||||
r:=new_reference(highframepointer,highoffset+4);
|
||||
len:=-1;
|
||||
end
|
||||
@ -101,7 +108,7 @@ implementation
|
||||
len:=str_length(p^.left)
|
||||
else
|
||||
begin
|
||||
href:=p^.left^.location.reference;
|
||||
href:=p^.location.reference;
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(href),R_EDI)));
|
||||
hreg:=R_EDI;
|
||||
len:=-2;
|
||||
@ -148,20 +155,15 @@ implementation
|
||||
push_int(len);
|
||||
end;
|
||||
inc(pushedparasize,4);
|
||||
{$endif OLDHIGH}
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
size : longint;
|
||||
otlabel,hlabel,oflabel : plabel;
|
||||
otlabel,oflabel : plabel;
|
||||
{ temporary variables: }
|
||||
tempdeftype : tdeftype;
|
||||
tempreference : treference;
|
||||
r : preference;
|
||||
opsize : topsize;
|
||||
op : tasmop;
|
||||
hreg : tregister;
|
||||
|
||||
r : preference;
|
||||
begin
|
||||
{ push from left to right if specified }
|
||||
if push_from_left_to_right and assigned(p^.right) then
|
||||
@ -254,391 +256,7 @@ implementation
|
||||
del_reference(p^.left^.location.reference);
|
||||
end
|
||||
else
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER:
|
||||
begin
|
||||
case p^.left^.location.register of
|
||||
R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
|
||||
R_EDI,R_ESP,R_EBP :
|
||||
begin
|
||||
inc(pushedparasize,4);
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
|
||||
p^.left^.location.register,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
|
||||
ungetregister32(p^.left^.location.register);
|
||||
end;
|
||||
R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
|
||||
begin
|
||||
if target_os.stackalignment=4 then
|
||||
begin
|
||||
opsize:=S_L;
|
||||
hreg:=reg16toreg32(p^.left^.location.register);
|
||||
inc(pushedparasize,4);
|
||||
end
|
||||
else
|
||||
begin
|
||||
opsize:=S_W;
|
||||
hreg:=p^.left^.location.register;
|
||||
inc(pushedparasize,2);
|
||||
end;
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,opsize,hreg)));
|
||||
ungetregister32(reg16toreg32(p^.left^.location.register));
|
||||
end;
|
||||
R_AL,R_BL,R_CL,R_DL:
|
||||
begin
|
||||
if target_os.stackalignment=4 then
|
||||
begin
|
||||
opsize:=S_L;
|
||||
hreg:=reg8toreg32(p^.left^.location.register);
|
||||
inc(pushedparasize,4);
|
||||
end
|
||||
else
|
||||
begin
|
||||
opsize:=S_W;
|
||||
hreg:=reg8toreg16(p^.left^.location.register);
|
||||
inc(pushedparasize,2);
|
||||
end;
|
||||
{ we must push always 16 bit }
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,opsize,hreg)));
|
||||
ungetregister32(reg8toreg32(p^.left^.location.register));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
LOC_FPU:
|
||||
begin
|
||||
size:=align(pfloatdef(p^.left^.resulttype)^.size,target_os.stackalignment);
|
||||
inc(pushedparasize,size);
|
||||
if not inlined then
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
|
||||
{$ifdef GDB}
|
||||
if (cs_debuginfo in aktmoduleswitches) and
|
||||
(exprasmlist^.first=exprasmlist^.last) then
|
||||
exprasmlist^.concat(new(pai_force_line,init));
|
||||
{$endif GDB}
|
||||
r:=new_reference(R_ESP,0);
|
||||
floatstoreops(pfloatdef(p^.left^.resulttype)^.typ,op,opsize);
|
||||
{ this is the easiest case for inlined !! }
|
||||
if inlined then
|
||||
begin
|
||||
r^.base:=procinfo.framepointer;
|
||||
r^.offset:=para_offset-pushedparasize;
|
||||
end;
|
||||
exprasmlist^.concat(new(pai386,op_ref(op,opsize,r)));
|
||||
end;
|
||||
LOC_REFERENCE,LOC_MEM:
|
||||
begin
|
||||
tempreference:=p^.left^.location.reference;
|
||||
del_reference(p^.left^.location.reference);
|
||||
case p^.resulttype^.deftype of
|
||||
enumdef,
|
||||
orddef :
|
||||
begin
|
||||
case p^.resulttype^.size of
|
||||
8 : begin
|
||||
inc(pushedparasize,8);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
inc(tempreference.offset,4);
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize+4);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(tempreference.offset,4);
|
||||
emit_push_mem(tempreference);
|
||||
dec(tempreference.offset,4);
|
||||
emit_push_mem(tempreference);
|
||||
end;
|
||||
end;
|
||||
4 : begin
|
||||
inc(pushedparasize,4);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
end;
|
||||
1,2 : begin
|
||||
if target_os.stackalignment=4 then
|
||||
begin
|
||||
opsize:=S_L;
|
||||
hreg:=R_EDI;
|
||||
inc(pushedparasize,4);
|
||||
end
|
||||
else
|
||||
begin
|
||||
opsize:=S_W;
|
||||
hreg:=R_DI;
|
||||
inc(pushedparasize,2);
|
||||
end;
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
|
||||
newreference(tempreference),hreg)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_ref(A_PUSH,opsize,
|
||||
newreference(tempreference))));
|
||||
end;
|
||||
else
|
||||
internalerror(234231);
|
||||
end;
|
||||
end;
|
||||
floatdef :
|
||||
begin
|
||||
case pfloatdef(p^.resulttype)^.typ of
|
||||
f32bit,
|
||||
s32real :
|
||||
begin
|
||||
inc(pushedparasize,4);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
end;
|
||||
s64real,
|
||||
s64bit :
|
||||
begin
|
||||
inc(pushedparasize,4);
|
||||
inc(tempreference.offset,4);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
inc(pushedparasize,4);
|
||||
dec(tempreference.offset,4);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
end;
|
||||
s80real :
|
||||
begin
|
||||
inc(pushedparasize,4);
|
||||
if target_os.stackalignment=4 then
|
||||
inc(tempreference.offset,8)
|
||||
else
|
||||
inc(tempreference.offset,6);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
dec(tempreference.offset,4);
|
||||
inc(pushedparasize,4);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
if target_os.stackalignment=4 then
|
||||
begin
|
||||
opsize:=S_L;
|
||||
hreg:=R_EDI;
|
||||
inc(pushedparasize,4);
|
||||
dec(tempreference.offset,4);
|
||||
end
|
||||
else
|
||||
begin
|
||||
opsize:=S_W;
|
||||
hreg:=R_DI;
|
||||
inc(pushedparasize,2);
|
||||
dec(tempreference.offset,2);
|
||||
end;
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
|
||||
newreference(tempreference),hreg)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_ref(A_PUSH,opsize,
|
||||
newreference(tempreference))));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
pointerdef,procvardef,
|
||||
classrefdef:
|
||||
begin
|
||||
inc(pushedparasize,4);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
end;
|
||||
arraydef,recorddef,stringdef,setdef,objectdef :
|
||||
begin
|
||||
{ even some structured types are 32 bit }
|
||||
if is_widestring(p^.resulttype) or
|
||||
is_ansistring(p^.resulttype) or
|
||||
is_smallset(p^.resulttype) or
|
||||
((p^.resulttype^.deftype=objectdef) and
|
||||
pobjectdef(p^.resulttype)^.isclass) then
|
||||
begin
|
||||
inc(pushedparasize,4);
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
concatcopy(tempreference,r^,4,false,false);
|
||||
end
|
||||
else
|
||||
emit_push_mem(tempreference);
|
||||
end
|
||||
{ call by value open array ? }
|
||||
else
|
||||
internalerror(8954);
|
||||
end;
|
||||
else
|
||||
CGMessage(cg_e_illegal_expression);
|
||||
end;
|
||||
end;
|
||||
LOC_JUMP:
|
||||
begin
|
||||
getlabel(hlabel);
|
||||
if target_os.stackalignment=4 then
|
||||
begin
|
||||
opsize:=S_L;
|
||||
inc(pushedparasize,4);
|
||||
end
|
||||
else
|
||||
begin
|
||||
opsize:=S_W;
|
||||
inc(pushedparasize,2);
|
||||
end;
|
||||
emitl(A_LABEL,truelabel);
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,1,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_const(A_PUSH,opsize,1)));
|
||||
emitl(A_JMP,hlabel);
|
||||
emitl(A_LABEL,falselabel);
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,0,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_const(A_PUSH,opsize,0)));
|
||||
emitl(A_LABEL,hlabel);
|
||||
end;
|
||||
LOC_FLAGS:
|
||||
begin
|
||||
if not(R_EAX in unused) then
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));
|
||||
exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
|
||||
R_AL)));
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,R_AL,R_AX)));
|
||||
if target_os.stackalignment=4 then
|
||||
begin
|
||||
opsize:=S_L;
|
||||
hreg:=R_EAX;
|
||||
inc(pushedparasize,4);
|
||||
end
|
||||
else
|
||||
begin
|
||||
opsize:=S_W;
|
||||
hreg:=R_AX;
|
||||
inc(pushedparasize,2);
|
||||
end;
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,opsize,hreg)));
|
||||
if not(R_EAX in unused) then
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EDI,R_EAX)));
|
||||
end;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
LOC_MMXREGISTER,
|
||||
LOC_CMMXREGISTER:
|
||||
begin
|
||||
inc(pushedparasize,8); { was missing !!! (PM) }
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(
|
||||
A_SUB,S_L,8,R_ESP)));
|
||||
{$ifdef GDB}
|
||||
if (cs_debuginfo in aktmoduleswitches) and
|
||||
(exprasmlist^.first=exprasmlist^.last) then
|
||||
exprasmlist^.concat(new(pai_force_line,init));
|
||||
{$endif GDB}
|
||||
if inlined then
|
||||
begin
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO,
|
||||
p^.left^.location.register,r)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
r:=new_reference(R_ESP,0);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(
|
||||
A_MOVQ,S_NO,p^.left^.location.register,r)));
|
||||
end;
|
||||
end;
|
||||
{$endif SUPPORT_MMX}
|
||||
end;
|
||||
push_value_para(p^.left,inlined,para_offset);
|
||||
end;
|
||||
freelabel(truelabel);
|
||||
freelabel(falselabel);
|
||||
@ -1614,7 +1232,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.57 1999-01-21 16:40:51 pierre
|
||||
Revision 1.58 1999-01-21 22:10:35 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.57 1999/01/21 16:40:51 pierre
|
||||
* fix for constructor inside with statements
|
||||
|
||||
Revision 1.56 1998/12/30 13:41:05 peter
|
||||
|
||||
@ -29,6 +29,8 @@ interface
|
||||
uses
|
||||
tree;
|
||||
|
||||
procedure loadshortstring(p:ptree);
|
||||
|
||||
procedure secondtypeconv(var p : ptree);
|
||||
procedure secondas(var p : ptree);
|
||||
procedure secondis(var p : ptree);
|
||||
@ -39,9 +41,91 @@ implementation
|
||||
uses
|
||||
cobjects,verbose,globals,systems,
|
||||
symtable,aasm,types,
|
||||
hcodegen,temp_gen,pass_2,
|
||||
hcodegen,temp_gen,pass_2,pass_1,
|
||||
i386,cgai386,tgeni386;
|
||||
|
||||
|
||||
|
||||
procedure push_shortstring_length(p:ptree);
|
||||
var
|
||||
r : preference;
|
||||
hightree : ptree;
|
||||
|
||||
begin
|
||||
if is_open_string(p^.resulttype) then
|
||||
begin
|
||||
getsymonlyin(p^.symtable,'high'+pvarsym(p^.symtableentry)^.name);
|
||||
hightree:=genloadnode(pvarsym(srsym),p^.symtable);
|
||||
firstpass(hightree);
|
||||
secondpass(hightree);
|
||||
push_value_para(hightree,false,0);
|
||||
disposetree(hightree);
|
||||
{ r:=new_reference(highframepointer,highoffset+4);
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,r,R_EDI)));
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI))); }
|
||||
end
|
||||
else
|
||||
begin
|
||||
push_int(pstringdef(p^.resulttype)^.len);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure loadshortstring(p:ptree);
|
||||
{
|
||||
Load a string, handles stringdef and orddef (char) types
|
||||
}
|
||||
begin
|
||||
case p^.right^.resulttype^.deftype of
|
||||
stringdef:
|
||||
begin
|
||||
if (p^.right^.treetype=stringconstn) and
|
||||
(str_length(p^.right)=0) then
|
||||
exprasmlist^.concat(new(pai386,op_const_ref(
|
||||
A_MOV,S_B,0,newreference(p^.left^.location.reference))))
|
||||
else
|
||||
begin
|
||||
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
push_shortstring_length(p^.left);
|
||||
emitcall('FPC_SHORTSTR_COPY',true);
|
||||
maybe_loadesi;
|
||||
end;
|
||||
end;
|
||||
orddef:
|
||||
begin
|
||||
if p^.right^.treetype=ordconstn then
|
||||
exprasmlist^.concat(new(pai386,op_const_ref(
|
||||
A_MOV,S_W,p^.right^.value*256+1,newreference(p^.left^.location.reference))))
|
||||
else
|
||||
begin
|
||||
{ not so elegant (goes better with extra register }
|
||||
if (p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(
|
||||
A_MOV,S_L,makereg32(p^.right^.location.register),R_EDI)));
|
||||
ungetregister(p^.right^.location.register);
|
||||
end
|
||||
else
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(
|
||||
A_MOV,S_L,newreference(p^.right^.location.reference),R_EDI)));
|
||||
del_reference(p^.right^.location.reference);
|
||||
end;
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,8,R_EDI)));
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(A_OR,S_L,1,R_EDI)));
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(
|
||||
A_MOV,S_W,R_DI,newreference(p^.left^.location.reference))));
|
||||
end;
|
||||
end;
|
||||
else
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SecondTypeConv
|
||||
*****************************************************************************}
|
||||
@ -1478,7 +1562,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.44 1999-01-19 10:18:59 florian
|
||||
Revision 1.45 1999-01-21 22:10:36 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.44 1999/01/19 10:18:59 florian
|
||||
* bug with mul. of dwords fixed, reported by Alexander Stohr
|
||||
* some changes to compile with TP
|
||||
+ small enhancements for the new code generator
|
||||
|
||||
@ -621,6 +621,7 @@ implementation
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
|
||||
p^.location.register:=reg16toreg8(p^.location.register);
|
||||
end;
|
||||
{$ifdef OLDHIGH}
|
||||
in_high_x :
|
||||
begin
|
||||
if is_open_array(p^.left^.resulttype) or
|
||||
@ -634,9 +635,11 @@ implementation
|
||||
r,p^.location.register)));
|
||||
end
|
||||
end;
|
||||
{$endif OLDHIGH}
|
||||
in_sizeof_x,
|
||||
in_typeof_x :
|
||||
begin
|
||||
{$ifdef OLDHIGH}
|
||||
{ sizeof(openarray) handling }
|
||||
if (p^.inlinenumber=in_sizeof_x) and
|
||||
(is_open_array(p^.left^.resulttype) or
|
||||
@ -657,6 +660,7 @@ implementation
|
||||
parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
|
||||
end
|
||||
else
|
||||
{$endif OLDHIGH}
|
||||
begin
|
||||
{ for both cases load vmt }
|
||||
if p^.left^.treetype=typen then
|
||||
@ -1004,7 +1008,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.23 1999-01-06 12:23:29 florian
|
||||
Revision 1.24 1999-01-21 22:10:39 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.23 1999/01/06 12:23:29 florian
|
||||
* str(...) for ansi/long and widestrings fixed
|
||||
|
||||
Revision 1.22 1998/12/11 23:36:07 florian
|
||||
|
||||
@ -187,14 +187,17 @@ implementation
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{ in case call by reference, then calculate: }
|
||||
{ in case call by reference, then calculate. Open array
|
||||
is always an reference! }
|
||||
if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
|
||||
is_open_array(pvarsym(p^.symtableentry)^.definition) or
|
||||
((pvarsym(p^.symtableentry)^.varspez=vs_const) and
|
||||
push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
|
||||
begin
|
||||
simple_loadn:=false;
|
||||
if hregister=R_NO then
|
||||
hregister:=getregister32;
|
||||
{$ifdef OLDHIGH}
|
||||
if is_open_array(pvarsym(p^.symtableentry)^.definition) or
|
||||
is_open_string(pvarsym(p^.symtableentry)^.definition) then
|
||||
begin
|
||||
@ -211,6 +214,7 @@ implementation
|
||||
p^.location.reference.base,R_EDI)));
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
if p^.location.loc=LOC_CREGISTER then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
|
||||
@ -730,7 +734,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.41 1999-01-20 10:20:18 peter
|
||||
Revision 1.42 1999-01-21 22:10:40 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.41 1999/01/20 10:20:18 peter
|
||||
* don't make localvar copies for assembler procedures
|
||||
|
||||
Revision 1.40 1998/12/30 13:41:07 peter
|
||||
|
||||
@ -188,7 +188,7 @@ implementation
|
||||
hregister1,hregister2,hregister3,
|
||||
hregisterhigh,hregisterlow : tregister;
|
||||
pushed,popecx : boolean;
|
||||
op,op2 : tasmop;
|
||||
op : tasmop;
|
||||
hr : preference;
|
||||
|
||||
begin
|
||||
@ -755,7 +755,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.16 1999-01-19 10:51:32 pierre
|
||||
Revision 1.17 1999-01-21 22:10:41 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.16 1999/01/19 10:51:32 pierre
|
||||
* fix to bug0183 in secondnot
|
||||
|
||||
Revision 1.15 1998/12/11 16:50:22 florian
|
||||
|
||||
@ -132,6 +132,10 @@ unit hcodegen;
|
||||
{ true, if an error while code generation occurs }
|
||||
codegenerror : boolean;
|
||||
|
||||
{ save the size of pushed parameter, needed for aligning }
|
||||
pushedparasize : longint;
|
||||
|
||||
{$ifdef OLDHIGH}
|
||||
{ this is for open arrays and strings }
|
||||
{ but be careful, this data is in the }
|
||||
{ generated code destroyed quick, and also }
|
||||
@ -141,6 +145,7 @@ unit hcodegen;
|
||||
{ provided by this variables }
|
||||
highframepointer : tregister;
|
||||
highoffset : longint;
|
||||
{$endif}
|
||||
|
||||
{ message calls with codegenerror support }
|
||||
procedure cgmessage(const t : tmsgconst);
|
||||
@ -355,7 +360,11 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.24 1998-12-29 18:48:18 jonas
|
||||
Revision 1.25 1999-01-21 22:10:45 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.24 1998/12/29 18:48:18 jonas
|
||||
+ optimize pascal code surrounding assembler blocks
|
||||
|
||||
Revision 1.23 1998/11/27 14:50:38 peter
|
||||
|
||||
@ -971,27 +971,34 @@
|
||||
case varspez of
|
||||
vs_var :
|
||||
begin
|
||||
{$ifdef OLDHIGH}
|
||||
{ open arrays push also the high valye }
|
||||
if is_open_array(definition) or
|
||||
is_open_string(definition) then
|
||||
getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
|
||||
else
|
||||
{$endif}
|
||||
getpushsize:=target_os.size_of_pointer;
|
||||
end;
|
||||
vs_value,
|
||||
vs_const :
|
||||
begin
|
||||
case definition^.deftype of
|
||||
{$ifndef OLDHIGH}
|
||||
arraydef,
|
||||
{$endif OLDHIGH}
|
||||
setdef,
|
||||
stringdef,
|
||||
recorddef,
|
||||
objectdef :
|
||||
getpushsize:=target_os.size_of_pointer;
|
||||
{$ifdef OLDHIGH}
|
||||
arraydef :
|
||||
if is_open_array(definition) then
|
||||
getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
|
||||
else
|
||||
getpushsize:=target_os.size_of_pointer;
|
||||
{$endif OLDHIGH}
|
||||
else
|
||||
getpushsize:=definition^.size;
|
||||
end;
|
||||
@ -1757,7 +1764,11 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.69 1999-01-20 10:20:20 peter
|
||||
Revision 1.70 1999-01-21 22:10:48 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.69 1999/01/20 10:20:20 peter
|
||||
* don't make localvar copies for assembler procedures
|
||||
|
||||
Revision 1.68 1999/01/12 14:25:36 peter
|
||||
|
||||
@ -27,6 +27,10 @@ interface
|
||||
symtable,tree;
|
||||
|
||||
|
||||
{$ifndef OLDHIGH}
|
||||
procedure gen_high_tree(p:ptree;openstring:boolean);
|
||||
{$endif}
|
||||
|
||||
procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
|
||||
procedure firstcalln(var p : ptree);
|
||||
procedure firstprocinline(var p : ptree);
|
||||
@ -51,6 +55,69 @@ implementation
|
||||
FirstCallParaN
|
||||
*****************************************************************************}
|
||||
|
||||
{$ifndef OLDHIGH}
|
||||
procedure gen_high_tree(p:ptree;openstring:boolean);
|
||||
var
|
||||
len : longint;
|
||||
st : psymtable;
|
||||
begin
|
||||
if assigned(p^.hightree) then
|
||||
exit;
|
||||
len:=-1;
|
||||
case p^.left^.resulttype^.deftype of
|
||||
arraydef :
|
||||
begin
|
||||
if is_open_array(p^.left^.resulttype) then
|
||||
begin
|
||||
st:=p^.left^.symtable;
|
||||
getsymonlyin(st,'high'+pvarsym(p^.left^.symtableentry)^.name);
|
||||
p^.hightree:=genloadnode(pvarsym(srsym),st);
|
||||
end
|
||||
else
|
||||
len:=parraydef(p^.left^.resulttype)^.highrange-
|
||||
parraydef(p^.left^.resulttype)^.lowrange;
|
||||
end;
|
||||
stringdef :
|
||||
begin
|
||||
if openstring then
|
||||
begin
|
||||
if is_open_string(p^.left^.resulttype) then
|
||||
begin
|
||||
st:=p^.left^.symtable;
|
||||
getsymonlyin(st,'high'+pvarsym(p^.left^.symtableentry)^.name);
|
||||
p^.hightree:=genloadnode(pvarsym(srsym),st);
|
||||
end
|
||||
else
|
||||
len:=pstringdef(p^.left^.resulttype)^.len;
|
||||
end
|
||||
else
|
||||
{ passing a string to an array of char }
|
||||
begin
|
||||
if (p^.left^.treetype=stringconstn) then
|
||||
begin
|
||||
len:=str_length(p^.left);
|
||||
if len>0 then
|
||||
dec(len);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p^.hightree:=gennode(subn,geninlinenode(in_length_string,false,getcopy(p^.left)),
|
||||
genordinalconstnode(1,s32bitdef));
|
||||
firstpass(p^.hightree);
|
||||
p^.hightree:=gentypeconvnode(p^.hightree,s32bitdef);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
len:=0;
|
||||
end;
|
||||
if len>=0 then
|
||||
p^.hightree:=genordinalconstnode(len,s32bitdef);
|
||||
firstpass(p^.hightree);
|
||||
end;
|
||||
{$endif OLDHIGH}
|
||||
|
||||
|
||||
procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
|
||||
var
|
||||
old_array_constructor : boolean;
|
||||
@ -91,28 +158,24 @@ implementation
|
||||
else
|
||||
begin
|
||||
if count_ref then
|
||||
begin
|
||||
store_valid:=must_be_valid;
|
||||
if (defcoll^.paratyp=vs_var) then
|
||||
test_protected(p^.left);
|
||||
if (defcoll^.paratyp<>vs_var) then
|
||||
must_be_valid:=true
|
||||
else
|
||||
must_be_valid:=false;
|
||||
{ here we must add something for the implicit type }
|
||||
{ conversion from array of char to pchar }
|
||||
{ if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,
|
||||
p^.left^.treetype,false) then
|
||||
if convtyp=tc_array_to_pointer then
|
||||
must_be_valid:=false; }
|
||||
{ only process typeconvn, else it will break other trees }
|
||||
old_array_constructor:=allow_array_constructor;
|
||||
allow_array_constructor:=true;
|
||||
if (p^.left^.treetype=typeconvn) then
|
||||
firstpass(p^.left);
|
||||
allow_array_constructor:=old_array_constructor;
|
||||
must_be_valid:=store_valid;
|
||||
end;
|
||||
begin
|
||||
store_valid:=must_be_valid;
|
||||
if (defcoll^.paratyp=vs_var) then
|
||||
test_protected(p^.left);
|
||||
must_be_valid:=(defcoll^.paratyp<>vs_var);
|
||||
{ only process typeconvn, else it will break other trees }
|
||||
old_array_constructor:=allow_array_constructor;
|
||||
allow_array_constructor:=true;
|
||||
if (p^.left^.treetype=typeconvn) then
|
||||
firstpass(p^.left);
|
||||
allow_array_constructor:=old_array_constructor;
|
||||
must_be_valid:=store_valid;
|
||||
end;
|
||||
{ generate the high() value tree }
|
||||
if push_high_param(defcoll^.data) then
|
||||
{$ifndef OLDHIGH}
|
||||
gen_high_tree(p,is_open_string(defcoll^.data));
|
||||
{$endif}
|
||||
if not(is_shortstring(p^.left^.resulttype) and
|
||||
is_shortstring(defcoll^.data)) and
|
||||
(defcoll^.data^.deftype<>formaldef) then
|
||||
@ -162,10 +225,8 @@ implementation
|
||||
firstpass(p^.left);
|
||||
allow_array_constructor:=old_array_constructor;
|
||||
end;
|
||||
{ don't generate an type conversion for open arrays and
|
||||
openstring, else we loss the ranges }
|
||||
if is_open_array(defcoll^.data) or
|
||||
is_open_string(defcoll^.data) then
|
||||
{ process open parameters }
|
||||
if push_high_param(defcoll^.data) then
|
||||
begin
|
||||
{ insert type conv but hold the ranges of the array }
|
||||
oldtype:=p^.left^.resulttype;
|
||||
@ -197,6 +258,7 @@ implementation
|
||||
not(is_open_string(defcoll^.data)) and
|
||||
not(is_equal(p^.left^.resulttype,defcoll^.data)) then
|
||||
CGMessage(type_e_strict_var_string_violation);
|
||||
|
||||
{ Variablen for call by reference may not be copied }
|
||||
{ into a register }
|
||||
{ is this usefull here ? }
|
||||
@ -999,7 +1061,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 1999-01-21 16:41:06 pierre
|
||||
Revision 1.21 1999-01-21 22:10:49 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.20 1999/01/21 16:41:06 pierre
|
||||
* fix for constructor inside with statements
|
||||
|
||||
Revision 1.19 1999/01/19 14:20:16 peter
|
||||
|
||||
@ -287,10 +287,24 @@ implementation
|
||||
end;
|
||||
in_sizeof_x:
|
||||
begin
|
||||
if p^.registers32<1 then
|
||||
{$ifndef OLDHIGH}
|
||||
if push_high_param(p^.left^.resulttype) then
|
||||
begin
|
||||
getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
|
||||
hp:=gennode(addn,genloadnode(pvarsym(srsym),p^.left^.symtable),
|
||||
genordinalconstnode(1,s32bitdef));
|
||||
if (p^.left^.resulttype^.deftype=arraydef) and
|
||||
(parraydef(p^.left^.resulttype)^.elesize<>1) then
|
||||
hp:=gennode(muln,hp,genordinalconstnode(parraydef(p^.left^.resulttype)^.elesize,s32bitdef));
|
||||
disposetree(p);
|
||||
p:=hp;
|
||||
firstpass(p);
|
||||
end;
|
||||
{$endif OLDHIGH}
|
||||
if p^.registers32<1 then
|
||||
p^.registers32:=1;
|
||||
p^.resulttype:=s32bitdef;
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
p^.resulttype:=s32bitdef;
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
end;
|
||||
in_typeof_x:
|
||||
begin
|
||||
@ -530,7 +544,11 @@ implementation
|
||||
if assigned(hp^.right) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
stringdef : ;
|
||||
stringdef : begin
|
||||
{ generate the high() value for the string }
|
||||
if not dowrite then
|
||||
gen_high_tree(hp,true);
|
||||
end;
|
||||
pointerdef : begin
|
||||
if not is_equal(ppointerdef(hp^.left^.resulttype)^.definition,cchardef) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
@ -670,6 +688,9 @@ implementation
|
||||
(hp^.right=nil) or
|
||||
(hp^.left^.location.loc<>LOC_REFERENCE) then
|
||||
CGMessage(cg_e_illegal_expression);
|
||||
{ generate the high() value for the string }
|
||||
gen_high_tree(hp,true);
|
||||
|
||||
{ !!!! check length of string }
|
||||
|
||||
while assigned(hp^.right) do
|
||||
@ -806,9 +827,17 @@ implementation
|
||||
begin
|
||||
if is_open_array(p^.left^.resulttype) then
|
||||
begin
|
||||
{$ifndef OLDHIGH}
|
||||
getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
|
||||
hp:=genloadnode(pvarsym(srsym),p^.left^.symtable);
|
||||
disposetree(p);
|
||||
p:=hp;
|
||||
firstpass(p);
|
||||
{$else OLDHIGH}
|
||||
p^.resulttype:=s32bitdef;
|
||||
p^.registers32:=max(1,p^.registers32);
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
{$endif OLDHIGH}
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -832,9 +861,17 @@ implementation
|
||||
begin
|
||||
if is_open_string(p^.left^.resulttype) then
|
||||
begin
|
||||
{$ifndef OLDHIGH}
|
||||
getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
|
||||
hp:=genloadnode(pvarsym(srsym),p^.left^.symtable);
|
||||
disposetree(p);
|
||||
p:=hp;
|
||||
firstpass(p);
|
||||
{$else OLDHIGH}
|
||||
p^.resulttype:=s32bitdef;
|
||||
p^.registers32:=max(1,p^.registers32);
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
{$endif OLDHIGH}
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -893,7 +930,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1998-12-30 22:13:13 peter
|
||||
Revision 1.14 1999-01-21 22:10:50 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.13 1998/12/30 22:13:13 peter
|
||||
* check the amount of paras for Str()
|
||||
|
||||
Revision 1.12 1998/12/15 10:23:31 peter
|
||||
|
||||
@ -235,7 +235,7 @@ unit tree;
|
||||
{$endif extdebug}
|
||||
case treetype : ttreetyp of
|
||||
addn : (use_strconcat : boolean;string_typ : tstringtype);
|
||||
callparan : (is_colon_para : boolean;exact_match_found : boolean);
|
||||
callparan : (is_colon_para : boolean;exact_match_found : boolean;hightree:ptree);
|
||||
assignn : (assigntyp : tassigntyp;concat_string : boolean);
|
||||
loadn : (symtableentry : psym;symtable : psymtable;
|
||||
is_absolute,is_first,is_methodpointer : boolean);
|
||||
@ -1663,7 +1663,11 @@ unit tree;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.61 1999-01-21 16:41:09 pierre
|
||||
Revision 1.62 1999-01-21 22:10:52 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.61 1999/01/21 16:41:09 pierre
|
||||
* fix for constructor inside with statements
|
||||
|
||||
Revision 1.60 1998/12/15 11:52:19 peter
|
||||
|
||||
@ -91,6 +91,8 @@ unit types;
|
||||
{ true, if def is a 64 bit int type }
|
||||
function is_64bitint(def : pdef) : boolean;
|
||||
|
||||
function push_high_param(def : pdef) : boolean;
|
||||
|
||||
{ true if a parameter is too large to copy and only the address is pushed }
|
||||
function push_addr_param(def : pdef) : boolean;
|
||||
|
||||
@ -376,6 +378,13 @@ unit types;
|
||||
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
|
||||
end;
|
||||
|
||||
|
||||
function push_high_param(def : pdef) : boolean;
|
||||
begin
|
||||
push_high_param:=is_open_array(def) or is_open_string(def);
|
||||
end;
|
||||
|
||||
|
||||
{ true if a parameter is too large to copy and only the address is pushed }
|
||||
function push_addr_param(def : pdef) : boolean;
|
||||
begin
|
||||
@ -1047,7 +1056,11 @@ unit types;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.45 1999-01-20 12:34:22 peter
|
||||
Revision 1.46 1999-01-21 22:10:54 peter
|
||||
* fixed array of const
|
||||
* generic platform independent high() support
|
||||
|
||||
Revision 1.45 1999/01/20 12:34:22 peter
|
||||
* fixed typed file read/write
|
||||
|
||||
Revision 1.44 1999/01/15 11:33:03 pierre
|
||||
|
||||
Loading…
Reference in New Issue
Block a user