* fixed array of const

  * generic platform independent high() support

compiler/cg386cal.pas

@@ -26,10 +26,6 @@ interface
     uses
       symtable,tree;
 
-    { save the size of pushed parameter }
-    var
-       pushedparasize : longint;
-
     procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
                 push_from_left_to_right,inlined : boolean;para_offset : longint);
     procedure secondcalln(var p : ptree);
@@ -52,28 +48,39 @@ implementation
                              SecondCallParaN
 *****************************************************************************}
 
-
     procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
                 push_from_left_to_right,inlined : boolean;para_offset : longint);
 
       procedure maybe_push_high;
+{$ifdef OLDHIGH}
         var
            r    : preference;
            hreg : tregister;
            href : treference;
            len  : longint;
+{$endif}
         begin
            { open array ? }
            { defcoll^.data can be nil for read/write }
            if assigned(defcoll^.data) and
-              (is_open_array(defcoll^.data) or
-               is_open_string(defcoll^.data)) then
+              push_high_param(defcoll^.data) then
              begin
-              { push high }
+{$ifndef OLDHIGH}
+               if assigned(p^.hightree) then
+                begin
+                  secondpass(p^.hightree);
+                  push_value_para(p^.hightree,inlined,para_offset);
+                end
+               else
+                internalerror(432645);
+{$else}
+               { push high }
                case p^.left^.resulttype^.deftype of
                 arraydef : begin
                              if is_open_array(p^.left^.resulttype) then
                               begin
+                                   p^.location.reference.base:=procinfo.framepointer;
+                                   p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
                                 r:=new_reference(highframepointer,highoffset+4);
                                 len:=-1;
                               end
@@ -101,7 +108,7 @@ implementation
                                    len:=str_length(p^.left)
                                  else
                                    begin
-                                     href:=p^.left^.location.reference;
+                                     href:=p^.location.reference;
                                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(href),R_EDI)));
                                      hreg:=R_EDI;
                                      len:=-2;
@@ -148,20 +155,15 @@ implementation
                     push_int(len);
                 end;
                inc(pushedparasize,4);
+{$endif OLDHIGH}
              end;
         end;
 
       var
-         size : longint;
-         otlabel,hlabel,oflabel : plabel;
+         otlabel,oflabel : plabel;
          { temporary variables: }
          tempdeftype : tdeftype;
-         tempreference : treference;
-         r      : preference;
-         opsize : topsize;
-         op     : tasmop;
-         hreg   : tregister;
-
+         r : preference;
       begin
          { push from left to right if specified }
          if push_from_left_to_right and assigned(p^.right) then
@@ -254,391 +256,7 @@ implementation
                    del_reference(p^.left^.location.reference);
                 end
               else
