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

+ wordbool,longbool

Browse Source 
* rename bis,von -> high,low
  * moved some systemunit loading/creating to psystem.pas
This commit is contained in:
peter 1998-06-03 22:48:50 +00:00
parent 75f7938e27
commit d6268ae22f
14 changed files with 736 additions and 597 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
compiler/cg386cnv.pas
View File

@ -59,8 +59,8 @@ implementation
if (cs_rangechecking in aktswitches) and
{ with $R+ explicit type conversations in TP aren't range checked! }
(not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
((porddef(p1)^.von>porddef(p2)^.von) or
(porddef(p1)^.bis<porddef(p2)^.bis) or
((porddef(p1)^.low>porddef(p2)^.low) or
(porddef(p1)^.high<porddef(p2)^.high) or
(porddef(p1)^.typ=u32bit) or
(porddef(p2)^.typ=u32bit)) then
begin
@ -114,7 +114,7 @@ implementation
else internalerror(6);
hp:=new_reference(R_NO,0);
hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
if porddef(p1)^.von>porddef(p1)^.bis then
if porddef(p1)^.low>porddef(p1)^.high then
begin
getlabel(neglabel);
getlabel(poslabel);
@ -122,7 +122,7 @@ implementation
emitl(A_JL,neglabel);
end;
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
if porddef(p1)^.von>porddef(p1)^.bis then
if porddef(p1)^.low>porddef(p1)^.high then
begin
hp:=new_reference(R_NO,0);
hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr+1));
@ -186,8 +186,8 @@ implementation
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
end
else
if ((porddef(p^.resulttype)^.von>porddef(hp^.resulttype)^.von) or
(porddef(p^.resulttype)^.bis<porddef(hp^.resulttype)^.bis)) then
if ((porddef(p^.resulttype)^.low>porddef(hp^.resulttype)^.low) or
(porddef(p^.resulttype)^.high<porddef(hp^.resulttype)^.high)) then
begin
porddef(p^.resulttype)^.genrangecheck;
{ per default the var is copied to EDI }
@ -286,7 +286,7 @@ implementation
gives me movl (%eax),%eax
for the length(string !!!
use only for constant values }
{Constanst cannot be loaded into registers using MOVZX!}
{Constant cannot be loaded into registers using MOVZX!}
if (p^.left^.location.loc<>LOC_MEM) or (not p^.left^.location.reference.isintvalue) then
case convtyp of
tc_u8bit_2_s32bit,tc_u8bit_2_u32bit :
@ -756,57 +756,100 @@ implementation
var
oldtruelabel,oldfalselabel,hlabel : plabel;
hregister : tregister;
newsize,
opsize : topsize;
op : tasmop;
begin
oldtruelabel:=truelabel;
oldfalselabel:=falselabel;
secondpass(hp);
getlabel(truelabel);
getlabel(falselabel);
secondpass(hp);
p^.location.loc:=LOC_REGISTER;
del_reference(hp^.location.reference);
hregister:=reg32toreg8(getregister32);
case hp^.location.loc of
LOC_MEM,LOC_REFERENCE :
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
newreference(hp^.location.reference),hregister)));
LOC_REGISTER,LOC_CREGISTER :
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_B,
hp^.location.register,hregister)));
LOC_FLAGS:
exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
LOC_JUMP:
begin
getlabel(hlabel);
emitl(A_LABEL,truelabel);
exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,1,hregister)));
emitl(A_JMP,hlabel);
emitl(A_LABEL,falselabel);
exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,hregister,hregister)));
emitl(A_LABEL,hlabel);
end;
else
internalerror(10060);
hregister:=getregister32;
case porddef(hp^.resulttype)^.typ of
bool8bit : begin
case porddef(p^.resulttype)^.typ of
u8bit,s8bit,
bool8bit : opsize:=S_B;
u16bit,s16bit,
bool16bit : opsize:=S_BW;
u32bit,s32bit,
bool32bit : opsize:=S_BL;
end;
end;
bool16bit : begin
case porddef(p^.resulttype)^.typ of
u8bit,s8bit,
bool8bit : opsize:=S_B;
u16bit,s16bit,
bool16bit : opsize:=S_W;
u32bit,s32bit,
bool32bit : opsize:=S_WL;
end;
end;
bool32bit : begin
case porddef(p^.resulttype)^.typ of
u8bit,s8bit,
bool8bit : opsize:=S_B;
u16bit,s16bit,
bool16bit : opsize:=S_W;
u32bit,s32bit,
bool32bit : opsize:=S_L;
end;
end;
end;
if opsize in [S_B,S_W,S_L] then
op:=A_MOV
else
if (porddef(p^.resulttype)^.typ in [s8bit,s16bit,s32bit]) then
op:=A_MOVSX
else
op:=A_MOVZX;
case porddef(p^.resulttype)^.typ of
bool8bit,
u8bit,
s8bit : p^.location.register:=hregister;
s16bit : begin
p^.location.register:=reg8toreg16(hregister);
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BW,hregister,p^.location.register)));
end;
u16bit : begin
p^.location.register:=reg8toreg16(hregister);
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
end;
s32bit : begin
p^.location.register:=reg8toreg32(hregister);
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,hregister,p^.location.register)));
end;
u32bit : begin
p^.location.register:=reg8toreg32(hregister);
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
end;
bool8bit,u8bit,s8bit : begin
p^.location.register:=reg32toreg8(hregister);
newsize:=S_B;
end;
bool16bit,u16bit,s16bit : begin
p^.location.register:=reg32toreg16(hregister);
newsize:=S_W;
end;
bool32bit,u32bit,s32bit : begin
p^.location.register:=hregister;
newsize:=S_L;
end;
else
internalerror(10060);
end;
case hp^.location.loc of
LOC_MEM,
LOC_REFERENCE : exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
newreference(hp^.location.reference),p^.location.register)));
LOC_REGISTER,
LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
hp^.location.register,p^.location.register)));
LOC_FLAGS : begin
hregister:=reg32toreg8(hregister);
exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
case porddef(p^.resulttype)^.typ of
bool16bit,
u16bit,s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
bool32bit,
u32bit,s32bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
end;
end;
LOC_JUMP : begin
getlabel(hlabel);
emitl(A_LABEL,truelabel);
exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,newsize,1,hregister)));
emitl(A_JMP,hlabel);
emitl(A_LABEL,falselabel);
exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,newsize,hregister,hregister)));
emitl(A_LABEL,hlabel);
end;
else
internalerror(10060);
end;
@ -814,6 +857,7 @@ implementation
falselabel:=oldfalselabel;
end;
procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
var
hregister : tregister;
@ -835,13 +879,22 @@ implementation
internalerror(10061);
end;
exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
{ return only lower 8 bits }
p^.location.register:=reg32toreg8(hregister);
exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,p^.location.register)));
hregister:=reg32toreg8(hregister);
exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
case porddef(p^.resulttype)^.typ of
bool8bit : p^.location.register:=hregister;
bool16bit : begin
p^.location.register:=reg8toreg16(hregister);
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
end;
bool32bit : begin
p^.location.register:=reg16toreg32(hregister);
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
end;
end;
end;
procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
begin
end;
@ -897,7 +950,12 @@ implementation
end.
{
$Log$
Revision 1.2 1998-06-02 10:52:10 peter
Revision 1.3 1998-06-03 22:48:50 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.2 1998/06/02 10:52:10 peter
* fixed second_bool_to_int with bool8bit return
Revision 1.1 1998/06/01 16:50:18 peter

115
compiler/cgi386.pas
View File

@ -626,11 +626,16 @@ implementation
var
hl : plabel;
opsize : topsize;
begin
if (p^.resulttype^.deftype=orddef) and
(porddef(p^.resulttype)^.typ=bool8bit) then
(porddef(p^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]) then
begin
case porddef(p^.resulttype)^.typ of
bool8bit : opsize:=S_B;
bool16bit : opsize:=S_W;
bool32bit : opsize:=S_L;
end;
case p^.location.loc of
LOC_JUMP : begin
hl:=truelabel;
@ -649,30 +654,36 @@ implementation
LOC_REGISTER : begin
secondpass(p^.left);
p^.location.register:=p^.left^.location.register;
exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,S_B,1,p^.location.register)));
exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,opsize,1,p^.location.register)));
end;
LOC_CREGISTER : begin
secondpass(p^.left);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=reg32toreg8(getregister32);
emit_reg_reg(A_MOV,S_B,p^.left^.location.register,
p^.location.register);
exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,S_B,1,p^.location.register)));
case porddef(p^.resulttype)^.typ of
bool8bit : p^.location.register:=reg32toreg8(getregister32);
bool16bit : p^.location.register:=reg32toreg16(getregister32);
bool32bit : p^.location.register:=getregister32;
end;
emit_reg_reg(A_MOV,opsize,p^.left^.location.register,p^.location.register);
exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,opsize,1,p^.location.register)));
end;
LOC_REFERENCE,LOC_MEM : begin
secondpass(p^.left);
del_reference(p^.left^.location.reference);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=reg32toreg8(getregister32);
if p^.left^.location.loc=LOC_CREGISTER then
emit_reg_reg(A_MOV,S_B,p^.left^.location.register,
p^.location.register)
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
newreference(p^.left^.location.reference),
p^.location.register)));
exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,S_B,1,p^.location.register)));
end;
LOC_REFERENCE,
LOC_MEM : begin
secondpass(p^.left);
del_reference(p^.left^.location.reference);
p^.location.loc:=LOC_REGISTER;
case porddef(p^.resulttype)^.typ of
bool8bit : p^.location.register:=reg32toreg8(getregister32);
bool16bit : p^.location.register:=reg32toreg16(getregister32);
bool32bit : p^.location.register:=getregister32;
end;
if p^.left^.location.loc=LOC_CREGISTER then
emit_reg_reg(A_MOV,opsize,p^.left^.location.register,p^.location.register)
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
newreference(p^.left^.location.reference),p^.location.register)));
exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,opsize,1,p^.location.register)));
end;
end;
end
{$ifdef SUPPORT_MMX}
@ -1262,7 +1273,7 @@ implementation
orddef :
begin
case porddef(p^.resulttype)^.typ of
s32bit,u32bit :
s32bit,u32bit,bool32bit :
begin
inc(pushedparasize,4);
if inlined then
@ -1276,7 +1287,7 @@ implementation
else
emit_push_mem(tempreference);
end;
s8bit,u8bit,uchar,bool8bit,s16bit,u16bit :
s8bit,u8bit,uchar,bool8bit,bool16bit,s16bit,u16bit :
begin
inc(pushedparasize,2);
if inlined then
@ -2194,7 +2205,7 @@ implementation
begin
p^.location.loc:=LOC_REGISTER;
case porddef(p^.resulttype)^.typ of
s32bit,u32bit :
s32bit,u32bit,bool32bit :
begin
{$ifdef test_dest_loc}
if dest_loc_known and (dest_loc_tree=p) then
@ -2220,7 +2231,7 @@ implementation
p^.location.register:=reg32toreg8(hregister);
end;
end;
s16bit,u16bit :
s16bit,u16bit,bool16bit :
begin
{$ifdef test_dest_loc}
if dest_loc_known and (dest_loc_tree=p) then
@ -2621,7 +2632,9 @@ implementation
emitcall('READ_TEXT_CHAR',true)
else
emitcall('WRITE_TEXT_CHAR',true);
bool8bit : if doread then
bool8bit,
bool16bit,
bool32bit : if doread then
{ emitcall('READ_TEXT_BOOLEAN',true) }
Message(parser_e_illegal_parameter_list)
else
@ -4119,36 +4132,32 @@ implementation
if (procinfo.retdef^.deftype=orddef) then
begin
case porddef(procinfo.retdef)^.typ of
s32bit,u32bit : if is_mem then
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
s32bit,u32bit,bool32bit : if is_mem then
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(p^.left^.location.reference),R_EAX)))
else
emit_reg_reg(A_MOV,S_L,
p^.left^.location.register,R_EAX);
u8bit,s8bit,uchar,bool8bit : if is_mem then
emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
u8bit,s8bit,uchar,bool8bit : if is_mem then
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
newreference(p^.left^.location.reference),R_AL)))
else
emit_reg_reg(A_MOV,S_B,
p^.left^.location.register,R_AL);
s16bit,u16bit : if is_mem then
emit_reg_reg(A_MOV,S_B,p^.left^.location.register,R_AL);
s16bit,u16bit,bool16bit : if is_mem then
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
newreference(p^.left^.location.reference),R_AX)))
else
emit_reg_reg(A_MOV,S_W,
p^.left^.location.register,R_AX);
emit_reg_reg(A_MOV,S_W,p^.left^.location.register,R_AX);
end;
end
else
if (procinfo.retdef^.deftype in
[pointerdef,enumdef,procvardef]) then
if (procinfo.retdef^.deftype in [pointerdef,enumdef,procvardef]) then
begin
if is_mem then
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(p^.left^.location.reference),R_EAX)))
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(p^.left^.location.reference),R_EAX)))
else
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
p^.left^.location.register,R_EAX)));
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
p^.left^.location.register,R_EAX)));
end
else
if (procinfo.retdef^.deftype=floatdef) then
@ -4159,8 +4168,7 @@ implementation
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(p^.left^.location.reference),R_EAX)))
else
emit_reg_reg(A_MOV,S_L,
p^.left^.location.register,R_EAX);
emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
end
else
if is_mem then
@ -4980,21 +4988,13 @@ do_jmp:
{ possibly no 32 bit register are needed }
if (regvars[i]^.definition^.deftype=orddef) and
(
(porddef(regvars[i]^.definition)^.typ=bool8bit) or
(porddef(regvars[i]^.definition)^.typ=uchar) or
(porddef(regvars[i]^.definition)^.typ=u8bit) or
(porddef(regvars[i]^.definition)^.typ=s8bit)
) then
(porddef(regvars[i]^.definition)^.typ in [bool8bit,uchar,u8bit,s8bit]) then
begin
regvars[i]^.reg:=reg32toreg8(varregs[i]);
regsize:=S_B;
end
else if (regvars[i]^.definition^.deftype=orddef) and
(
(porddef(regvars[i]^.definition)^.typ=u16bit) or
(porddef(regvars[i]^.definition)^.typ=s16bit)
) then
(porddef(regvars[i]^.definition)^.typ in [bool16bit,u16bit,s16bit]) then
begin
regvars[i]^.reg:=reg32toreg16(varregs[i]);
regsize:=S_W;
@ -5059,7 +5059,12 @@ do_jmp:
end.
{
$Log$
Revision 1.30 1998-06-02 17:03:00 pierre
Revision 1.31 1998-06-03 22:48:52 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.30 1998/06/02 17:03:00 pierre
* with node corrected for objects
* small bugs for SUPPORT_MMX fixed

117
compiler/cgi386ad.inc
View File

@ -421,59 +421,70 @@
firstcomplex(p);
{ handling boolean expressions extra: }
if ((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=bool8bit)) or
(porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) or
((p^.right^.resulttype^.deftype=orddef) and
(porddef(p^.right^.resulttype)^.typ=bool8bit)) then
(porddef(p^.right^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) then
begin
if (p^.treetype=andn) or (p^.treetype=orn) then
begin
p^.location.loc:=LOC_JUMP;
cmpop:=false;
case p^.treetype of
andn : begin
otl:=truelabel;
getlabel(truelabel);
secondpass(p^.left);
maketojumpbool(p^.left);
emitl(A_LABEL,truelabel);
truelabel:=otl;
end;
orn : begin
ofl:=falselabel;
getlabel(falselabel);
secondpass(p^.left);
maketojumpbool(p^.left);
emitl(A_LABEL,falselabel);
falselabel:=ofl;
end;
else Message(sym_e_type_mismatch);
end;
secondpass(p^.right);
maketojumpbool(p^.right);
end
else if p^.treetype in [unequaln,equaln,xorn] then
begin
opsize:=S_B;
if p^.left^.treetype=ordconstn then
begin
swapp:=p^.right;
p^.right:=p^.left;
p^.left:=swapp;
p^.swaped:=not(p^.swaped);
if (porddef(p^.left^.resulttype)^.typ=bool8bit) or
(porddef(p^.right^.resulttype)^.typ=bool8bit) then
opsize:=S_B
else
if (porddef(p^.left^.resulttype)^.typ=bool16bit) or
(porddef(p^.right^.resulttype)^.typ=bool16bit) then
opsize:=S_W
else
opsize:=S_L;
case p^.treetype of
andn,
orn : begin
p^.location.loc:=LOC_JUMP;
cmpop:=false;
case p^.treetype of
andn : begin
otl:=truelabel;
getlabel(truelabel);
secondpass(p^.left);
maketojumpbool(p^.left);
emitl(A_LABEL,truelabel);
truelabel:=otl;
end;
orn : begin
ofl:=falselabel;
getlabel(falselabel);
secondpass(p^.left);
maketojumpbool(p^.left);
emitl(A_LABEL,falselabel);
falselabel:=ofl;
end;
else
Message(sym_e_type_mismatch);
end;
secondpass(p^.right);
maketojumpbool(p^.right);
end;
secondpass(p^.left);
p^.location:=p^.left^.location;
{ are enough registers free ? }
pushed:=maybe_push(p^.right^.registers32,p);
secondpass(p^.right);
if pushed then restore(p);
goto do_normal;
end
else Message(sym_e_type_mismatch);
unequaln,
equaln,xorn : begin
if p^.left^.treetype=ordconstn then
begin
swapp:=p^.right;
p^.right:=p^.left;
p^.left:=swapp;
p^.swaped:=not(p^.swaped);
end;
secondpass(p^.left);
p^.location:=p^.left^.location;
{ are enough registers free ? }
pushed:=maybe_push(p^.right^.registers32,p);
secondpass(p^.right);
if pushed then restore(p);
goto do_normal;
end
else
Message(sym_e_type_mismatch);
end
end
else
if (p^.left^.resulttype^.deftype=setdef) and
not(psetdef(p^.left^.resulttype)^.settype=smallset) then
else if (p^.left^.resulttype^.deftype=setdef) and
not(psetdef(p^.left^.resulttype)^.settype=smallset) then
begin
mboverflow:=false;
secondpass(p^.left);
@ -728,6 +739,7 @@
{ first give free, then demand new register }
case opsize of
S_L : hregister:=getregister32;
S_W : hregister:=reg32toreg16(getregister32);
S_B : hregister:=reg32toreg8(getregister32);
end;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
@ -1273,7 +1285,12 @@
{
$Log$
Revision 1.8 1998-05-11 13:07:53 peter
Revision 1.9 1998-06-03 22:48:53 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.8 1998/05/11 13:07:53 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments

72
compiler/parser.pas
View File

@ -49,41 +49,11 @@ unit parser;
,cga68k
{$endif m68k}
{ parser units }
,pbase,pmodules,pdecl,
,pbase,pmodules,pdecl,psystem,
{ assembling & linking }
assemble,
link;
{ dummy variable for search when calling exec }
var
file_found : boolean;
procedure readconstdefs;
begin
s32bitdef:=porddef(globaldef('longint'));
u32bitdef:=porddef(globaldef('ulong'));
cstringdef:=pstringdef(globaldef('string'));
clongstringdef:=pstringdef(globaldef('longstring'));
cansistringdef:=pstringdef(globaldef('ansistring'));
cwidestringdef:=pstringdef(globaldef('widestring'));
cchardef:=porddef(globaldef('char'));
{$ifdef i386}
c64floatdef:=pfloatdef(globaldef('s64real'));
{$endif}
{$ifdef m68k}
c64floatdef:=pfloatdef(globaldef('s32real'));
{$endif m68k}
s80floatdef:=pfloatdef(globaldef('s80real'));
s32fixeddef:=pfloatdef(globaldef('cs32fixed'));
voiddef:=porddef(globaldef('void'));
u8bitdef:=porddef(globaldef('byte'));
u16bitdef:=porddef(globaldef('word'));
booldef:=porddef(globaldef('boolean'));
voidpointerdef:=ppointerdef(globaldef('void_pointer'));
cfiledef:=pfiledef(globaldef('file'));
end;
procedure initparser;
begin
@ -91,7 +61,6 @@ unit parser;
{ ^M means a string or a char, because we don't parse a }
{ type declaration }
block_type:=bt_general;
ignore_equal:=false;
{ we didn't parse a object or class declaration }
@ -329,38 +298,10 @@ unit parser;
end
else
begin
{ create definitions for constants }
registerdef:=false;
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
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 ?? }
clongstringdef:=new(pstringdef,longinit(-1));
cansistringdef:=new(pstringdef,ansiinit(-1));
cwidestringdef:=new(pstringdef,wideinit(-1));
cchardef:=new(porddef,init(uchar,0,255));
{$ifdef i386}
c64floatdef:=new(pfloatdef,init(s64real));
s80floatdef:=new(pfloatdef,init(s80real));
{$endif}
{$ifdef m68k}
c64floatdef:=new(pfloatdef,init(s32real));
if (cs_fp_emulation in aktswitches) then
s80floatdef:=new(pfloatdef,init(s32real))
else
s80floatdef:=new(pfloatdef,init(s80real));
{$endif}
s32fixeddef:=new(pfloatdef,init(f32bit));
{ some other definitions }
voiddef:=new(porddef,init(uvoid,0,0));
u8bitdef:=new(porddef,init(u8bit,0,255));
u16bitdef:=new(porddef,init(u16bit,0,65535));
booldef:=new(porddef,init(bool8bit,0,1));
voidpointerdef:=new(ppointerdef,init(voiddef));
cfiledef:=new(pfiledef,init(ft_untyped,nil));
createconstdefs;
systemunit:=nil;
end;
registerdef:=true;
make_ref:=true;
@ -511,7 +452,12 @@ done:
end.
{
$Log$
Revision 1.19 1998-05-27 19:45:04 peter
Revision 1.20 1998-06-03 22:48:55 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.19 1998/05/27 19:45:04 peter
* symtable.pas splitted into includefiles
* symtable adapted for $ifdef NEWPPU

243
compiler/pass_1.pas
View File

@ -171,63 +171,73 @@ unit pass_1;
var doconv : tconverttype;fromtreetype : ttreetyp;
explicit : boolean) : boolean;
{ from_is_cstring muá true sein, wenn def_from die Definition einer }
{ Stringkonstanten ist, n”tig wegen der Konvertierung von String- }
{ konstante zu nullterminiertem String }
{ Hilfsliste: u8bit,s32bit,uvoid,
bool8bit,uchar,s8bit,s16bit,u16bit,u32bit }
{ Tbasetype: uauto,uvoid,uchar,
u8bit,u16bit,u32bit,
s8bit,s16bit,s32,
bool8bit,bool16bit,boot32bit }
const
basedefconverts : array[u8bit..u32bit,u8bit..u32bit] of tconverttype =
{u8bit}
((tc_only_rangechecks32bit,tc_u8bit_2_s32bit,tc_not_possible,
tc_int_2_bool,tc_not_possible,tc_only_rangechecks32bit,tc_u8bit_2_s16bit,
tc_u8bit_2_u16bit,{tc_not_possible}tc_u8bit_2_u32bit),
{s32bit}
(tc_s32bit_2_u8bit,tc_only_rangechecks32bit,tc_not_possible,
tc_int_2_bool,tc_not_possible,tc_s32bit_2_s8bit,
tc_s32bit_2_s16bit,tc_s32bit_2_u16bit,{tc_not_possible}tc_s32bit_2_u32bit),
basedefconverts : array[tbasetype,tbasetype] of tconverttype =
{uauto}
((tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible),
{uvoid}
(tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible),
{bool8bit}
{ (tc_not_possible,tc_not_possible,tc_not_possible,
tc_only_rangechecks32bit,tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible),}
(tc_bool_2_int,tc_bool_2_int,tc_not_possible,
tc_only_rangechecks32bit,tc_not_possible,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int),
{uchar}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_only_rangechecks32bit,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible),
{s8bit}
(tc_only_rangechecks32bit,tc_s8bit_2_s32bit,tc_not_possible,
tc_int_2_bool,tc_not_possible,tc_only_rangechecks32bit,tc_s8bit_2_s16bit,
tc_s8bit_2_u16bit,{tc_not_possible}tc_s8bit_2_u32bit),
{s16bit}
(tc_s16bit_2_u8bit,tc_s16bit_2_s32bit,tc_not_possible,
tc_int_2_bool,tc_not_possible,tc_s16bit_2_s8bit,tc_only_rangechecks32bit,
tc_only_rangechecks32bit,{tc_not_possible}tc_s8bit_2_u32bit),
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible),
{uchar}
(tc_not_possible,tc_not_possible,tc_only_rangechecks32bit,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible),
{u8bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_only_rangechecks32bit,tc_u8bit_2_u16bit,tc_u8bit_2_u32bit,
tc_only_rangechecks32bit,tc_u8bit_2_s16bit,tc_u8bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{u16bit}
(tc_u16bit_2_u8bit,tc_u16bit_2_s32bit,tc_not_possible,
tc_int_2_bool,tc_not_possible,tc_u16bit_2_s8bit,tc_only_rangechecks32bit,
tc_only_rangechecks32bit,{tc_not_possible}tc_u16bit_2_u32bit),
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_u16bit_2_u8bit,tc_only_rangechecks32bit,tc_u16bit_2_u32bit,
tc_u16bit_2_s8bit,tc_only_rangechecks32bit,tc_u16bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{u32bit}
(tc_u32bit_2_u8bit,{tc_not_possible}tc_u32bit_2_s32bit,tc_not_possible,
tc_int_2_bool,tc_not_possible,tc_u32bit_2_s8bit,tc_u32bit_2_s16bit,
tc_u32bit_2_u16bit,tc_only_rangechecks32bit)
);
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_u32bit_2_u8bit,tc_u32bit_2_u16bit,tc_only_rangechecks32bit,
tc_u32bit_2_s8bit,tc_u32bit_2_s16bit,tc_only_rangechecks32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{s8bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_only_rangechecks32bit,tc_s8bit_2_u16bit,tc_s8bit_2_u32bit,
tc_only_rangechecks32bit,tc_s8bit_2_s16bit,tc_s8bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{s16bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_s16bit_2_u8bit,tc_only_rangechecks32bit,tc_s16bit_2_u32bit,
tc_s16bit_2_s8bit,tc_only_rangechecks32bit,tc_s16bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{s32bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_s32bit_2_u8bit,tc_s32bit_2_u16bit,tc_only_rangechecks32bit,
tc_s32bit_2_s8bit,tc_s32bit_2_s16bit,tc_only_rangechecks32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{bool8bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_only_rangechecks32bit,tc_bool_2_int,tc_bool_2_int),
{bool16bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_only_rangechecks32bit,tc_bool_2_int),
{bool32bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_only_rangechecks32bit));
var
b : boolean;
@ -588,6 +598,25 @@ unit pass_1;
procedure firstadd(var p : ptree);
procedure make_bool_equal_size(var p:ptree);
begin
if porddef(p^.left^.resulttype)^.typ>porddef(p^.right^.resulttype)^.typ then
begin
p^.right:=gentypeconvnode(p^.right,porddef(p^.left^.resulttype));
p^.right^.convtyp:=tc_bool_2_int;
p^.right^.explizit:=true;
firstpass(p^.right);
end
else
if porddef(p^.left^.resulttype)^.typ<porddef(p^.right^.resulttype)^.typ then
begin
p^.left:=gentypeconvnode(p^.left,porddef(p^.right^.resulttype));
p^.left^.convtyp:=tc_bool_2_int;
p^.left^.explizit:=true;
firstpass(p^.left);
end;
end;
var
lt,rt : ttreetyp;
t : ptree;
@ -907,41 +936,28 @@ unit pass_1;
{ if both are boolean: }
if ((ld^.deftype=orddef) and
(porddef(ld)^.typ=bool8bit)) and
(porddef(ld)^.typ in [bool8bit,bool16bit,bool32bit])) and
((rd^.deftype=orddef) and
(porddef(rd)^.typ=bool8bit)) then
(porddef(rd)^.typ in [bool8bit,bool16bit,bool32bit])) then
begin
if (p^.treetype=andn) or (p^.treetype=orn) then
begin
calcregisters(p,0,0,0);
p^.location.loc:=LOC_JUMP;
end
else if p^.treetype in [unequaln,equaln,xorn] then
begin
{ I'am not very content with this solution, but it's
a working hack (FK) }
p^.left:=gentypeconvnode(p^.left,u8bitdef);
p^.right:=gentypeconvnode(p^.right,u8bitdef);
p^.left^.convtyp:=tc_bool_2_int;
p^.left^.explizit:=true;
firstpass(p^.left);
p^.left^.resulttype:=booldef;
p^.right^.convtyp:=tc_bool_2_int;
p^.right^.explizit:=true;
firstpass(p^.right);
p^.right^.resulttype:=booldef;
calcregisters(p,1,0,0);
{ is done commonly for all data types
p^.location.loc:=LOC_FLAGS;
p^.resulttype:=booldef;
}
end
else Message(sym_e_type_mismatch);
case p^.treetype of
andn,orn : begin
calcregisters(p,0,0,0);
p^.location.loc:=LOC_JUMP;
end;
unequaln,
equaln,xorn : begin
make_bool_equal_size(p);
calcregisters(p,1,0,0);
end
else
Message(sym_e_type_mismatch);
end;
end
{ wenn beides vom Char dann keine Konvertiereung einf<6E>gen }
{ h”chstens es handelt sich um einen +-Operator }
else if ((rd^.deftype=orddef) and (porddef(rd)^.typ=uchar)) and
((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar)) then
((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar)) then
begin
if p^.treetype=addn then
begin
@ -1929,7 +1945,7 @@ unit pass_1;
{ maybe type conversion }
if (p^.right^.resulttype^.deftype<>enumdef) and
not ((p^.right^.resulttype^.deftype=orddef) and
(Porddef(p^.right^.resulttype)^.typ in [bool8bit,uchar])) then
(Porddef(p^.right^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit,uchar])) then
begin
p^.right:=gentypeconvnode(p^.right,s32bitdef);
{ once more firstpass }
@ -2187,19 +2203,31 @@ unit pass_1;
procedure first_bool_int(var p : ptree);
begin
p^.location.loc:=LOC_REGISTER;
{ Florian I think this is overestimated
but I still do not really understand how to get this right (PM) }
{ Hmmm, I think we need only one reg to return the result of }
{ this node => so }
if p^.registers32<1 then
p^.registers32:=1;
{ should work (FK)
p^.registers32:=p^.left^.registers32+1;}
end;
procedure first_int_bool(var p : ptree);
begin
p^.location.loc:=LOC_REGISTER;
{ Florian I think this is overestimated
but I still do not really understand how to get this right (PM) }
{ Hmmm, I think we need only one reg to return the result of }
{ this node => so }
p^.left:=gentypeconvnode(p^.left,s32bitdef);
firstpass(p^.left);
if p^.registers32<1 then
p^.registers32:=1;
p^.resulttype:=booldef;
{ p^.resulttype:=booldef; }
{ should work (FK)
p^.registers32:=p^.left^.registers32+1;}
end;
procedure first_proc_to_procvar(var p : ptree);
@ -2708,8 +2736,8 @@ unit pass_1;
begin
is_in_limit:=(def_from^.deftype = orddef) and
(def_to^.deftype = orddef) and
(porddef(def_from)^.von>porddef(def_to)^.von) and
(porddef(def_from)^.bis<porddef(def_to)^.bis);
(porddef(def_from)^.low>porddef(def_to)^.low) and
(porddef(def_from)^.high<porddef(def_to)^.high);
end;
@ -3038,8 +3066,8 @@ unit pass_1;
begin
def_to:=hp^.next^.nextpara^.data;
if (conv_to^.size>def_to^.size) or
((porddef(conv_to)^.von<porddef(def_to)^.von) and
(porddef(conv_to)^.bis>porddef(def_to)^.bis)) then
((porddef(conv_to)^.low<porddef(def_to)^.low) and
(porddef(conv_to)^.high>porddef(def_to)^.high)) then
begin
hp2:=procs;
procs:=hp;
@ -3370,9 +3398,9 @@ unit pass_1;
orddef:
begin
if p^.inlinenumber=in_low_x then
v:=porddef(Adef)^.von
v:=porddef(Adef)^.low
else
v:=porddef(Adef)^.bis;
v:=porddef(Adef)^.high;
hp:=genordinalconstnode(v,adef);
firstpass(hp);
disposetree(p);
@ -4921,42 +4949,15 @@ unit pass_1;
end.
{
$Log$
Revision 1.24 1998-06-02 17:03:01 pierre
Revision 1.25 1998-06-03 22:48:57 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.24 1998/06/02 17:03:01 pierre
* with node corrected for objects
* small bugs for SUPPORT_MMX fixed
<<<<<<< PASS_1.pas
Revision 1.22 1998/05/28 17:26:49 peter
* fixed -R switch, it didn't work after my previous akt/init patch
* fixed bugs 110,130,136
Revision 1.21 1998/05/25 17:11:41 pierre
* firstpasscount bug fixed
now all is already set correctly the first time
under EXTDEBUG try -gp to skip all other firstpasses
it works !!
* small bug fixes
- for smallsets with -dTESTSMALLSET
- some warnings removed (by correcting code !)
Revision 1.20 1998/05/23 01:21:17 peter
+ aktasmmode, aktoptprocessor, aktoutputformat
+ smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+ $LIBNAME to set the library name where the unit will be put in
* splitted cgi386 a bit (codeseg to large for bp7)
* nasm, tasm works again. nasm moved to ag386nsm.pas
Revision 1.19 1998/05/20 09:42:34 pierre
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now
* only one error for unknown symbol (uses lastsymknown boolean)
the problem came from the label code !
+ first inlined procedures and function work
(warning there might be allowed cases were the result is still wrong !!)
* UseBrower updated gives a global list of all position of all used symbols
with switch -gb
=======
Revision 1.23 1998/06/01 16:50:20 peter
+ boolean -> ord conversion
* fixed ord -> boolean conversion

12
compiler/pbase.pas
View File

@ -39,8 +39,6 @@ unit pbase;
getprocvar : boolean = false;
getprocvardef : pprocvardef = nil;
type
tblock_type = (bt_general,bt_type,bt_const);
var
{ contains the current token to be processes }
@ -62,9 +60,6 @@ unit pbase;
{ true, if we are in a except block }
in_except_block : boolean;
{ type of currently parsed block }
{ isn't full implemented (FK) }
block_type : tblock_type;
{ true, if we should ignore an equal in const x : 1..2=2 }
ignore_equal : boolean;
@ -223,7 +218,12 @@ end.
{
$Log$
Revision 1.8 1998-05-23 01:21:18 peter
Revision 1.9 1998-06-03 22:48:58 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.8 1998/05/23 01:21:18 peter
+ aktasmmode, aktoptprocessor, aktoutputformat
+ smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+ $LIBNAME to set the library name where the unit will be put in

19
compiler/pdecl.pas
View File

@ -1242,14 +1242,14 @@ unit pdecl;
begin
if p=nil then
begin
ap:=new(parraydef,init(porddef(pt^.resulttype)^.von,
porddef(pt^.resulttype)^.bis,pt^.resulttype));
ap:=new(parraydef,init(porddef(pt^.resulttype)^.low,
porddef(pt^.resulttype)^.high,pt^.resulttype));
p:=ap;
end
else
begin
ap^.definition:=new(parraydef,init(porddef(pt^.resulttype)^.von,
porddef(pt^.resulttype)^.bis,pt^.resulttype));
ap^.definition:=new(parraydef,init(porddef(pt^.resulttype)^.low,
porddef(pt^.resulttype)^.high,pt^.resulttype));
ap:=parraydef(ap^.definition);
end;
end;
@ -1370,8 +1370,8 @@ unit pdecl;
uchar : p:=new(psetdef,init(hp1,255));
u8bit,s8bit,u16bit,s16bit,s32bit :
begin
if (porddef(hp1)^.von>=0) then
p:=new(psetdef,init(hp1,porddef(hp1)^.bis))
if (porddef(hp1)^.low>=0) then
p:=new(psetdef,init(hp1,porddef(hp1)^.high))
else Message(sym_e_ill_type_decl_set);
end;
else Message(sym_e_ill_type_decl_set);
@ -1797,7 +1797,12 @@ unit pdecl;
end.
{
$Log$
Revision 1.21 1998-06-03 22:14:19 florian
Revision 1.22 1998-06-03 22:48:59 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.21 1998/06/03 22:14:19 florian
* problem with sizes of classes fixed (if the anchestor was declared
forward, the compiler doesn't update the child classes size)

128
compiler/pmodules.pas
View File

@ -35,7 +35,7 @@ unit pmodules;
,ppu
{$endif}
{ parser specific stuff }
,pbase,pdecl,pstatmnt,psub
,pbase,pdecl,pstatmnt,psub,psystem
{ processor specific stuff }
{$ifdef i386}
,i386
@ -62,8 +62,6 @@ unit pmodules;
uses
parser;
{$I innr.inc}
procedure addlinkerfiles(hp:pmodule);
begin
with hp^ do
@ -149,123 +147,6 @@ unit pmodules;
end;
{ all intern procedures for system unit }
procedure insertinternsyms(p : psymtable);
begin
p^.insert(new(psyssym,init('CONCAT',in_concat_x)));
p^.insert(new(psyssym,init('WRITE',in_write_x)));
p^.insert(new(psyssym,init('WRITELN',in_writeln_x)));
p^.insert(new(psyssym,init('ASSIGNED',in_assigned_x)));
p^.insert(new(psyssym,init('READ',in_read_x)));
p^.insert(new(psyssym,init('READLN',in_readln_x)));
p^.insert(new(psyssym,init('OFS',in_ofs_x)));
p^.insert(new(psyssym,init('SIZEOF',in_sizeof_x)));
p^.insert(new(psyssym,init('TYPEOF',in_typeof_x)));
p^.insert(new(psyssym,init('LOW',in_low_x)));
p^.insert(new(psyssym,init('HIGH',in_high_x)));
p^.insert(new(psyssym,init('SEG',in_seg_x)));
p^.insert(new(psyssym,init('ORD',in_ord_x)));
p^.insert(new(psyssym,init('PRED',in_pred_x)));
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)));
p^.insert(new(psyssym,init('INCI',in_inc_x)));
p^.insert(new(psyssym,init('STR',in_str_x_string)));
end;
{ all the types inserted into the system unit }
procedure insert_intern_types(p : psymtable);
{$ifdef GDB}
var
{ several defs to simulate more or less C++ objects for GDB }
vmtdef : precdef;
pvmtdef : ppointerdef;
vmtarraydef : parraydef;
vmtsymtable : psymtable;
{$endif GDB}
begin
p^.insert(new(ptypesym,init('longint',s32bitdef)));
p^.insert(new(ptypesym,init('ulong',u32bitdef)));
p^.insert(new(ptypesym,init('void',voiddef)));
p^.insert(new(ptypesym,init('char',cchardef)));
{$ifdef i386}
p^.insert(new(ptypesym,init('s64real',c64floatdef)));
{$endif i386}
p^.insert(new(ptypesym,init('s80real',s80floatdef)));
p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
p^.insert(new(ptypesym,init('byte',u8bitdef)));
p^.insert(new(ptypesym,init('string',cstringdef)));
p^.insert(new(ptypesym,init('longstring',clongstringdef)));
p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
p^.insert(new(ptypesym,init('word',u16bitdef)));
p^.insert(new(ptypesym,init('boolean',booldef)));
p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
p^.insert(new(ptypesym,init('file',cfiledef)));
{$ifdef i386}
p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s64real)))));
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bit)))));
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
{$endif}
{$ifdef m68k}
{ internal definitions }
p^.insert(new(ptypesym,init('s32real',c64floatdef)));
{ mappings... }
p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s32real)))));
if (cs_fp_emulation) in aktswitches then
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real)))))
else
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s64real)))));
{ p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s32real)))));}
if (cs_fp_emulation) in aktswitches then
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s32real)))))
else
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
{$endif}
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)));
p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
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)))));
p^.insert(new(ptypesym,init('CARDINAL',new(porddef,init(u32bit,0,$ffffffff)))));
p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
{ !!!!!
p^.insert(new(ptypesym,init('COMP',new(porddef,init(s64bit,0,0)))));
p^.insert(new(ptypesym,init('SINGLE',new(porddef,init(s32real,0,0)))));
p^.insert(new(ptypesym,init('EXTENDED',new(porddef,init(s80real,0,0)))));
p^.insert(new(ptypesym,init('FILE',new(pfiledef,init(ft_untyped,nil)))));
}
{ Add a type for virtual method tables in lowercase }
{ so it isn't reachable! }
{$ifdef GDB}
vmtsymtable:=new(psymtable,init(recordsymtable));
vmtdef:=new(precdef,init(vmtsymtable));
pvmtdef:=new(ppointerdef,init(vmtdef));
vmtsymtable^.insert(new(pvarsym,init('parent',pvmtdef)));
vmtsymtable^.insert(new(pvarsym,init('length',globaldef('longint'))));
vmtsymtable^.insert(new(pvarsym,init('mlength',globaldef('longint'))));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := voidpointerdef;
vmtsymtable^.insert(new(pvarsym,init('__pfn',vmtarraydef)));
p^.insert(new(ptypesym,init('__vtbl_ptr_type',vmtdef)));
p^.insert(new(ptypesym,init('pvmt',pvmtdef)));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := pvmtdef;
p^.insert(new(ptypesym,init('vtblarray',vmtarraydef)));
{$endif GDB}
insertinternsyms(p);
end;
procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
var
@ -1120,7 +1001,12 @@ unit pmodules;
end.
{
$Log$
Revision 1.17 1998-05-28 14:40:25 peter
Revision 1.18 1998-06-03 22:49:00 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.17 1998/05/28 14:40:25 peter
* fixes for newppu, remake3 works now with it
Revision 1.16 1998/05/27 19:45:06 peter

236
compiler/psystem.pas Normal file
View File

@ -0,0 +1,236 @@
{
$Id$
Copyright (c) 1993-98 by Florian Klaempfl
Load the system unit, create required defs for systemunit
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit psystem;
interface
uses symtable;
procedure insertinternsyms(p : psymtable);
procedure insert_intern_types(p : psymtable);
procedure readconstdefs;
procedure createconstdefs;
implementation
uses tree;
procedure insertinternsyms(p : psymtable);
{
all intern procedures for system unit
}
begin
p^.insert(new(psyssym,init('CONCAT',in_concat_x)));
p^.insert(new(psyssym,init('WRITE',in_write_x)));
p^.insert(new(psyssym,init('WRITELN',in_writeln_x)));
p^.insert(new(psyssym,init('ASSIGNED',in_assigned_x)));
p^.insert(new(psyssym,init('READ',in_read_x)));
p^.insert(new(psyssym,init('READLN',in_readln_x)));
p^.insert(new(psyssym,init('OFS',in_ofs_x)));
p^.insert(new(psyssym,init('SIZEOF',in_sizeof_x)));
p^.insert(new(psyssym,init('TYPEOF',in_typeof_x)));
p^.insert(new(psyssym,init('LOW',in_low_x)));
p^.insert(new(psyssym,init('HIGH',in_high_x)));
p^.insert(new(psyssym,init('SEG',in_seg_x)));
p^.insert(new(psyssym,init('ORD',in_ord_x)));
p^.insert(new(psyssym,init('PRED',in_pred_x)));
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)));
p^.insert(new(psyssym,init('INCI',in_inc_x)));
p^.insert(new(psyssym,init('STR',in_str_x_string)));
end;
procedure insert_intern_types(p : psymtable);
{
all the types inserted into the system unit
}
{$ifdef GDB}
var
{ several defs to simulate more or less C++ objects for GDB }
vmtdef : precdef;
pvmtdef : ppointerdef;
vmtarraydef : parraydef;
vmtsymtable : psymtable;
{$endif GDB}
begin
p^.insert(new(ptypesym,init('longint',s32bitdef)));
p^.insert(new(ptypesym,init('ulong',u32bitdef)));
p^.insert(new(ptypesym,init('void',voiddef)));
p^.insert(new(ptypesym,init('char',cchardef)));
{$ifdef i386}
p^.insert(new(ptypesym,init('s64real',c64floatdef)));
{$endif i386}
p^.insert(new(ptypesym,init('s80real',s80floatdef)));
p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
p^.insert(new(ptypesym,init('byte',u8bitdef)));
p^.insert(new(ptypesym,init('string',cstringdef)));
p^.insert(new(ptypesym,init('longstring',clongstringdef)));
p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
p^.insert(new(ptypesym,init('word',u16bitdef)));
p^.insert(new(ptypesym,init('boolean',booldef)));
p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
p^.insert(new(ptypesym,init('file',cfiledef)));
{$ifdef i386}
p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s64real)))));
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bit)))));
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
{$endif}
{$ifdef m68k}
{ internal definitions }
p^.insert(new(ptypesym,init('s32real',c64floatdef)));
{ mappings... }
p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s32real)))));
if (cs_fp_emulation) in aktswitches then
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real)))))
else
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s64real)))));
if (cs_fp_emulation) in aktswitches then
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s32real)))))
else
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
{ p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s32real)))));}
{$endif}
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)));
p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
p^.insert(new(ptypesym,init('BYTEBOOL',new(porddef,init(bool8bit,0,1)))));
p^.insert(new(ptypesym,init('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
p^.insert(new(ptypesym,init('LONGBOOL',new(porddef,init(bool32bit,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)))));
p^.insert(new(ptypesym,init('CARDINAL',new(porddef,init(u32bit,0,$ffffffff)))));
p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
{ !!!!!
p^.insert(new(ptypesym,init('COMP',new(porddef,init(s64bit,0,0)))));
p^.insert(new(ptypesym,init('SINGLE',new(porddef,init(s32real,0,0)))));
p^.insert(new(ptypesym,init('EXTENDED',new(porddef,init(s80real,0,0)))));
p^.insert(new(ptypesym,init('FILE',new(pfiledef,init(ft_untyped,nil)))));
}
{ Add a type for virtual method tables in lowercase }
{ so it isn't reachable! }
{$ifdef GDB}
vmtsymtable:=new(psymtable,init(recordsymtable));
vmtdef:=new(precdef,init(vmtsymtable));
pvmtdef:=new(ppointerdef,init(vmtdef));
vmtsymtable^.insert(new(pvarsym,init('parent',pvmtdef)));
vmtsymtable^.insert(new(pvarsym,init('length',globaldef('longint'))));
vmtsymtable^.insert(new(pvarsym,init('mlength',globaldef('longint'))));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := voidpointerdef;
vmtsymtable^.insert(new(pvarsym,init('__pfn',vmtarraydef)));
p^.insert(new(ptypesym,init('__vtbl_ptr_type',vmtdef)));
p^.insert(new(ptypesym,init('pvmt',pvmtdef)));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := pvmtdef;
p^.insert(new(ptypesym,init('vtblarray',vmtarraydef)));
{$endif GDB}
insertinternsyms(p);
end;
procedure readconstdefs;
{
Load all default definitions for consts from the system unit
}
begin
s32bitdef:=porddef(globaldef('longint'));
u32bitdef:=porddef(globaldef('ulong'));
cstringdef:=pstringdef(globaldef('string'));
clongstringdef:=pstringdef(globaldef('longstring'));
cansistringdef:=pstringdef(globaldef('ansistring'));
cwidestringdef:=pstringdef(globaldef('widestring'));
cchardef:=porddef(globaldef('char'));
{$ifdef i386}
c64floatdef:=pfloatdef(globaldef('s64real'));
{$endif}
{$ifdef m68k}
c64floatdef:=pfloatdef(globaldef('s32real'));
{$endif m68k}
s80floatdef:=pfloatdef(globaldef('s80real'));
s32fixeddef:=pfloatdef(globaldef('cs32fixed'));
voiddef:=porddef(globaldef('void'));
u8bitdef:=porddef(globaldef('byte'));
u16bitdef:=porddef(globaldef('word'));
booldef:=porddef(globaldef('boolean'));
voidpointerdef:=ppointerdef(globaldef('void_pointer'));
cfiledef:=pfiledef(globaldef('file'));
end;
procedure createconstdefs;
{
Create all default definitions for consts for the system unit
}
begin
{ create definitions for constants }
registerdef:=false;
voiddef:=new(porddef,init(uvoid,0,0));
u8bitdef:=new(porddef,init(u8bit,0,255));
u16bitdef:=new(porddef,init(u16bit,0,65535));
u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
booldef:=new(porddef,init(bool8bit,0,1));
cchardef:=new(porddef,init(uchar,0,255));
cstringdef:=new(pstringdef,init(255));
{ should we give a length to the default long and ansi string definition ?? }
clongstringdef:=new(pstringdef,longinit(-1));
cansistringdef:=new(pstringdef,ansiinit(-1));
cwidestringdef:=new(pstringdef,wideinit(-1));
{$ifdef i386}
c64floatdef:=new(pfloatdef,init(s64real));
s80floatdef:=new(pfloatdef,init(s80real));
{$endif}
{$ifdef m68k}
c64floatdef:=new(pfloatdef,init(s32real));
if (cs_fp_emulation in aktswitches) then
s80floatdef:=new(pfloatdef,init(s32real))
else
s80floatdef:=new(pfloatdef,init(s80real));
{$endif}
s32fixeddef:=new(pfloatdef,init(f32bit));
{ some other definitions }
voidpointerdef:=new(ppointerdef,init(voiddef));
cfiledef:=new(pfiledef,init(ft_untyped,nil));
end;
end.
{
$Log$
Revision 1.1 1998-06-03 22:49:01 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
}

11
compiler/ptconst.pas
View File

@ -68,8 +68,8 @@ unit ptconst;
procedure check_range;
begin
if ((p^.value>porddef(def)^.bis) or
(p^.value<porddef(def)^.von)) then
if ((p^.value>porddef(def)^.high) or
(p^.value<porddef(def)^.low)) then
Message(parser_e_range_check_error);
end;
@ -450,7 +450,12 @@ unit ptconst;
end.
{
$Log$
Revision 1.4 1998-05-05 12:05:42 florian
Revision 1.5 1998-06-03 22:49:01 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.4 1998/05/05 12:05:42 florian
* problems with properties fixed
* crash fixed: i:=l when i and l are undefined, was a problem with
implementation of private/protected

14
compiler/scanner.pas
View File

@ -159,9 +159,6 @@ unit scanner;
lastasmgetchar : char;
preprocstack : ppreprocstack;
var tokenpos : tfileposinfo;
{public}
procedure syntaxerror(const s : string);
function yylex : ttoken;
@ -179,9 +176,7 @@ unit scanner;
implementation
uses
dos,verbose,systems,
pbase,symtable,
switches;
dos,verbose,systems,symtable,switches;
{*****************************************************************************
TPreProcStack
@ -1174,6 +1169,7 @@ exit_label:
lasttokenpos:=inputpointer;
lastlinepos:=inputpointer;
s_point:=false;
block_type:=bt_general;
end;
procedure get_cur_file_pos(var fileinfo : tfileposinfo);
@ -1260,8 +1256,10 @@ exit_label:
end.
{
$Log$
Revision 1.22 1998-05-31 14:10:54 peter
* better get_current_col
Revision 1.23 1998-06-03 22:49:02 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.21 1998/05/27 00:20:32 peter
* some scanner optimizes

68
compiler/symdef.inc
View File

@ -534,8 +534,8 @@
begin
tdef.init;
deftype:=orddef;
von:=v;
bis:=b;
low:=v;
high:=b;
typ:=t;
setsize;
end;
@ -545,8 +545,8 @@
tdef.load;
deftype:=orddef;
typ:=tbasetype(readbyte);
von:=readlong;
bis:=readlong;
low:=readlong;
high:=readlong;
rangenr:=0;
setsize;
end;
@ -555,28 +555,28 @@
begin
if typ=uauto then
begin
{ generate a unsigned range if bis<0 and von>=0 }
if (von>=0) and (bis<0) then
{ generate a unsigned range if high<0 and low>=0 }
if (low>=0) and (high<0) then
begin
savesize:=4;
typ:=u32bit;
end
else if (von>=0) and (bis<=255) then
else if (low>=0) and (high<=255) then
begin
savesize:=1;
typ:=u8bit;
end
else if (von>=-128) and (bis<=127) then
else if (low>=-128) and (high<=127) then
begin
savesize:=1;
typ:=s8bit;
end
else if (von>=0) and (bis<=65536) then
else if (low>=0) and (high<=65536) then
begin
savesize:=2;
typ:=u16bit;
end
else if (von>=-32768) and (bis<=32767) then
else if (low>=-32768) and (high<=32767) then
begin
savesize:=2;
typ:=s16bit;
@ -588,14 +588,19 @@
end;
end
else
case typ of
uchar,u8bit,bool8bit,s8bit : savesize:=1;
u16bit,s16bit : savesize:=2;
s32bit,u32bit : savesize:=4;
else savesize:=0;
begin
case typ of
u8bit,s8bit,
uchar,bool8bit : savesize:=1;
u16bit,s16bit,
bool16bit : savesize:=2;
s32bit,u32bit,
bool32bit : savesize:=4;
else
savesize:=0;
end;
end;
{ there are no entrys for range checking }
{ there are no entrys for range checking }
rangenr:=0;
end;
@ -609,15 +614,15 @@
datasegment^.concat(new(pai_symbol,init_global('R_'+current_module^.mainsource^+tostr(rangenr))))
else
datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr))));
if von<=bis then
if low<=high then
begin
datasegment^.concat(new(pai_const,init_32bit(von)));
datasegment^.concat(new(pai_const,init_32bit(bis)));
datasegment^.concat(new(pai_const,init_32bit(low)));
datasegment^.concat(new(pai_const,init_32bit(high)));
end
{ for u32bit we need two bounds }
else
begin
datasegment^.concat(new(pai_const,init_32bit(von)));
datasegment^.concat(new(pai_const,init_32bit(low)));
datasegment^.concat(new(pai_const,init_32bit($7fffffff)));
inc(nextlabelnr);
if (cs_smartlink in aktswitches) then
@ -625,7 +630,7 @@
else
datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr+1))));
datasegment^.concat(new(pai_const,init_32bit($80000000)));
datasegment^.concat(new(pai_const,init_32bit(bis)));
datasegment^.concat(new(pai_const,init_32bit(high)));
end;
end;
end;
@ -637,8 +642,8 @@
{$endif}
tdef.write;
writebyte(byte(typ));
writelong(von);
writelong(bis);
writelong(low);
writelong(high);
{$ifdef NEWPPU}
ppufile^.writeentry(iborddef);
{$endif}
@ -648,13 +653,15 @@
function torddef.stabstring : pchar;
begin
case typ of
uvoid : stabstring := strpnew(numberstring+';');
uvoid : stabstring := strpnew(numberstring+';');
{GDB 4.12 for go32 doesn't like boolean as range for 0 to 1 !!!}
bool8bit : stabstring := strpnew('r'+numberstring+';0;255;');
bool8bit,
bool16bit,
bool32bit : stabstring := strpnew('r'+numberstring+';0;255;');
{ u32bit : stabstring := strpnew('r'+
s32bitdef^.numberstring+';0;-1;'); }
else
stabstring := strpnew('r'+s32bitdef^.numberstring+';'+tostr(von)+';'+tostr(bis)+';');
stabstring := strpnew('r'+s32bitdef^.numberstring+';'+tostr(low)+';'+tostr(high)+';');
end;
end;
{$endif GDB}
@ -2368,7 +2375,12 @@
{
$Log$
Revision 1.2 1998-05-31 14:13:37 peter
Revision 1.3 1998-06-03 22:49:03 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.2 1998/05/31 14:13:37 peter
* fixed call bugs with assembler readers
+ OPR_SYMBOL to hold a symbol in the asm parser
* fixed staticsymtable vars which were acessed through %ebp instead of

9
compiler/tree.pas
View File

@ -294,7 +294,7 @@ unit tree;
implementation
uses
scanner,verbose,files,types,pbase;
verbose,files;
{****************************************************************************
this is a pool for the tree nodes to get more performance
@ -1534,9 +1534,10 @@ unit tree;
end.
{
$Log$
Revision 1.11 1998-06-01 16:50:23 peter
+ boolean -> ord conversion
* fixed ord -> boolean conversion
Revision 1.12 1998-06-03 22:49:06 peter
+ wordbool,longbool
* rename bis,von -> high,low
* moved some systemunit loading/creating to psystem.pas
Revision 1.10 1998/05/20 09:42:38 pierre
+ UseTokenInfo now default

123
compiler/types.pas
View File

@ -25,7 +25,7 @@ unit types;
interface
uses
cobjects,globals,symtable,tree,aasm;
cobjects,globals,symtable,tree;
type
tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
@ -110,7 +110,7 @@ unit types;
implementation
uses verbose;
uses verbose,aasm;
function is_constintnode(p : ptree) : boolean;
@ -143,7 +143,7 @@ unit types;
begin
is_constboolnode:=((p^.treetype=ordconstn) and
(p^.resulttype^.deftype=orddef) and
(porddef(p^.resulttype)^.typ=bool8bit));
(porddef(p^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]));
end;
function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
@ -189,35 +189,32 @@ unit types;
end;
function is_ordinal(def : pdef) : boolean;
var
dt : tbasetype;
begin
case def^.deftype of
orddef : begin
dt:=porddef(def)^.typ;
is_ordinal:=(dt=s32bit) or (dt=u32bit) or (dt=uchar) or (dt=u8bit) or
(dt=s8bit) or (dt=s16bit) or (dt=bool8bit) or (dt=u16bit);
end;
enumdef : is_ordinal:=true;
else is_ordinal:=false;
orddef : begin
dt:=porddef(def)^.typ;
is_ordinal:=dt in [uchar,u8bit,u16bit,u32bit,s8bit,s16bit,s32bit,bool8bit,bool16bit,bool32bit];
end;
enumdef : is_ordinal:=true;
else
is_ordinal:=false;
end;
end;
function is_signed(def : pdef) : boolean;
var
dt : tbasetype;
begin
case def^.deftype of
orddef : begin
dt:=porddef(def)^.typ;
is_signed:=(dt=s32bit) or (dt=s8bit) or (dt=s16bit);
end;
enumdef : is_signed:=false;
else internalerror(1001);
dt:=porddef(def)^.typ;
is_signed:=(dt in [s8bit,s16bit,s32bit]);
end;
enumdef : is_signed:=false;
else
is_signed:=false;
end;
end;
@ -340,37 +337,20 @@ unit types;
procedure getrange(def : pdef;var l : longint;var h : longint);
begin
if def^.deftype=orddef then
case porddef(def)^.typ of
s32bit,s16bit,u16bit,s8bit,u8bit :
begin
l:=porddef(def)^.von;
h:=porddef(def)^.bis;
end;
bool8bit : begin
l:=0;
h:=1;
end;
uchar : begin
l:=0;
h:=255;
end;
u32bit : begin
{ this should work now }
l:=porddef(def)^.von;
h:=porddef(def)^.bis;
end;
end
else
if def^.deftype=enumdef then
begin
l:=0;
h:=penumdef(def)^.max;
end;
case def^.deftype of
orddef : begin
l:=porddef(def)^.low;
h:=porddef(def)^.high;
end;
enumdef : begin
l:=0;
h:=penumdef(def)^.max;
end;
end;
end;
function get_ordinal_value(p : ptree) : longint;
function get_ordinal_value(p : ptree) : longint;
begin
if p^.treetype=ordconstn then
get_ordinal_value:=p^.value
@ -378,8 +358,8 @@ unit types;
Message(parser_e_ordinal_expected);
end;
function mmx_type(p : pdef) : tmmxtype;
function mmx_type(p : pdef) : tmmxtype;
begin
mmx_type:=mmxno;
if is_mmx_able_array(p) then
@ -527,19 +507,16 @@ unit types;
b:=is_equal(ppointerdef(def1)^.definition,ppointerdef(def2)^.definition);
end
else
{ Grundtypen sind gleich, wenn sie den selben Grundtyp haben, }
{ und wenn noetig den selben Unterbereich haben }
{ ordinals are equal only when the ordinal type is equal }
if (def1^.deftype=orddef) and (def2^.deftype=orddef) then
begin
case porddef(def1)^.typ of
u32bit,u8bit,s32bit,s8bit,u16bit,s16bit : begin
if porddef(def1)^.typ=porddef(def2)^.typ then
if (porddef(def1)^.von=porddef(def2)^.von) and
(porddef(def1)^.bis=porddef(def2)^.bis) then
b:=true;
end;
uvoid,bool8bit,uchar :
b:=porddef(def1)^.typ=porddef(def2)^.typ;
u8bit,u16bit,u32bit,
s8bit,s16bit,s32bit : b:=((porddef(def1)^.typ=porddef(def2)^.typ) and
(porddef(def1)^.low=porddef(def2)^.low) and
(porddef(def1)^.high=porddef(def2)^.high));
uvoid,uchar,
bool8bit,bool16bit,bool32bit : b:=(porddef(def1)^.typ=porddef(def2)^.typ);
end;
end
else
@ -646,23 +623,10 @@ unit types;
{ see p.47 of Turbo Pascal 7.01 manual for the separation of types }
{ range checking for case statements is done with testrange }
case porddef(def1)^.typ of
s32bit,u32bit,u8bit,s8bit,s16bit,u16bit:
Begin
{ PROBABLE CODE GENERATION BUG HERE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
{ if porddef(def2)^.typ in [s32bit,u32bit,u8bit,s8bit,s16bit,u16bit] then
is_subequal := TRUE; }
if (porddef(def2)^.typ = s32bit) or
(porddef(def2)^.typ = u32bit) or
(porddef(def2)^.typ = u8bit) or
(porddef(def2)^.typ = s8bit) or
(porddef(def2)^.typ = s16bit) or
(porddef(def2)^.typ = u16bit) then
Begin
is_subequal:=TRUE;
end;
end;
bool8bit: if porddef(def2)^.typ = bool8bit then is_subequal := TRUE;
uchar: if porddef(def2)^.typ = uchar then is_subequal := TRUE;
u8bit,u16bit,u32bit,
s8bit,s16bit,s32bit : is_subequal:=(porddef(def2)^.typ in [s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
bool8bit,bool16bit,bool32bit : is_subequal:=(porddef(def2)^.typ in [bool8bit,bool16bit,bool32bit]);
uchar : is_subequal:=(porddef(def2)^.typ=uchar);
end;
end
else
@ -897,7 +861,7 @@ unit types;
if has_virtual_method and not(has_constructor) then
Message1(parser_w_virtual_without_constructor,_class^.name^);
{ generates the VMT }
@ -964,7 +928,12 @@ unit types;
end.
{
$Log$
Revision 1.12 1998-05-12 10:47:00 peter
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
Revision 1.12 1998/05/12 10:47:00 peter
* moved printstatus to verb_def
+ V_Normal which is between V_Error and V_Warning and doesn't have a
prefix like error: warning: and is included in V_Default