+ wordbool,longbool

  * rename bis,von -> high,low
  * moved some systemunit loading/creating to psystem.pas

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)^.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

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
 

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

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
 

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),
-
+            (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),
            {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_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_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�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

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

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)
 

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

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
+
+}

compiler/ptconst.pas

@@ -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

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

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

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

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