-                case p^.left^.location.loc of
-                   LOC_REGISTER,
-                   LOC_CREGISTER:
-                     begin
-                        case p^.left^.location.register of
-                           R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
-                           R_EDI,R_ESP,R_EBP :
-                              begin
-                                inc(pushedparasize,4);
-                                if inlined then
-                                  begin
-                                     r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                     exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-                                       p^.left^.location.register,r)));
-                                  end
-                                else
-                                  exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
-                                ungetregister32(p^.left^.location.register);
-                              end;
-                           R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
-                              begin
-                                if target_os.stackalignment=4 then
-                                  begin
-                                    opsize:=S_L;
-                                    hreg:=reg16toreg32(p^.left^.location.register);
-                                    inc(pushedparasize,4);
-                                  end
-                                else
-                                  begin
-                                    opsize:=S_W;
-                                    hreg:=p^.left^.location.register;
-                                    inc(pushedparasize,2);
-                                  end;
-                                if inlined then
-                                  begin
-                                    r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
-                                  end
-                                else
-                                  exprasmlist^.concat(new(pai386,op_reg(A_PUSH,opsize,hreg)));
-                                ungetregister32(reg16toreg32(p^.left^.location.register));
-                              end;
-                           R_AL,R_BL,R_CL,R_DL:
-                              begin
-                                if target_os.stackalignment=4 then
-                                  begin
-                                    opsize:=S_L;
-                                    hreg:=reg8toreg32(p^.left^.location.register);
-                                    inc(pushedparasize,4);
-                                  end
-                                else
-                                  begin
-                                    opsize:=S_W;
-                                    hreg:=reg8toreg16(p^.left^.location.register);
-                                    inc(pushedparasize,2);
-                                  end;
-                                { we must push always 16 bit }
-                                if inlined then
-                                  begin
-                                    r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
-                                  end
-                                else
-                                  exprasmlist^.concat(new(pai386,op_reg(A_PUSH,opsize,hreg)));
-                                ungetregister32(reg8toreg32(p^.left^.location.register));
-                              end;
-                        end;
-                     end;
-                   LOC_FPU:
-                     begin
-                        size:=align(pfloatdef(p^.left^.resulttype)^.size,target_os.stackalignment);
-                        inc(pushedparasize,size);
-                        if not inlined then
-                         exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
-{$ifdef GDB}
-                        if (cs_debuginfo in aktmoduleswitches) and
-                           (exprasmlist^.first=exprasmlist^.last) then
-                          exprasmlist^.concat(new(pai_force_line,init));
-{$endif GDB}
-                        r:=new_reference(R_ESP,0);
-                        floatstoreops(pfloatdef(p^.left^.resulttype)^.typ,op,opsize);
-                        { this is the easiest case for inlined !! }
-                        if inlined then
-                          begin
-                             r^.base:=procinfo.framepointer;
-                             r^.offset:=para_offset-pushedparasize;
-                          end;
-                        exprasmlist^.concat(new(pai386,op_ref(op,opsize,r)));
-                     end;
-                   LOC_REFERENCE,LOC_MEM:
-                     begin
-                        tempreference:=p^.left^.location.reference;
-                        del_reference(p^.left^.location.reference);
-                        case p^.resulttype^.deftype of
-                        enumdef,
-                        orddef :
-                          begin
-                            case p^.resulttype^.size of
-                               8 : begin
-                                    inc(pushedparasize,8);
-                                    if inlined then
-                                      begin
-                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                           newreference(tempreference),R_EDI)));
-                                         r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                         inc(tempreference.offset,4);
-                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                           newreference(tempreference),R_EDI)));
-                                         r:=new_reference(procinfo.framepointer,para_offset-pushedparasize+4);
-                                         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                      end
-                                    else
-                                      begin
-                                         inc(tempreference.offset,4);
-                                         emit_push_mem(tempreference);
-                                         dec(tempreference.offset,4);
-                                         emit_push_mem(tempreference);
-                                      end;
-                                 end;
-                               4 : begin
-                                    inc(pushedparasize,4);
-                                    if inlined then
-                                      begin
-                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                           newreference(tempreference),R_EDI)));
-                                         r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                      end
-                                    else
-                                      emit_push_mem(tempreference);
-                                 end;
-                           1,2 : begin
-                                   if target_os.stackalignment=4 then
-                                     begin
-                                       opsize:=S_L;
-                                       hreg:=R_EDI;
-                                       inc(pushedparasize,4);
-                                     end
-                                   else
-                                     begin
-                                       opsize:=S_W;
-                                       hreg:=R_DI;
-                                       inc(pushedparasize,2);
-                                     end;
-                                   if inlined then
-                                     begin
-                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
-                                          newreference(tempreference),hreg)));
-                                        r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                        exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
-                                     end
-                                   else
-                                     exprasmlist^.concat(new(pai386,op_ref(A_PUSH,opsize,
-                                       newreference(tempreference))));
-                                 end;
-                             else
-                              internalerror(234231);
-                             end;
-                          end;
-                        floatdef :
-                          begin
-                            case pfloatdef(p^.resulttype)^.typ of
-                            f32bit,
-                            s32real :
-                              begin
-                                 inc(pushedparasize,4);
-                                 if inlined then
-                                   begin
-                                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                        newreference(tempreference),R_EDI)));
-                                      r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                      exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                   end
-                                 else
-                                   emit_push_mem(tempreference);
-                              end;
-                            s64real,
-                            s64bit :
-                              begin
-                                inc(pushedparasize,4);
-                                inc(tempreference.offset,4);
-                                if inlined then
-                                  begin
-                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                       newreference(tempreference),R_EDI)));
-                                     r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                     exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                  end
-                                else
-                                  emit_push_mem(tempreference);
-                                inc(pushedparasize,4);
-                                dec(tempreference.offset,4);
-                                if inlined then
-                                  begin
-                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                       newreference(tempreference),R_EDI)));
-                                     r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                     exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                  end
-                                else
-                                  emit_push_mem(tempreference);
-                              end;
-                            s80real :
-                              begin
-                                inc(pushedparasize,4);
-                                if target_os.stackalignment=4 then
-                                  inc(tempreference.offset,8)
-                                else
-                                  inc(tempreference.offset,6);
-                                if inlined then
-                                  begin
-                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                       newreference(tempreference),R_EDI)));
-                                     r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                     exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                  end
-                                else
-                                  emit_push_mem(tempreference);
-                                dec(tempreference.offset,4);
-                                inc(pushedparasize,4);
-                                if inlined then
-                                  begin
-                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                       newreference(tempreference),R_EDI)));
-                                     r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                     exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                                  end
-                                else
-                                  emit_push_mem(tempreference);
-                                if target_os.stackalignment=4 then
-                                  begin
-                                    opsize:=S_L;
-                                    hreg:=R_EDI;
-                                    inc(pushedparasize,4);
-                                    dec(tempreference.offset,4);
-                                  end
-                                else
-                                  begin
-                                    opsize:=S_W;
-                                    hreg:=R_DI;
-                                    inc(pushedparasize,2);
-                                    dec(tempreference.offset,2);
-                                  end;
-                                if inlined then
-                                  begin
-                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
-                                       newreference(tempreference),hreg)));
-                                     r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                     exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
-                                  end
-                                else
-                                  exprasmlist^.concat(new(pai386,op_ref(A_PUSH,opsize,
-                                    newreference(tempreference))));
-                              end;
-                            end;
-                          end;
-                        pointerdef,procvardef,
-                        classrefdef:
-                          begin
-                             inc(pushedparasize,4);
-                             if inlined then
-                               begin
-                                  exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                    newreference(tempreference),R_EDI)));
-                                  r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                  exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                               end
-                             else
-                               emit_push_mem(tempreference);
-                          end;
-                        arraydef,recorddef,stringdef,setdef,objectdef :
-                          begin
-                             { even some structured types are 32 bit }
-                             if is_widestring(p^.resulttype) or
-                                is_ansistring(p^.resulttype) or
-                                is_smallset(p^.resulttype) or
-                                ((p^.resulttype^.deftype=objectdef) and
-                                 pobjectdef(p^.resulttype)^.isclass) then
-                               begin
-                                  inc(pushedparasize,4);
-                                  if inlined then
-                                    begin
-                                      r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                                      concatcopy(tempreference,r^,4,false,false);
-                                    end
-                                  else
-                                    emit_push_mem(tempreference);
-                               end
-                             { call by value open array ? }
-                             else
-                               internalerror(8954);
-                          end;
-                        else
-                          CGMessage(cg_e_illegal_expression);
-                        end;
-                     end;
-                   LOC_JUMP:
-                     begin
-                        getlabel(hlabel);
-                        if target_os.stackalignment=4 then
-                         begin
-                           opsize:=S_L;
-                           inc(pushedparasize,4);
-                         end
-                        else
-                         begin
-                           opsize:=S_W;
-                           inc(pushedparasize,2);
-                         end;
-                        emitl(A_LABEL,truelabel);
-                        if inlined then
-                          begin
-                             r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                             exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,1,r)));
-                          end
-                        else
-                          exprasmlist^.concat(new(pai386,op_const(A_PUSH,opsize,1)));
-                        emitl(A_JMP,hlabel);
-                        emitl(A_LABEL,falselabel);
-                        if inlined then
-                          begin
-                             r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                             exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,0,r)));
-                          end
-                        else
-                          exprasmlist^.concat(new(pai386,op_const(A_PUSH,opsize,0)));
-                        emitl(A_LABEL,hlabel);
-                     end;
-                   LOC_FLAGS:
-                     begin
-                        if not(R_EAX in unused) then
-                          exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));
-                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
-                          R_AL)));
-                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,R_AL,R_AX)));
-                        if target_os.stackalignment=4 then
-                         begin
-                           opsize:=S_L;
-                           hreg:=R_EAX;
-                           inc(pushedparasize,4);
-                         end
-                        else
-                         begin
-                           opsize:=S_W;
-                           hreg:=R_AX;
-                           inc(pushedparasize,2);
-                         end;
-                        if inlined then
-                          begin
-                             r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                             exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,hreg,r)));
-                          end
-                        else
-                          exprasmlist^.concat(new(pai386,op_reg(A_PUSH,opsize,hreg)));
-                        if not(R_EAX in unused) then
-                          exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EDI,R_EAX)));
-                     end;
-{$ifdef SUPPORT_MMX}
-                   LOC_MMXREGISTER,
-                   LOC_CMMXREGISTER:
-                     begin
-                        inc(pushedparasize,8); { was missing !!! (PM) }
-                        exprasmlist^.concat(new(pai386,op_const_reg(
-                          A_SUB,S_L,8,R_ESP)));
-{$ifdef GDB}
-                        if (cs_debuginfo in aktmoduleswitches) and
-                           (exprasmlist^.first=exprasmlist^.last) then
-                          exprasmlist^.concat(new(pai_force_line,init));
-{$endif GDB}
-                        if inlined then
-                          begin
-                             r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                             exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO,
-                               p^.left^.location.register,r)));
-                          end
-                        else
-                           begin
-                              r:=new_reference(R_ESP,0);
-                              exprasmlist^.concat(new(pai386,op_reg_ref(
-                             A_MOVQ,S_NO,p^.left^.location.register,r)));
-                        end;
-                     end;
-{$endif SUPPORT_MMX}
-                end;
+                push_value_para(p^.left,inlined,para_offset);
            end;
          freelabel(truelabel);
          freelabel(falselabel);
