* first working array of const things

compiler/cg386ld.pas

@@ -40,6 +40,7 @@ interface
     procedure secondload(var p : ptree);
     procedure secondassignment(var p : ptree);
     procedure secondfuncret(var p : ptree);
+    procedure secondarrayconstruct(var p : ptree);
 
 
 implementation
@@ -559,10 +560,157 @@ implementation
       end;
 
 
+{*****************************************************************************
+                           SecondArrayConstruct
+*****************************************************************************}
+
+      const
+        vtInteger    = 0;
+        vtBoolean    = 1;
+        vtChar       = 2;
+        vtExtended   = 3;
+        vtString     = 4;
+        vtPointer    = 5;
+        vtPChar      = 6;
+        vtObject     = 7;
+        vtClass      = 8;
+        vtWideChar   = 9;
+        vtPWideChar  = 10;
+        vtAnsiString = 11;
+        vtCurrency   = 12;
+        vtVariant    = 13;
+        vtInterface  = 14;
+        vtWideString = 15;
+        vtInt64      = 16;
+
+    procedure emit_mov_value_ref(const t:tlocation;const ref:treference);
+      begin
+        case t.loc of
+          LOC_REGISTER,
+         LOC_CREGISTER : begin
+                           exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                             t.register,newreference(ref))));
+                         end;
+               LOC_MEM,
+         LOC_REFERENCE : begin
+                           if t.reference.isintvalue then
+                             exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,
+                               t.reference.offset,newreference(ref))))
+                           else
+                             begin
+                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                 newreference(t.reference),R_EDI)));
+                               exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                                 R_EDI,newreference(ref))));
+                             end;
+                         end;
+        else
+         internalerror(330);
+        end;
+      end;
+
+
+    procedure emit_mov_addr_ref(const t:tlocation;const ref:treference);
+      begin
+        case t.loc of
+               LOC_MEM,
+         LOC_REFERENCE : begin
+                           if t.reference.isintvalue then
+                             internalerror(331)
+                           else
+                             begin
+                               exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+                                 newreference(t.reference),R_EDI)));
+                               exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                                 R_EDI,newreference(ref))));
+                             end;
+                         end;
+        else
+         internalerror(332);
+        end;
+      end;
+
+
+    procedure secondarrayconstruct(var p : ptree);
+      var
+        hp    : ptree;
+        href  : treference;
+        hreg  : tregister;
+        lt    : pdef;
+        vtype : longint;
+      begin
+        clear_reference(p^.location.reference);
+        gettempofsizereference(parraydef(p^.resulttype)^.highrange*8,p^.location.reference);
+        hp:=p;
+        href:=p^.location.reference;
+        while assigned(hp) do
+         begin
+           secondpass(hp^.left);
+           if codegenerror then
+            exit;
+           { find the correct vtype value }
+           vtype:=$ff;
+           lt:=hp^.left^.resulttype;
+           case lt^.deftype of
+           enumdef,
+            orddef : begin
+                       if (lt^.deftype=enumdef) or
+                          is_integer(lt) then
+                        vtype:=vtInteger
+                       else
+                        if is_boolean(lt) then
+                         vtype:=vtBoolean
+                       else
+                        if (lt^.deftype=orddef) and (porddef(lt)^.typ=uchar) then
+                         vtype:=vtChar;
+                       emit_mov_value_ref(hp^.left^.location,href);
+                     end;
+        pointerdef : begin
+                       if is_pchar(lt) then
+                        vtype:=vtPChar
+                       else
+                        vtype:=vtPointer;
+                       emit_mov_value_ref(hp^.left^.location,href);
+                     end;
+       classrefdef : begin
+                       vtype:=vtClass;
+                       emit_mov_value_ref(hp^.left^.location,href);
+                     end;
+         stringdef : begin
+                       if is_shortstring(lt) then
+                        begin
+                          vtype:=vtString;
+                          emit_mov_addr_ref(hp^.left^.location,href);
+                        end
+                       else
+                        if is_ansistring(lt) then
+                         begin
+                           vtype:=vtAnsiString;
+                           emit_mov_value_ref(hp^.left^.location,href);
+                         end;
+                     end;
+           end;
+           if vtype=$ff then
+            internalerror(14357);
+           { update href to the vtype field and write it }
+           inc(href.offset,4);
+           exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,
+             vtype,newreference(href))));
+           { update href to the next element }
+           inc(href.offset,4);
+           { load next entry }
+           hp:=hp^.right;
+         end;
+      end;
+
+
 end.
 {
   $Log$
-  Revision 1.17  1998-09-20 18:00:19  florian
+  Revision 1.18  1998-09-23 09:58:48  peter
+    * first working array of const things
+
+  Revision 1.17  1998/09/20 18:00:19  florian
     * small compiling problems fixed
 
   Revision 1.16  1998/09/20 17:46:48  florian

compiler/pass_1.pas

@@ -56,7 +56,7 @@ unit pass_1;
       we don't count the ref }
     const
        count_ref : boolean = true;
-
+       allow_array_constructor : boolean = false;
 
     { marks an lvalue as "unregable" }
     procedure make_not_regable(p : ptree);
@@ -148,6 +148,218 @@ unit pass_1;
     function is_assignment_overloaded(from_def,to_def : pdef) : boolean;forward;
 
 
+    procedure arrayconstructor_to_set(var p:ptree);
+      var
+        constp,
+        buildp,
+        p2,p3,p4    : ptree;
+        pd          : pdef;
+        constset    : pconstset;
+        constsetlo,
+        constsethi  : longint;
+
+        procedure update_constsethi(p:pdef);
+        begin
+          if ((p^.deftype=orddef) and
+              (porddef(p)^.high>constsethi)) then
+            constsethi:=porddef(p)^.high
+          else
+            if ((p^.deftype=enumdef) and
+                (penumdef(p)^.max>constsethi)) then
+              constsethi:=penumdef(p)^.max;
+        end;
+
+        procedure do_set(pos : longint);
+        var
+          mask,l : longint;
+        begin
+          if (pos>255) or (pos<0) then
+           Message(parser_e_illegal_set_expr);
+          if pos>constsethi then
+           constsethi:=pos;
+          if pos<constsetlo then
+           constsetlo:=pos;
+          l:=pos shr 3;
+          mask:=1 shl (pos mod 8);
+          { do we allow the same twice }
+          if (constset^[l] and mask)<>0 then
+           Message(parser_e_illegal_set_expr);
+          constset^[l]:=constset^[l] or mask;
+        end;
+
+      var
+        l : longint;
+      begin
+        new(constset);
+        FillChar(constset^,sizeof(constset^),0);
+        pd:=nil;
+        constsetlo:=0;
+        constsethi:=0;
+        constp:=gensinglenode(setconstn,nil);
+        constp^.value_set:=constset;
+        buildp:=constp;
+        if assigned(p^.left) then
+         begin
+           while assigned(p) do
+            begin
+              p4:=nil; { will contain the tree to create the set }
+            { split a range into p2 and p3 }
+              if p^.left^.treetype=arrayconstructrangen then
+               begin
+                 p2:=p^.left^.left;
+                 p3:=p^.left^.right;
+               { node is not used anymore }
+                 putnode(p^.left);
+               end
+              else
+               begin
+                 p2:=p^.left;
+                 p3:=nil;
+               end;
+              firstpass(p2);
+              if codegenerror then
+               break;
+              case p2^.resulttype^.deftype of
+            enumdef,
+             orddef : begin
+                        if (p2^.resulttype^.deftype=orddef) and
+                           (porddef(p2^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
+                         begin
+                           p2:=gentypeconvnode(p2,u8bitdef);
+                           firstpass(p2);
+                         end;
+                        { set settype result }
+                        if pd=nil then
+                          pd:=p2^.resulttype;
+                        if not(is_equal(pd,p2^.resulttype)) then
+                         begin
+                           Message(type_e_typeconflict_in_set);
+                           disposetree(p2);
+                         end
+                        else
+                         begin
+                           if assigned(p3) then
+                            begin
+                              if (p3^.resulttype^.deftype=orddef) and
+                                 (porddef(p3^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
+                               begin
+                                 p3:=gentypeconvnode(p3,u8bitdef);
+                                 firstpass(p3);
+                               end;
+                              if not(is_equal(pd,p3^.resulttype)) then
+                                Message(type_e_typeconflict_in_set)
+                              else
+                                begin
+                                  if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
+                                   begin
+                                     for l:=p2^.value to p3^.value do
+                                      do_set(l);
+                                     disposetree(p3);
+                                     disposetree(p2);
+                                   end
+                                  else
+                                   begin
+                                     update_constsethi(p3^.resulttype);
+                                     p4:=gennode(setelementn,p2,p3);
+                                   end;
+                                end;
+                            end
+                           else
+                            begin
+                           { Single value }
+                              if p2^.treetype=ordconstn then
+                               begin
+                                 do_set(p2^.value);
+                                 disposetree(p2);
+                               end
+                              else
+                               begin
+                                 update_constsethi(p2^.resulttype);
+                                 p4:=gennode(setelementn,p2,nil);
+                               end;
+                            end;
+                         end;
+                      end;
+          stringdef : begin
+                        if pd=nil then
+                         pd:=cchardef;
+                        if not(is_equal(pd,cchardef)) then
+                         Message(type_e_typeconflict_in_set)
+                        else
+                         for l:=1 to length(pstring(p2^.value_str)^) do
+                          do_set(ord(pstring(p2^.value_str)^[l]));
+                        disposetree(p2);
+                      end;
+              else
+               Internalerror(4234);
+              end;
+            { insert the set creation tree }
+              if assigned(p4) then
+               buildp:=gennode(addn,buildp,p4);
+            { load next and dispose current node }
+              p2:=p;
+              p:=p^.right;
+              putnode(p2);
+            end;
+         end
+        else
+         begin
+         { empty set [], only remove node }
+           putnode(p);
+         end;
+      { set the initial set type }
+        constp^.resulttype:=new(psetdef,init(pd,constsethi));
+      { set the new tree }
+        p:=buildp;
+      end;
+
+
+    procedure firstarrayconstruct(var p : ptree);
+      var
+        pd : pdef;
+        hp : ptree;
+        len : longint;
+      begin
+      { are we allowing array constructor? Then convert it to a set }
+        if not allow_array_constructor then
+         begin
+           arrayconstructor_to_set(p);
+           firstpass(p);
+           exit;
+         end;
+      { only pass left tree, right tree contains next construct if any }
+        pd:=nil;
+        len:=0;
+        if assigned(p^.left) then
+         begin
+           hp:=p;
+           while assigned(hp) do
+            begin
+              firstpass(hp^.left);
+              if (pd=nil) then
+               pd:=hp^.left^.resulttype
+              else
+               Comment(V_Warning,'Variant type found !!');
+              inc(len);
+              hp:=hp^.right;
+            end;
+           if len=0 then
+            Internalerror(4235);
+         end;
+        calcregisters(p,0,0,0);
+        p^.resulttype:=new(parraydef,init(0,len,pd));
+        p^.location.loc:=LOC_REFERENCE;
+      end;
+
+
+    procedure firstarrayconstructrange(var p : ptree);
+      begin
+      { This is not allowed, it's only to support sets when parsing the [a..b] }
+        Internalerror(4236);
+        Codegenerror:=true;
+      end;
+
+
     function isconvertable(def_from,def_to : pdef;
              var doconv : tconverttype;fromtreetype : ttreetyp;
              explicit : boolean) : boolean;
@@ -422,7 +634,7 @@ unit pass_1;
 
          { string constant to zero terminated string constant }
           if (fromtreetype=stringconstn) and
-             ((def_to^.deftype=pointerdef) and is_equal(Ppointerdef(def_to)^.definition,cchardef)) then
+             is_pchar(def_to) then
            begin
              doconv:=tc_cstring_charpointer;
              b:=true;
@@ -1928,6 +2140,7 @@ unit pass_1;
          { assignements to open arrays aren't allowed }
          if is_open_array(p^.left^.resulttype) then
            CGMessage(type_e_mismatch);
+
          { test if we can avoid copying string to temp
            as in s:=s+...; (PM) }
 {$ifdef dummyi386}
@@ -2895,6 +3108,7 @@ unit pass_1;
     procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
 
       var store_valid : boolean;
+          old_array_constructor : boolean;
           convtyp     : tconverttype;
       begin
          inc(parsing_para_level);
@@ -2912,21 +3126,17 @@ unit pass_1;
            end;
          if defcoll=nil then
            begin
-              { this breaks typeconversions in write !!! (PM) }
-              {if not(assigned(p^.resulttype)) then }
+              old_array_constructor:=allow_array_constructor;
+              allow_array_constructor:=true;
               if not(assigned(p^.resulttype)) or
                 (p^.left^.treetype=typeconvn) then
                 firstpass(p^.left);
-              {else
-                exit; this broke the
-                value of registers32 !! }
-
+              allow_array_constructor:=old_array_constructor;
               if codegenerror then
                 begin
                    dec(parsing_para_level);
                    exit;
                 end;
-
               p^.resulttype:=p^.left^.resulttype;
            end
          { if we know the routine which is called, then the type }
@@ -2948,7 +3158,12 @@ unit pass_1;
                       p^.left^.treetype,false) then
                       if convtyp=tc_array_to_pointer then
                         must_be_valid:=false;
-                    firstpass(p^.left);
+                    { only process typeconvn, else it will break other trees }
+                    old_array_constructor:=allow_array_constructor;
+                    allow_array_constructor:=true;
+{                    if (p^.left^.treetype=typeconvn) then }
+                      firstpass(p^.left);
+                    allow_array_constructor:=old_array_constructor;
                     must_be_valid:=store_valid;
                  end;
               if not(is_shortstring(p^.left^.resulttype) and
@@ -4596,7 +4811,7 @@ unit pass_1;
 
          firstpass(p^.right);
          if codegenerror then
-           exit;
+          exit;
 
          if p^.right^.resulttype^.deftype<>setdef then
           CGMessage(sym_e_set_expected);
@@ -5211,7 +5426,7 @@ unit pass_1;
            pobjectdef(p^.left^.resulttype)))) then
            CGMessage(type_e_mismatch);
 
-         p^.location:=p^.left^.location;
+         set_location(p^.location,p^.left^.location);
          p^.resulttype:=pclassrefdef(p^.right^.resulttype)^.definition;
       end;
 
@@ -5427,7 +5642,9 @@ unit pass_1;
              firstgoto,firstsimplenewdispose,firsttryexcept,
              firstraise,firstnothing,firsttryfinally,
              firstonn,firstis,firstas,firstadd,
-             firstnothing,firstadd,firstprocinline,firstnothing,firstloadvmt);
+             firstnothing,firstadd,firstprocinline,
+             firstarrayconstruct,firstarrayconstructrange,
+             firstnothing,firstloadvmt);
 
       var
          oldcodegenerror  : boolean;
@@ -5516,7 +5733,10 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.89  1998-09-22 15:34:10  peter
+  Revision 1.90  1998-09-23 09:58:49  peter
+    * first working array of const things
+
+  Revision 1.89  1998/09/22 15:34:10  peter
     + pchar -> string conversion
 
   Revision 1.88  1998/09/21 08:45:14  pierre

compiler/pass_2.pas

@@ -196,6 +196,8 @@ implementation
              secondfail,        {failn}
              secondadd,         {starstarn}
              secondprocinline,  {procinlinen}
+             secondarrayconstruct, {arrayconstructn}
+             secondnothing,     {arrayconstructrangen}
              secondnothing,     {nothingn}
              secondloadvmt      {loadvmtn}
              );
@@ -483,7 +485,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  1998-09-21 10:01:06  peter
+  Revision 1.6  1998-09-23 09:58:52  peter
+    * first working array of const things
+
+  Revision 1.5  1998/09/21 10:01:06  peter
     * check if procinfo.def is assigned before storing registersfpu
 
   Revision 1.4  1998/09/21 08:45:16  pierre

compiler/pexpr.pas

@@ -972,146 +972,42 @@ unit pexpr;
          { Read a set between [] }
          function factor_read_set:ptree;
          var
-           constp,
-           buildp,
-           p2,p3,p4    : ptree;
-           pd          : pdef;
-           constset    : pconstset;
-           constsetlo,
-           constsethi  : longint;
-
-           procedure update_constsethi(p:pdef);
-           begin
-             if ((p^.deftype=orddef) and
-                 (porddef(p)^.high>constsethi)) then
-               constsethi:=porddef(p)^.high
-             else
-               if ((p^.deftype=enumdef) and
-                   (penumdef(p)^.max>constsethi)) then
-                 constsethi:=penumdef(p)^.max;
-           end;
-
-           procedure do_set(pos : longint);
-           var
-             mask,l : longint;
-           begin
-             if (pos>255) or (pos<0) then
-              Message(parser_e_illegal_set_expr);
-             if pos>constsethi then
-              constsethi:=pos;
-             if pos<constsetlo then
-              constsetlo:=pos;
-             l:=pos shr 3;
-             mask:=1 shl (pos mod 8);
-             { do we allow the same twice }
-             if (constset^[l] and mask)<>0 then
-              Message(parser_e_illegal_set_expr);
-             constset^[l]:=constset^[l] or mask;
-           end;
-
-         var
-           l : longint;
+           p1,
+           lastp,
+           buildp : ptree;
          begin
-           new(constset);
-           FillChar(constset^,sizeof(constset^),0);
-           constsetlo:=0;
-           constsethi:=0;
-           constp:=gensinglenode(setconstn,nil);
-           constp^.value_set:=constset;
-           buildp:=constp;
-           pd:=nil;
-           if token<>RECKKLAMMER then
+           buildp:=nil;
+         { be sure that a least one arrayconstructn is used, also for an
+           empty [] }
+           if token=RECKKLAMMER then
+            buildp:=gennode(arrayconstructn,nil,buildp)
+           else
             begin
               while true do
                begin
-                 p4:=nil; { will contain the tree to create the set }
-                 p2:=comp_expr(true);
-                 do_firstpass(p2);
+                 p1:=comp_expr(true);
+                 do_firstpass(p1);
                  if codegenerror then
                   break;
-                 case p2^.resulttype^.deftype of
-               enumdef,
-                orddef : begin
-                           if (p2^.resulttype^.deftype=orddef) and
-                              (porddef(p2^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
-                            begin
-                              p2:=gentypeconvnode(p2,u8bitdef);
-                              do_firstpass(p2);
-                            end;
-                           { set settype result }
-                           if pd=nil then
-                             pd:=p2^.resulttype;
-                           if not(is_equal(pd,p2^.resulttype)) then
-                            begin
-                              Message(type_e_typeconflict_in_set);
-                              disposetree(p2);
-                            end
-                           else
-                            begin
-                              if token=POINTPOINT then
-                               begin
-                                 consume(POINTPOINT);
-                                 p3:=comp_expr(true);
-                                 do_firstpass(p3);
-                                 if codegenerror then
-                                  break;
-                                 if (p3^.resulttype^.deftype=orddef) and
-                                    (porddef(p3^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
-                                  begin
-                                    p3:=gentypeconvnode(p3,u8bitdef);
-                                    do_firstpass(p3);
-                                  end;
-                                 if not(is_equal(pd,p3^.resulttype)) then
-                                   Message(type_e_typeconflict_in_set)
-                                 else
-                                   begin
-                                     if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
-                                      begin
-                                        for l:=p2^.value to p3^.value do
-                                         do_set(l);
-                                        disposetree(p3);
-                                        disposetree(p2);
-                                      end
-                                     else
-                                      begin
-                                        update_constsethi(p3^.resulttype);
-                                        p4:=gennode(setelementn,p2,p3);
-                                      end;
-                                   end;
-                               end
-                              else
-                               begin
-                              { Single value }
-                                 if p2^.treetype=ordconstn then
-                                  begin
-                                    do_set(p2^.value);
-                                    disposetree(p2);
-                                  end
-                                 else
-                                  begin
-                                    update_constsethi(p2^.resulttype);
-                                    p4:=gennode(setelementn,p2,nil);
-                                  end;
-                               end;
-                            end;
-                         end;
-             stringdef : begin
-                           if pd=nil then
-                            pd:=cchardef;
-                           if not(is_equal(pd,cchardef)) then
-                            Message(type_e_typeconflict_in_set)
-                           else
-                            for l:=1 to length(pstring(p2^.value_str)^) do
-                             do_set(ord(pstring(p2^.value_str)^[l]));
-                           disposetree(p2);
-                         end;
+                 if token=POINTPOINT then
+                  begin
+                    consume(POINTPOINT);
+                    p2:=comp_expr(true);
+                    do_firstpass(p2);
+                    if codegenerror then
+                     break;
+                    p1:=gennode(arrayconstructrangen,p1,p2);
+                  end;
+               { insert at the end of the tree, to get the correct order }
+                 if not assigned(buildp) then
+                  begin
+                    buildp:=gensinglenode(arrayconstructn,p1);
+                    lastp:=buildp;
+                  end
                  else
-                  Internalerror(4234);
-                 end;
-               { insert the set creation tree }
-                 if assigned(p4) then
                   begin
-                    buildp:=gennode(addn,buildp,p4);
+                    lastp^.right:=gensinglenode(arrayconstructn,p1);
+                    lastp:=lastp^.right;
                   end;
                { there could be more elements }
                  if token=COMMA then
@@ -1120,7 +1016,6 @@ unit pexpr;
                    break;
                end;
             end;
-           constp^.resulttype:=new(psetdef,init(pd,constsethi));
            factor_read_set:=buildp;
          end;
 
@@ -1856,7 +1751,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.52  1998-09-20 09:38:45  florian
+  Revision 1.53  1998-09-23 09:58:54  peter
+    * first working array of const things
+
+  Revision 1.52  1998/09/20 09:38:45  florian
     * hasharray for defs fixed
     * ansistring code generation corrected (init/final, assignement)
 

compiler/tree.pas

@@ -120,7 +120,9 @@ unit tree;
                    caretn,          {Represents the ^ operator.}
                    failn,           {Represents the fail statement.}
                    starstarn,       {Represents the ** operator exponentiation }
-                   procinlinen,      {Procedures that can be inlined }
+                   procinlinen,     {Procedures that can be inlined }
+                   arrayconstructn, {Construction node for [...] parsing}
+                   arrayconstructrangen, {Range element to allow sets in array construction tree}
                    { added for optimizations where we cannot suppress }
                    nothingn,
                    loadvmtn);       {???.}
@@ -1567,7 +1569,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.40  1998-09-22 15:34:07  peter
+  Revision 1.41  1998-09-23 09:58:55  peter
+    * first working array of const things
+
+  Revision 1.40  1998/09/22 15:34:07  peter
     + pchar -> string conversion
 
   Revision 1.39  1998/09/21 08:45:27  pierre

compiler/types.pas

@@ -40,6 +40,9 @@ unit types;
     { returns true, if def defines an ordinal type }
     function is_integer(def : pdef) : boolean;
 
+    { true if p is a boolean }
+    function is_boolean(def : pdef) : boolean;
+
     { true if p points to an open array def }
     function is_open_array(p : pdef) : boolean;
 
@@ -55,6 +58,9 @@ unit types;
     { true if o is a short string def }
     function is_shortstring(p : pdef) : boolean;
 
+    { true if o is a pchar def }
+    function is_pchar(p : pdef) : boolean;
+
     { returns true, if def defines a signed data type (only for ordinal types) }
     function is_signed(def : pdef) : boolean;
 
@@ -204,6 +210,13 @@ unit types;
       end;
 
 
+    { true if p is a boolean }
+    function is_boolean(def : pdef) : boolean;
+      begin
+        is_boolean:=(def^.deftype=orddef) and
+                    (porddef(def)^.typ in [bool8bit,bool16bit,bool32bit]);
+      end;
+
     { true if p is signed (integer) }
     function is_signed(def : pdef) : boolean;
       var
@@ -261,6 +274,13 @@ unit types;
                          (pstringdef(p)^.string_typ=st_shortstring);
       end;
 
+    { true if p is a pchar def }
+    function is_pchar(p : pdef) : boolean;
+      begin
+        is_pchar:=(p^.deftype=pointerdef) and
+                  is_equal(Ppointerdef(p)^.definition,cchardef);
+      end;
+
 
     { true if the return value is in accumulator (EAX for i386), D0 for 68k }
     function ret_in_acc(def : pdef) : boolean;
@@ -922,7 +942,10 @@ unit types;
 end.
 {
   $Log$
-  Revision 1.30  1998-09-22 15:40:58  peter
+  Revision 1.31  1998-09-23 09:58:56  peter
+    * first working array of const things
+
+  Revision 1.30  1998/09/22 15:40:58  peter
     * some extra ifdef GDB
 
   Revision 1.29  1998/09/16 12:37:31  michael