Browse Source

* merged fixes

peter 25 years ago
parent
commit
c5da6c53fd
6 changed files with 127 additions and 98 deletions
  1. 21 23
      compiler/cg386set.pas
  2. 26 27
      compiler/pdecl.pas
  3. 15 5
      compiler/psub.pas
  4. 59 41
      compiler/ptype.pas
  5. 6 2
      compiler/ra386int.pas
  6. BIN
      compiler/tokens.dat

+ 21 - 23
compiler/cg386set.pas

@@ -632,6 +632,14 @@ implementation
 
         procedure genitem(t : pcaserecord);
 
+            procedure gensub(value:longint);
+            begin
+              if value=1 then
+                emit_reg(A_DEC,opsize,hregister)
+              else
+                emit_const_reg(A_SUB,opsize,value,hregister);
+            end;
+
           begin
              if assigned(t^.less) then
                genitem(t^.less);
@@ -643,12 +651,10 @@ implementation
                end;
              if t^._low=t^._high then
                begin
-                  if t^._low-last=1 then
-                    emit_reg(A_DEC,opsize,hregister)
-                  else if t^._low-last=0 then
+                  if t^._low-last=0 then
                     emit_reg_reg(A_OR,opsize,hregister,hregister)
                   else
-                    emit_const_reg(A_SUB,opsize,t^._low-last,hregister);
+                    gensub(t^._low-last);
                   last:=t^._low;
                   emitjmp(C_Z,t^.statement);
                end
@@ -661,29 +667,18 @@ implementation
                     begin
                        { have we to ajust the first value ? }
                        if t^._low>get_min_value(p^.left^.resulttype) then
-                         begin
-                            if t^._low=1 then
-                              emit_reg(A_DEC,opsize,
-                                hregister)
-                            else
-                              emit_const_reg(A_SUB,opsize,
-                                t^._low,hregister);
-                         end;
+                         gensub(t^._low);
                     end
                   else
-                  { if there is no unused label between the last and the }
-                  { present label then the lower limit can be checked    }
-                  { immediately. else check the range in between:       }
-                  if (t^._low-last>1) then
                     begin
-                       emit_const_reg(A_SUB,opsize,t^._low-last,hregister);
-                       emitjmp(jmp_le,elselabel);
-                    end
-                  else
-                    emit_reg(A_DEC,opsize,hregister);
+                      { if there is no unused label between the last and the }
+                      { present label then the lower limit can be checked    }
+                      { immediately. else check the range in between:       }
+                      emit_const_reg(A_SUB,opsize,t^._low-last,hregister);
+                      emitjmp(jmp_le,elselabel);
+                    end;
                   emit_const_reg(A_SUB,opsize,t^._high-t^._low,hregister);
                   emitjmp(jmp_lee,t^.statement);
-
                   last:=t^._high;
                end;
              first:=false;
@@ -969,7 +964,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-07-27 09:25:05  jonas
+  Revision 1.4  2000-07-30 17:04:43  peter
+    * merged fixes
+
+  Revision 1.3  2000/07/27 09:25:05  jonas
     * moved locflags2reg() procedure from cg386add to cgai386
     + added locjump2reg() procedure to cgai386
     * fixed internalerror(2002) when the result of a case expression has

+ 26 - 27
compiler/pdecl.pas

@@ -99,36 +99,32 @@ unit pdecl;
               varspez:=vs_value;
           inserthigh:=false;
           tt.reset;
-          if idtoken=_SELF then
+          { self is only allowed in procvars and class methods }
+          if (idtoken=_SELF) and
+             (is_procvar or
+              (assigned(procinfo^._class) and procinfo^._class^.is_class)) then
             begin
-               { only allowed in procvars and class methods }
-               if is_procvar or
-                  (assigned(procinfo^._class) and procinfo^._class^.is_class) then
-                begin
-                  if not is_procvar then
-                   begin
+              if not is_procvar then
+               begin
 {$ifndef UseNiceNames}