@@ -1614,7 +1232,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.57  1999-01-21 16:40:51  pierre
+  Revision 1.58  1999-01-21 22:10:35  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.57  1999/01/21 16:40:51  pierre
    * fix for constructor inside with statements
 
   Revision 1.56  1998/12/30 13:41:05  peter

compiler/cg386cnv.pas

@@ -29,6 +29,8 @@ interface
     uses
       tree;
 
+    procedure loadshortstring(p:ptree);
+
     procedure secondtypeconv(var p : ptree);
     procedure secondas(var p : ptree);
     procedure secondis(var p : ptree);
@@ -39,9 +41,91 @@ implementation
    uses
       cobjects,verbose,globals,systems,
       symtable,aasm,types,
-      hcodegen,temp_gen,pass_2,
+      hcodegen,temp_gen,pass_2,pass_1,
       i386,cgai386,tgeni386;
 
+
+
+    procedure push_shortstring_length(p:ptree);
+      var
+        r : preference;
+        hightree : ptree;
+
+      begin
+        if is_open_string(p^.resulttype) then
+         begin
+           getsymonlyin(p^.symtable,'high'+pvarsym(p^.symtableentry)^.name);
+           hightree:=genloadnode(pvarsym(srsym),p^.symtable);
+           firstpass(hightree);
+           secondpass(hightree);
+           push_value_para(hightree,false,0);
+           disposetree(hightree);
+{           r:=new_reference(highframepointer,highoffset+4);
+           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,r,R_EDI)));
+           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI))); }
+         end
+        else
+         begin
+           push_int(pstringdef(p^.resulttype)^.len);
+         end;
+      end;
+
+
+    procedure loadshortstring(p:ptree);
+    {
+      Load a string, handles stringdef and orddef (char) types
+    }
+      begin
+         case p^.right^.resulttype^.deftype of
+            stringdef:
+              begin
+                 if (p^.right^.treetype=stringconstn) and
+                   (str_length(p^.right)=0) then
+                   exprasmlist^.concat(new(pai386,op_const_ref(
+                      A_MOV,S_B,0,newreference(p^.left^.location.reference))))
+                 else
+                   begin
+                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                     push_shortstring_length(p^.left);
+                     emitcall('FPC_SHORTSTR_COPY',true);
+                     maybe_loadesi;
+                   end;
+              end;
+            orddef:
+              begin
+                 if p^.right^.treetype=ordconstn then
+                   exprasmlist^.concat(new(pai386,op_const_ref(
+                      A_MOV,S_W,p^.right^.value*256+1,newreference(p^.left^.location.reference))))
+                 else
+                   begin
+                      { not so elegant (goes better with extra register }
+                      if (p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                        begin
+                           exprasmlist^.concat(new(pai386,op_reg_reg(
+                              A_MOV,S_L,makereg32(p^.right^.location.register),R_EDI)));
+                           ungetregister(p^.right^.location.register);
+                        end
+                      else
+                        begin
+                           exprasmlist^.concat(new(pai386,op_ref_reg(
+                              A_MOV,S_L,newreference(p^.right^.location.reference),R_EDI)));
+                           del_reference(p^.right^.location.reference);
+                        end;
+                      exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,8,R_EDI)));
+                      exprasmlist^.concat(new(pai386,op_const_reg(A_OR,S_L,1,R_EDI)));
+                      exprasmlist^.concat(new(pai386,op_reg_ref(
+                         A_MOV,S_W,R_DI,newreference(p^.left^.location.reference))));
+                   end;
+              end;
+         else
+           CGMessage(type_e_mismatch);
+         end;
+      end;
+
+
+
+
 {*****************************************************************************
                              SecondTypeConv
 *****************************************************************************}
