From d6268ae22f932374bbf2f9c95c45a3e7eacd95ec Mon Sep 17 00:00:00 2001 From: peter Date: Wed, 3 Jun 1998 22:48:50 +0000 Subject: [PATCH] + wordbool,longbool * rename bis,von -> high,low * moved some systemunit loading/creating to psystem.pas --- compiler/cg386cnv.pas | 166 +++++++++++++++++++---------- compiler/cgi386.pas | 115 ++++++++++---------- compiler/cgi386ad.inc | 117 +++++++++++--------- compiler/parser.pas | 72 ++----------- compiler/pass_1.pas | 243 +++++++++++++++++++++--------------------- compiler/pbase.pas | 12 +-- compiler/pdecl.pas | 19 ++-- compiler/pmodules.pas | 128 ++-------------------- compiler/psystem.pas | 236 ++++++++++++++++++++++++++++++++++++++++ compiler/ptconst.pas | 11 +- compiler/scanner.pas | 14 ++- compiler/symdef.inc | 68 +++++++----- compiler/tree.pas | 9 +- compiler/types.pas | 123 ++++++++------------- 14 files changed, 736 insertions(+), 597 deletions(-) create mode 100644 compiler/psystem.pas diff --git a/compiler/cg386cnv.pas b/compiler/cg386cnv.pas index 2d0ce3390b..5462f86d8b 100644 --- a/compiler/cg386cnv.pas +++ b/compiler/cg386cnv.pas @@ -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)^.bisporddef(p2)^.low) or + (porddef(p1)^.highporddef(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)^.bisporddef(hp^.resulttype)^.low) or + (porddef(p^.resulttype)^.highLOC_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 diff --git a/compiler/cgi386.pas b/compiler/cgi386.pas index b74f9208a2..13f1515b76 100644 --- a/compiler/cgi386.pas +++ b/compiler/cgi386.pas @@ -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 diff --git a/compiler/cgi386ad.inc b/compiler/cgi386ad.inc index ef48fff40b..4fa24dfdc5 100644 --- a/compiler/cgi386ad.inc +++ b/compiler/cgi386ad.inc @@ -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 diff --git a/compiler/parser.pas b/compiler/parser.pas index 1828d95c60..8c778da7a6 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -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 diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas index def9b65b82..a36bb43b44 100644 --- a/compiler/pass_1.pas +++ b/compiler/pass_1.pas @@ -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)^.typenumdef) 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)^.bisporddef(def_to)^.low) and + (porddef(def_from)^.highdef_to^.size) or - ((porddef(conv_to)^.vonporddef(def_to)^.bis)) then + ((porddef(conv_to)^.lowporddef(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 diff --git a/compiler/pbase.pas b/compiler/pbase.pas index 967cac69ba..235fa09fc4 100644 --- a/compiler/pbase.pas +++ b/compiler/pbase.pas @@ -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 diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index c65679c96b..770ff03faa 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -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) diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index c9ff5b4093..ea204286c0 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -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 diff --git a/compiler/psystem.pas b/compiler/psystem.pas new file mode 100644 index 0000000000..d1550022eb --- /dev/null +++ b/compiler/psystem.pas @@ -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 + +} diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 1b6e97f6d6..7b9c52cb2a 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -68,8 +68,8 @@ unit ptconst; procedure check_range; begin - if ((p^.value>porddef(def)^.bis) or - (p^.valueporddef(def)^.high) or + (p^.value 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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index d374d5e667..467644e0ed 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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 diff --git a/compiler/symdef.inc b/compiler/symdef.inc index 38b90d9754..fbb0c64eec 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -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 diff --git a/compiler/tree.pas b/compiler/tree.pas index 3c43249b1b..04238753ab 100644 --- a/compiler/tree.pas +++ b/compiler/tree.pas @@ -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 diff --git a/compiler/types.pas b/compiler/types.pas index 9ca2cf1a7b..ce99ddf34e 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -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