-                     hs2:=hs2+'$'+'self';
+                 hs2:=hs2+'$'+'self';
 {$else UseNiceNames}
-                     hs2:=hs2+tostr(length('self'))+'self';
+                 hs2:=hs2+tostr(length('self'))+'self';
 {$endif UseNiceNames}
-                     vs:=new(Pvarsym,initdef('@',procinfo^._class));
-                     vs^.varspez:=vs_var;
-                   { insert the sym in the parasymtable }
-                     pprocdef(aktprocdef)^.parast^.insert(vs);
-                     include(aktprocdef^.procoptions,po_containsself);
-                     inc(procinfo^.selfpointer_offset,vs^.address);
-                   end;
-                  consume(idtoken);
-                  consume(_COLON);
-                  single_type(tt,hs1,false);
-                  aktprocdef^.concatpara(tt,vs_value);
-                  { check the types for procedures only }
-                  if not is_procvar then
-                   CheckTypes(tt.def,procinfo^._class);
-                end
-               else
-                consume(_ID);
+                 vs:=new(Pvarsym,initdef('@',procinfo^._class));
+                 vs^.varspez:=vs_var;
+               { insert the sym in the parasymtable }
+                 pprocdef(aktprocdef)^.parast^.insert(vs);
+                 include(aktprocdef^.procoptions,po_containsself);
+                 inc(procinfo^.selfpointer_offset,vs^.address);
+               end;
+              consume(idtoken);
+              consume(_COLON);
+              single_type(tt,hs1,false);
+              aktprocdef^.concatpara(tt,vs_value);
+              { check the types for procedures only }
+              if not is_procvar then
+               CheckTypes(tt.def,procinfo^._class);
             end
           else
             begin
@@ -1232,7 +1228,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.4  2000-07-14 05:11:49  michael
+  Revision 1.5  2000-07-30 17:04:43  peter
+    * merged fixes
+
+  Revision 1.4  2000/07/14 05:11:49  michael
   + Patch to 1.1
 
   Revision 1.3  2000/07/13 12:08:26  michael

+ 15 - 5
compiler/psub.pas

@@ -1252,9 +1252,17 @@ begin
               if (po_overload in pd^.procoptions) or
                  (po_overload in hd^.procoptions) then
                begin
-                 if not((po_overload in pd^.procoptions) and
-                        (po_overload in hd^.procoptions)) then
-                  Message1(parser_e_no_overload_for_all_procs,aktprocsym^.name);
+                 { one a forwarddef and the other not then the not may not have
+                   the directive as in D5 (PFV) }
+                 if hd^.forwarddef and (not pd^.forwarddef) then
+                  begin
+                    if (po_overload in pd^.procoptions) then
+                     Message1(parser_e_proc_dir_not_allowed_in_implementation,'OVERLOAD');
+                  end
+                 else
+                  if not((po_overload in pd^.procoptions) and
+                         ((po_overload in hd^.procoptions))) then
+                   Message1(parser_e_no_overload_for_all_procs,aktprocsym^.name);
                end
               else
                begin
@@ -2058,10 +2066,12 @@ end.
 
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:27  michael
+  Revision 1.4  2000-07-30 17:04:43  peter
+    * merged fixes
+
+  Revision 1.3  2000/07/13 12:08:27  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:46  michael
   + removed logs
-
 }

+ 59 - 41
compiler/ptype.pas

@@ -1338,6 +1338,28 @@ uses
           lowval,
           highval   : longint;
           arraytype : pdef;
+          ht        : ttype;
+
+          procedure setdefdecl(p:pdef);
+          begin
+            case p^.deftype of
+              enumdef :
+                begin
+                  lowval:=penumdef(p)^.min;
+                  highval:=penumdef(p)^.max;
+                  arraytype:=p;
+                end;
+              orddef :
+                begin
+                  lowval:=porddef(p)^.low;
+                  highval:=porddef(p)^.high;
+                  arraytype:=p;
+                end;
+              else
+                Message(sym_e_error_in_type_def);
+            end;
+          end;
+
         begin
            consume(_ARRAY);
            consume(_LECKKLAMMER);