@@ -1478,7 +1562,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.44  1999-01-19 10:18:59  florian
+  Revision 1.45  1999-01-21 22:10:36  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.44  1999/01/19 10:18:59  florian
     * bug with mul. of dwords fixed, reported by Alexander Stohr
     * some changes to compile with TP
     + small enhancements for the new code generator

compiler/cg386inl.pas

@@ -621,6 +621,7 @@ implementation
                    exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
                  p^.location.register:=reg16toreg8(p^.location.register);
               end;
+{$ifdef OLDHIGH}
             in_high_x :
               begin
                  if is_open_array(p^.left^.resulttype) or
@@ -634,9 +635,11 @@ implementation
                         r,p^.location.register)));
                    end
               end;
+{$endif OLDHIGH}
             in_sizeof_x,
             in_typeof_x :
               begin
+{$ifdef OLDHIGH}
                { sizeof(openarray) handling }
                  if (p^.inlinenumber=in_sizeof_x) and
                     (is_open_array(p^.left^.resulttype) or
@@ -657,6 +660,7 @@ implementation
                         parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
                   end
                  else
+{$endif OLDHIGH}
                   begin
                     { for both cases load vmt }
                     if p^.left^.treetype=typen then
@@ -1004,7 +1008,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  1999-01-06 12:23:29  florian
+  Revision 1.24  1999-01-21 22:10:39  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.23  1999/01/06 12:23:29  florian
     * str(...) for ansi/long and widestrings fixed
 
   Revision 1.22  1998/12/11 23:36:07  florian

compiler/cg386ld.pas

@@ -187,14 +187,17 @@ implementation
                                      end;
                                 end;
                            end;
-                         { in case call by reference, then calculate: }
+                         { in case call by reference, then calculate. Open array
+                           is always an reference! }
                          if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
+                            is_open_array(pvarsym(p^.symtableentry)^.definition) or
                             ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
                              push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
                            begin
                               simple_loadn:=false;
                               if hregister=R_NO then
                                 hregister:=getregister32;
+{$ifdef OLDHIGH}
                               if is_open_array(pvarsym(p^.symtableentry)^.definition) or
                                  is_open_string(pvarsym(p^.symtableentry)^.definition) then
                                 begin
@@ -211,6 +214,7 @@ implementation
                                           p^.location.reference.base,R_EDI)));
                                      end;
                                 end;
+{$endif}
                               if p^.location.loc=LOC_CREGISTER then
                                 begin
                                    exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
@@ -730,7 +734,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  1999-01-20 10:20:18  peter
+  Revision 1.42  1999-01-21 22:10:40  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.41  1999/01/20 10:20:18  peter
     * don't make localvar copies for assembler procedures
 
   Revision 1.40  1998/12/30 13:41:07  peter

compiler/cg386mat.pas

@@ -188,7 +188,7 @@ implementation
          hregister1,hregister2,hregister3,
          hregisterhigh,hregisterlow : tregister;
          pushed,popecx : boolean;
-         op,op2 : tasmop;
+         op : tasmop;
          hr : preference;
 
       begin
@@ -755,7 +755,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  1999-01-19 10:51:32  pierre
+  Revision 1.17  1999-01-21 22:10:41  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.16  1999/01/19 10:51:32  pierre
    * fix to bug0183 in secondnot
 
   Revision 1.15  1998/12/11 16:50:22  florian

compiler/hcodegen.pas

@@ -132,6 +132,10 @@ unit hcodegen;
        { true, if an error while code generation occurs }
        codegenerror : boolean;
 
+       { save the size of pushed parameter, needed for aligning }
+       pushedparasize : longint;
+
+{$ifdef OLDHIGH}
        { this is for open arrays and strings        }
        { but be careful, this data is in the        }
        { generated code destroyed quick, and also   }
@@ -141,6 +145,7 @@ unit hcodegen;
        { provided by this variables                 }
        highframepointer : tregister;
        highoffset : longint;