@@ -1347,51 +1369,44 @@ uses
            highval:=$7fffffff;
            tt.reset;
            repeat
-             { read the expression and check it }
-             pt:=expr;
-             if pt^.treetype=typen then
-               begin
-                 case pt^.resulttype^.deftype of
-                   enumdef :
-                     begin
-                       lowval:=penumdef(pt^.resulttype)^.min;
-                       highval:=penumdef(pt^.resulttype)^.max;
-                       arraytype:=pt^.resulttype;
-                     end;
-                   orddef :
-                     begin
-                       lowval:=porddef(pt^.resulttype)^.low;
-                       highval:=porddef(pt^.resulttype)^.high;
-                       arraytype:=pt^.resulttype;
-                     end;
-                   else
-                     Message(sym_e_error_in_type_def);
-                 end;
-               end
+             { read the expression and check it, check apart if the
+               declaration is an enum declaration because that needs to
+               be parsed by readtype (PFV) }
+             if token=_LKLAMMER then
+              begin
+                read_type(ht,'');
+                setdefdecl(ht.def);
+              end
              else
-               begin
-                  do_firstpass(pt);
-                  if (pt^.treetype=rangen) then
-                   begin
-                     if (pt^.left^.treetype=ordconstn) and
-                        (pt^.right^.treetype=ordconstn) then
+              begin
+                pt:=expr;
+                if pt^.treetype=typen then
+                 setdefdecl(pt^.resulttype)
+                else
+                  begin
+                     do_firstpass(pt);
+                     if (pt^.treetype=rangen) then
                       begin
-                        lowval:=pt^.left^.value;
-                        highval:=pt^.right^.value;
-                        if highval<lowval then
+                        if (pt^.left^.treetype=ordconstn) and
+                           (pt^.right^.treetype=ordconstn) then
                          begin
-                           Message(parser_e_array_lower_less_than_upper_bound);
-                           highval:=lowval;
-                         end;
-                        arraytype:=pt^.right^.resulttype;
+                           lowval:=pt^.left^.value;
+                           highval:=pt^.right^.value;
+                           if highval<lowval then
+                            begin
+                              Message(parser_e_array_lower_less_than_upper_bound);
+                              highval:=lowval;
+                            end;
+                           arraytype:=pt^.right^.resulttype;
+                         end
+                        else
+                         Message(type_e_cant_eval_constant_expr);
                       end
                      else
-                      Message(type_e_cant_eval_constant_expr);
-                   end
-                  else
-                   Message(sym_e_error_in_type_def)
-               end;
-             disposetree(pt);
+                      Message(sym_e_error_in_type_def)
+                  end;
+                disposetree(pt);
+              end;
 
            { create arraydef }
              if not assigned(tt.def) then
@@ -1578,7 +1593,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:27  michael
+  Revision 1.4  2000-07-30 17:04:43  peter
+    * merged fixes
+
+  Revision 1.3  2000/07/13 12:08:27  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:47  michael

+ 6 - 2
compiler/ra386int.pas

@@ -1167,7 +1167,8 @@ Begin
 
       AS_REGISTER :
         begin
-          if (not GotPlus) and (not GotStar) then
+          if not((GotPlus and (not Negative)) or
+                 GotStar) then
             Message(asmr_e_invalid_reference_syntax);
           hreg:=actasmregister;
           Consume(AS_REGISTER);
@@ -1902,7 +1903,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:48  michael
+  Revision 1.3  2000-07-30 17:04:43  peter
+    * merged fixes
+
+  Revision 1.2  2000/07/13 11:32:48  michael
   + removed logs
 
 }

BIN
compiler/tokens.dat