+{$endif}
 
     { message calls with codegenerror support }
     procedure cgmessage(const t : tmsgconst);
@@ -355,7 +360,11 @@ end.
 
 {
   $Log$
-  Revision 1.24  1998-12-29 18:48:18  jonas
+  Revision 1.25  1999-01-21 22:10:45  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.24  1998/12/29 18:48:18  jonas
     + optimize pascal code surrounding assembler blocks
 
   Revision 1.23  1998/11/27 14:50:38  peter

compiler/symsym.inc

@@ -971,27 +971,34 @@
               case varspez of
                 vs_var :
                   begin
+{$ifdef OLDHIGH}
                     { open arrays push also the high valye }
                     if is_open_array(definition) or
                        is_open_string(definition) then
                       getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
                     else
+{$endif}
                       getpushsize:=target_os.size_of_pointer;
                   end;
                 vs_value,
                 vs_const :
                   begin
                     case definition^.deftype of
+{$ifndef OLDHIGH}
+                      arraydef,
+{$endif OLDHIGH}
                       setdef,
                       stringdef,
                       recorddef,
                       objectdef :
                         getpushsize:=target_os.size_of_pointer;
+{$ifdef OLDHIGH}
                       arraydef :
                         if is_open_array(definition) then
                           getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
                         else
                           getpushsize:=target_os.size_of_pointer;
+{$endif OLDHIGH}
                       else
                         getpushsize:=definition^.size;
                     end;
@@ -1757,7 +1764,11 @@
 
 {
   $Log$
-  Revision 1.69  1999-01-20 10:20:20  peter
+  Revision 1.70  1999-01-21 22:10:48  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.69  1999/01/20 10:20:20  peter
     * don't make localvar copies for assembler procedures
 
   Revision 1.68  1999/01/12 14:25:36  peter

compiler/tccal.pas

@@ -27,6 +27,10 @@ interface
       symtable,tree;
 
 
+{$ifndef OLDHIGH}
+    procedure gen_high_tree(p:ptree;openstring:boolean);
+{$endif}
+
     procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
     procedure firstcalln(var p : ptree);
     procedure firstprocinline(var p : ptree);
@@ -51,6 +55,69 @@ implementation
                              FirstCallParaN
 *****************************************************************************}
 
+{$ifndef OLDHIGH}
+    procedure gen_high_tree(p:ptree;openstring:boolean);
+      var
+        len : longint;
+        st  : psymtable;
+      begin
+        if assigned(p^.hightree) then
+         exit;
+        len:=-1;
+        case p^.left^.resulttype^.deftype of
+          arraydef :
+            begin
+              if is_open_array(p^.left^.resulttype) then
+               begin
+                 st:=p^.left^.symtable;
+                 getsymonlyin(st,'high'+pvarsym(p^.left^.symtableentry)^.name);
+                 p^.hightree:=genloadnode(pvarsym(srsym),st);
+               end
+              else
+               len:=parraydef(p^.left^.resulttype)^.highrange-
+                    parraydef(p^.left^.resulttype)^.lowrange;
+            end;
+          stringdef :
+            begin
+              if openstring then
+               begin
+                 if is_open_string(p^.left^.resulttype) then
+                  begin
+                    st:=p^.left^.symtable;
+                    getsymonlyin(st,'high'+pvarsym(p^.left^.symtableentry)^.name);
+                    p^.hightree:=genloadnode(pvarsym(srsym),st);
+                  end
+                 else
+                  len:=pstringdef(p^.left^.resulttype)^.len;
+               end
+              else
+             { passing a string to an array of char }
+               begin
+                 if (p^.left^.treetype=stringconstn) then
+                   begin
+                     len:=str_length(p^.left);
+                     if len>0 then
+                      dec(len);
+                   end
+                 else
+                   begin
+                     p^.hightree:=gennode(subn,geninlinenode(in_length_string,false,getcopy(p^.left)),
+                                               genordinalconstnode(1,s32bitdef));
+                     firstpass(p^.hightree);
+                     p^.hightree:=gentypeconvnode(p^.hightree,s32bitdef);
+                   end;
+               end;
+           end;
+        else
+          len:=0;
+        end;
+        if len>=0 then
+          p^.hightree:=genordinalconstnode(len,s32bitdef);
+        firstpass(p^.hightree);
+      end;
+{$endif OLDHIGH}
+
+
     procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
       var
         old_array_constructor : boolean;
@@ -91,28 +158,24 @@ implementation
          else
            begin
               if count_ref then
-                 begin
-                    store_valid:=must_be_valid;
-                    if (defcoll^.paratyp=vs_var) then
-                      test_protected(p^.left);
-                    if (defcoll^.paratyp<>vs_var) then
-                      must_be_valid:=true
-                    else
-                      must_be_valid:=false;
-                    { here we must add something for the implicit type }
-                    { conversion from array of char to pchar }
-{                    if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,
-                      p^.left^.treetype,false) then
-                      if convtyp=tc_array_to_pointer then
-                        must_be_valid:=false; }
-                    { only process typeconvn, else it will break other trees }
-                    old_array_constructor:=allow_array_constructor;
-                    allow_array_constructor:=true;
-                    if (p^.left^.treetype=typeconvn) then
-                      firstpass(p^.left);
-                    allow_array_constructor:=old_array_constructor;
-                    must_be_valid:=store_valid;
-                 end;
+               begin
+                 store_valid:=must_be_valid;
+                 if (defcoll^.paratyp=vs_var) then
+                   test_protected(p^.left);
+                 must_be_valid:=(defcoll^.paratyp<>vs_var);
+                 { only process typeconvn, else it will break other trees }
+                 old_array_constructor:=allow_array_constructor;
+                 allow_array_constructor:=true;
+                 if (p^.left^.treetype=typeconvn) then
+                   firstpass(p^.left);
+                 allow_array_constructor:=old_array_constructor;
+                 must_be_valid:=store_valid;
+               end;
+              { generate the high() value tree }
+              if push_high_param(defcoll^.data) then
+{$ifndef OLDHIGH}
+                gen_high_tree(p,is_open_string(defcoll^.data));
+{$endif}
               if not(is_shortstring(p^.left^.resulttype) and
                      is_shortstring(defcoll^.data)) and
                      (defcoll^.data^.deftype<>formaldef) then
@@ -162,10 +225,8 @@ implementation
                       firstpass(p^.left);
                       allow_array_constructor:=old_array_constructor;
                     end;
-                   { don't generate an type conversion for open arrays and
-                     openstring, else we loss the ranges }
-                   if is_open_array(defcoll^.data) or
-                      is_open_string(defcoll^.data) then
+                   { process open parameters }
+                   if push_high_param(defcoll^.data) then
                     begin
                       { insert type conv but hold the ranges of the array }
                       oldtype:=p^.left^.resulttype;
@@ -197,6 +258,7 @@ implementation
                  not(is_open_string(defcoll^.data)) and
                  not(is_equal(p^.left^.resulttype,defcoll^.data)) then
                  CGMessage(type_e_strict_var_string_violation);
+
               { Variablen for call by reference may not be copied }
               { into a register }
               { is this usefull here ? }
@@ -999,7 +1061,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  1999-01-21 16:41:06  pierre
+  Revision 1.21  1999-01-21 22:10:49  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.20  1999/01/21 16:41:06  pierre
    * fix for constructor inside with statements
 
   Revision 1.19  1999/01/19 14:20:16  peter

compiler/tcinl.pas

@@ -287,10 +287,24 @@ implementation
                end;
              in_sizeof_x:
                begin
-                  if p^.registers32<1 then
+{$ifndef OLDHIGH}
+                 if push_high_param(p^.left^.resulttype) then
+                  begin
+                    getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
+                    hp:=gennode(addn,genloadnode(pvarsym(srsym),p^.left^.symtable),
+                                     genordinalconstnode(1,s32bitdef));
+                    if (p^.left^.resulttype^.deftype=arraydef) and
+                       (parraydef(p^.left^.resulttype)^.elesize<>1) then
+                      hp:=gennode(muln,hp,genordinalconstnode(parraydef(p^.left^.resulttype)^.elesize,s32bitdef));
+                    disposetree(p);
+                    p:=hp;
+                    firstpass(p);
+                  end;
+{$endif OLDHIGH}
+                 if p^.registers32<1 then
                     p^.registers32:=1;
-                  p^.resulttype:=s32bitdef;
-                  p^.location.loc:=LOC_REGISTER;
+                 p^.resulttype:=s32bitdef;
+                 p^.location.loc:=LOC_REGISTER;
                end;
              in_typeof_x:
                begin
@@ -530,7 +544,11 @@ implementation
                                                   if assigned(hp^.right) then
                                                    CGMessage(type_e_cant_read_write_type);
                                                 end;
-                                    stringdef : ;
+                                    stringdef : begin
+                                                  { generate the high() value for the string }
+                                                  if not dowrite then
+                                                    gen_high_tree(hp,true);
+                                                end;
                                    pointerdef : begin
                                                   if not is_equal(ppointerdef(hp^.left^.resulttype)^.definition,cchardef) then
                                                     CGMessage(type_e_cant_read_write_type);
@@ -670,6 +688,9 @@ implementation
                      (hp^.right=nil) or
                      (hp^.left^.location.loc<>LOC_REFERENCE) then
                     CGMessage(cg_e_illegal_expression);
+                  { generate the high() value for the string }
+                  gen_high_tree(hp,true);
+
                   { !!!! check length of string }
 
                   while assigned(hp^.right) do
@@ -806,9 +827,17 @@ implementation
                                begin
                                  if is_open_array(p^.left^.resulttype) then
                                   begin
+{$ifndef OLDHIGH}
+                                    getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
+                                    hp:=genloadnode(pvarsym(srsym),p^.left^.symtable);
+                                    disposetree(p);
+                                    p:=hp;
+                                    firstpass(p);
+{$else OLDHIGH}
                                     p^.resulttype:=s32bitdef;
                                     p^.registers32:=max(1,p^.registers32);
                                     p^.location.loc:=LOC_REGISTER;
+{$endif OLDHIGH}
                                   end
                                  else
                                   begin
@@ -832,9 +861,17 @@ implementation
                                begin
                                  if is_open_string(p^.left^.resulttype) then
                                   begin
+{$ifndef OLDHIGH}
+                                    getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
+                                    hp:=genloadnode(pvarsym(srsym),p^.left^.symtable);
+                                    disposetree(p);
+                                    p:=hp;
+                                    firstpass(p);
+{$else OLDHIGH}
                                     p^.resulttype:=s32bitdef;
                                     p^.registers32:=max(1,p^.registers32);
                                     p^.location.loc:=LOC_REGISTER;
+{$endif OLDHIGH}
                                   end
                                  else
                                   begin
@@ -893,7 +930,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  1998-12-30 22:13:13  peter
+  Revision 1.14  1999-01-21 22:10:50  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.13  1998/12/30 22:13:13  peter
     * check the amount of paras for Str()
 
   Revision 1.12  1998/12/15 10:23:31  peter

compiler/tree.pas

@@ -235,7 +235,7 @@ unit tree;
 {$endif extdebug}
           case treetype : ttreetyp of
              addn : (use_strconcat : boolean;string_typ : tstringtype);
-             callparan : (is_colon_para : boolean;exact_match_found : boolean);
+             callparan : (is_colon_para : boolean;exact_match_found : boolean;hightree:ptree);
              assignn : (assigntyp : tassigntyp;concat_string : boolean);
              loadn : (symtableentry : psym;symtable : psymtable;
                       is_absolute,is_first,is_methodpointer : boolean);
@@ -1663,7 +1663,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.61  1999-01-21 16:41:09  pierre
+  Revision 1.62  1999-01-21 22:10:52  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.61  1999/01/21 16:41:09  pierre
    * fix for constructor inside with statements
 
   Revision 1.60  1998/12/15 11:52:19  peter

compiler/types.pas

@@ -91,6 +91,8 @@ unit types;
     { true, if def is a 64 bit int type }
     function is_64bitint(def : pdef) : boolean;
 
+    function push_high_param(def : pdef) : boolean;
+
     { true if a parameter is too large to copy and only the address is pushed }
     function push_addr_param(def : pdef) : boolean;
 
@@ -376,6 +378,13 @@ unit types;
            ((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
       end;
 
+
+    function push_high_param(def : pdef) : boolean;
+      begin
+         push_high_param:=is_open_array(def) or is_open_string(def);
+      end;
+
+
     { true if a parameter is too large to copy and only the address is pushed }
     function push_addr_param(def : pdef) : boolean;
       begin
@@ -1047,7 +1056,11 @@ unit types;
 end.
 {
   $Log$
-  Revision 1.45  1999-01-20 12:34:22  peter
+  Revision 1.46  1999-01-21 22:10:54  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.45  1999/01/20 12:34:22  peter
     * fixed typed file read/write
 
   Revision 1.44  1999/01/15 11:33:03  pierre