Przeglądaj źródła

* recordtype.field support in constant expressions
* fixed imul for oa_imm8 which was not allowed
* fixed reading of local typed constants
* fixed comment reading which is not any longer a separator

peter 27 lat temu
rodzic
commit
d84489d9b7
7 zmienionych plików z 435 dodań i 431 usunięć
  1. 117 234
      compiler/asmutils.pas
  2. 9 2
      compiler/i386.pas
  3. 1 0
      compiler/msgidx.inc
  4. 68 67
      compiler/msgtxt.inc
  5. 113 93
      compiler/ra386att.pas
  6. 109 26
      compiler/ra386int.pas
  7. 18 9
      compiler/scanner.pas

+ 117 - 234
compiler/asmutils.pas

@@ -268,10 +268,9 @@ Type
   {                     Symbol helper routines                          }
   {---------------------------------------------------------------------}
 
-  Function GetTypeOffset(var Instr: TInstruction; const base: string; const field: string;
-    Var Offset: longint; operandnum: byte):boolean;
-  Function GetVarOffset(var Instr: TInstruction;const base: string; const field: string;
-    Var Offset: longint; operandnum: byte):boolean;
+  Procedure SetOperandSize(var instr:TInstruction;operandnum,size:longint);
+  Function GetVarOffsetSize(const base,field:string;Var Offset: longint;var Size:longint):boolean;
+  Function GetTypeOffsetSize(const base,field: string;Var Offset: longint;var Size:longint):boolean;
   Function SearchIConstant(const s:string; var l:longint): boolean;
   Function SearchLabel(const s: string; var hl: plabel): boolean;
   Function CreateVarInstr(var Instr: TInstruction; const hs:string;
@@ -1000,13 +999,17 @@ end;
     getsym(s,false);
     if srsym <> nil then
      Begin
-       if (srsym^.typ=constsym) and
-          (pconstsym(srsym)^.consttype in [constord,constint,constchar,constbool]) then
-        Begin
-          l:=pconstsym(srsym)^.value;
-          SearchIConstant := TRUE;
-          exit;
-        end;
+       case srsym^.typ of
+         constsym :
+           begin
+             if (pconstsym(srsym)^.consttype in [constord,constint,constchar,constbool]) then
+              Begin
+                l:=pconstsym(srsym)^.value;
+                SearchIConstant := TRUE;
+                exit;
+              end;
+           end;
+       end;
      end;
   end;
 
@@ -1043,18 +1046,39 @@ end;
 {$endif i386}
 
 
+  Procedure SetOperandSize(var instr:TInstruction;operandnum,size:longint);
+  begin
+    { the current size is NOT overriden if it already }
+    { exists, such as in the case of a byte ptr, in   }
+    { front of the identifier.                        }
+    if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
+    Begin
+      case size of
+       1: instr.operands[operandnum].size := S_B;
+       2: instr.operands[operandnum].size := S_W{ could be S_IS};
+       4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
+       8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
+       extended_size: instr.operands[operandnum].size := S_FX;
+      else
+       { this is in the case where the instruction is LEA }
+       { or something like that, in that case size is not }
+       { important.                                       }
+        instr.operands[operandnum].size := S_NO;
+      end; { end case }
+    end;
+  end;
 
-  Function GetVarOffset(var Instr: TInstruction;const base: string; const field: string;
-    Var Offset: longint; operandnum: byte):boolean;
-  { search and returns the offset of records/objects of the base }
+
+  Function GetVarOffsetSize(const base,field:string;Var Offset: longint;var Size:longint):boolean;
+  { search and returns the offset and size of records/objects of the base }
   { with field name setup in field.                              }
-  { returns FALSE if not found.                                      }
+  { returns FALSE if not found.                                  }
   { used when base is a variable or a typed constant name.       }
    var
     sym:psym;
     p: psym;
   Begin
-     GetVarOffset := FALSE;
+     GetVarOffsetSize := FALSE;
      Offset := 0;
      { local list }
      if assigned(aktprocsym) then
@@ -1072,25 +1096,8 @@ end;
              if assigned(pvarsym(p)) then
              Begin
                 Offset := pvarsym(p)^.address;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
-                GetVarOffset := TRUE;
+                Size:=PVarsym(p)^.getsize;
+                GetVarOffsetSize := TRUE;
                 Exit;
              end;
           end
@@ -1103,26 +1110,9 @@ end;
                   if assigned(pvarsym(p)) then
                     Begin
                       Offset := pvarsym(p)^.address;
-                      { the current size is NOT overriden if it already }
-                      { exists, such as in the case of a byte ptr, in   }
-                      { front of the identifier.                        }
-                      if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                        Begin
-                          case pvarsym(p)^.getsize of
-                          1: instr.operands[operandnum].size := S_B;
-                          2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                          4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                          8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                         extended_size: instr.operands[operandnum].size := S_FX;
-                         else
-                         { this is in the case where the instruction is LEA }
-                         { or something like that, in that case size is not }
-                         { important.                                       }
-                           instr.operands[operandnum].size := S_NO;
-                         end; { end case }
-                       end;
-                     GetVarOffset := TRUE;
-                     Exit;
+                      Size:=PVarsym(p)^.getsize;
+                      GetVarOffsetSize := TRUE;
+                      Exit;
                     end;
                end;
           end;
@@ -1131,7 +1121,7 @@ end;
        begin
         { field of local record parameter to routine. }
          if assigned(aktprocsym^.definition^.parast) then
-            sym:=aktprocsym^.definition^.parast^.search(base)
+           sym:=aktprocsym^.definition^.parast^.search(base)
          else
            sym:=nil;
          if assigned(sym) then
@@ -1143,25 +1133,8 @@ end;
              if assigned(p) then
              Begin
                 Offset := pvarsym(p)^.address;
-                GetVarOffset := TRUE;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
+                Size:=PVarsym(p)^.getsize;
+                GetVarOffsetSize := TRUE;
                 Exit;
              end;
            end { endif }
@@ -1174,26 +1147,9 @@ end;
                   if assigned(pvarsym(p)) then
                     Begin
                       Offset := pvarsym(p)^.address;
-                      { the current size is NOT overriden if it already }
-                      { exists, such as in the case of a byte ptr, in   }
-                      { front of the identifier.                        }
-                      if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                        Begin
-                          case pvarsym(p)^.getsize of
-                          1: instr.operands[operandnum].size := S_B;
-                          2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                          4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                          8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                         extended_size: instr.operands[operandnum].size := S_FX;
-                         else
-                         { this is in the case where the instruction is LEA }
-                         { or something like that, in that case size is not }
-                         { important.                                       }
-                           instr.operands[operandnum].size := S_NO;
-                         end; { end case }
-                       end;
-                     GetVarOffset := TRUE;
-                     Exit;
+                      Size:=PVarsym(p)^.getsize;
+                      GetVarOffsetSize := TRUE;
+                      Exit;
                     end;
                end;
           end;
@@ -1213,25 +1169,8 @@ end;
              if assigned(p) then
              Begin
                 Offset := pvarsym(p)^.address;
-                GetVarOffset := TRUE;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
+                Size:=PVarsym(p)^.getsize;
+                GetVarOffsetSize := TRUE;
                 Exit;
              end;
           end
@@ -1244,25 +1183,8 @@ end;
              if assigned(p) then
              Begin
                 Offset := pvarsym(p)^.address;
-                GetVarOffset := TRUE;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
+                Size:=PVarsym(p)^.getsize;
+                GetVarOffsetSize := TRUE;
                 Exit;
              end;
           end
@@ -1275,26 +1197,9 @@ end;
                   if assigned(pvarsym(p)) then
                     Begin
                       Offset := pvarsym(p)^.address;
-                      { the current size is NOT overriden if it already }
-                      { exists, such as in the case of a byte ptr, in   }
-                      { front of the identifier.                        }
-                      if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                        Begin
-                          case pvarsym(p)^.getsize of
-                          1: instr.operands[operandnum].size := S_B;
-                          2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                          4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                          8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                         extended_size: instr.operands[operandnum].size := S_FX;
-                         else
-                         { this is in the case where the instruction is LEA }
-                         { or something like that, in that case size is not }
-                         { important.                                       }
-                           instr.operands[operandnum].size := S_NO;
-                         end; { end case }
-                       end;
-                     GetVarOffset := TRUE;
-                     Exit;
+                      Size:=PVarsym(p)^.getsize;
+                      GetVarOffsetSize := TRUE;
+                      Exit;
                     end;
                end;
           end;
@@ -1303,8 +1208,7 @@ end;
 
 
 
-  Function GetTypeOffset(var instr: TInstruction; const base: string; const field: string;
-    Var Offset: longint; operandnum: byte):boolean;
+  Function GetTypeOffsetSize(const base,field: string;Var Offset: longint;var Size:longint):boolean;
   { search and returns the offset of records/objects of the base }
   { with field name setup in field.                              }
   { returns 0 if not found.                                      }
@@ -1314,7 +1218,7 @@ end;
     p: psym;
   Begin
      Offset := 0;
-     GetTypeOffset := FALSE;
+     GetTypeOffsetSize := FALSE;
      { local list }
      if assigned(aktprocsym) then
      begin
@@ -1331,25 +1235,8 @@ end;
              if assigned(p) then
              Begin
                 Offset := pvarsym(p)^.address;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
-                GetTypeOffset := TRUE;
+                Size:=PVarsym(p)^.getsize;
+                GetTypeOffsetSize := TRUE;
                 Exit;
              end;
           end;
@@ -1370,25 +1257,7 @@ end;
              if assigned(p) then
              Begin
                 Offset := pvarsym(p)^.address;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
-                GetTypeOffset := TRUE;
+                GetTypeOffsetSize := TRUE;
                 Exit;
              end;
            end; { endif }
@@ -1408,25 +1277,8 @@ end;
              if assigned(p) then
              Begin
                 Offset := pvarsym(p)^.address;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
-                GetTypeOffset := TRUE;
+                Size:=PVarsym(p)^.getsize;
+                GetTypeOffsetSize := TRUE;
                 Exit;
              end
           end
@@ -1440,25 +1292,8 @@ end;
                if assigned(p) then
                Begin
                   Offset := pvarsym(p)^.address;
-                { the current size is NOT overriden if it already }
-                { exists, such as in the case of a byte ptr, in   }
-                { front of the identifier.                        }
-                if instr.operands[operandnum].size = S_NO then
-                Begin
-                  case pvarsym(p)^.getsize of
-                   1: instr.operands[operandnum].size := S_B;
-                   2: instr.operands[operandnum].size := S_W{ could be S_IS};
-                   4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
-                   8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
-                   extended_size: instr.operands[operandnum].size := S_FX;
-                  else
-                   { this is in the case where the instruction is LEA }
-                   { or something like that, in that case size is not }
-                   { important.                                       }
-                    instr.operands[operandnum].size := S_NO;
-                  end; { end case }
-                end;
-                  GetTypeOffset := TRUE;
+                  Size:=PVarsym(p)^.getsize;
+                  GetTypeOffsetSize := TRUE;
                   Exit;
                end
              end;
@@ -1487,7 +1322,6 @@ end;
        if assigned(sym) then
         begin
           case sym^.typ of
-  typedconstsym,
          varsym : begin
                     { we always assume in asm statements that     }
                     { that the variable is valid.                 }
@@ -1525,6 +1359,31 @@ end;
                     CreateVarInstr := TRUE;
                     Exit;
                   end;
+  typedconstsym : begin
+                    { we always assume in asm statements that     }
+                    { that the variable is valid.                 }
+                    if assigned(instr.operands[operandnum].ref.symbol) then
+                      FreeMem(instr.operands[operandnum].ref.symbol,length(instr.operands[operandnum].ref.symbol^)+1);
+                    instr.operands[operandnum].ref.symbol:=newpasstr(pvarsym(sym)^.mangledname);
+                   { the current size is NOT overriden if it already }
+                   { exists, such as in the case of a byte ptr, in   }
+                   { front of the identifier.                        }
+                   if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
+                    Begin
+                      case ptypedconstsym(sym)^.getsize of
+                       1: instr.operands[operandnum].size := S_B;
+                       2: instr.operands[operandnum].size := S_W{ could be S_IS};
+                       4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
+                       8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
+                       extended_size: instr.operands[operandnum].size := S_FX;
+                      else
+                        instr.operands[operandnum].size := S_NO;
+                      end; { end case }
+                    end;
+                    { ok, finished for this var }
+                    CreateVarInstr := TRUE;
+                    Exit;
+                  end;
        constsym : begin
                     if pconstsym(sym)^.consttype in [constint,constchar,constbool] then
                      begin
@@ -1534,6 +1393,15 @@ end;
                        Exit;
                      end;
                   end;
+        typesym : begin
+                    if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
+                     begin
+                       instr.operands[operandnum].operandtype:=OPR_CONSTANT;
+                       instr.operands[operandnum].val:=0;
+                       CreateVarInstr := TRUE;
+                       Exit;
+                     end;
+                  end;
         procsym : begin
                     { free the memory before changing the symbol name. }
                     if assigned(instr.operands[operandnum].ref.symbol) then
@@ -1653,6 +1521,15 @@ end;
                        Exit;
                      end;
                   end;
+        typesym : begin
+                    if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
+                     begin
+                       instr.operands[operandnum].operandtype:=OPR_CONSTANT;
+                       instr.operands[operandnum].val:=0;
+                       CreateVarInstr := TRUE;
+                       Exit;
+                     end;
+                  end;
         procsym : begin
                     if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
                      Message(assem_w_calling_overload_func);
@@ -1902,7 +1779,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  1998-10-28 00:08:45  peter
+  Revision 1.14  1998-11-05 23:48:17  peter
+    * recordtype.field support in constant expressions
+    * fixed imul for oa_imm8 which was not allowed
+    * fixed reading of local typed constants
+    * fixed comment reading which is not any longer a separator
+
+  Revision 1.13  1998/10/28 00:08:45  peter
     + leal procsym,eax is now allowed
     + constants are now handled also when starting an expression
     + call *pointer is now allowed

+ 9 - 2
compiler/i386.pas

@@ -568,7 +568,8 @@ unit i386;
          (i : A_IMUL;ops : 3;oc : $69;eb : ao_none;m : Modrm or af_reverseregregmem;o1 : ao_imm16 or ao_imm32;
            o2 : ao_wordreg or ao_mem;o3 : ao_wordreg),
          (i : A_IMUL;ops : 2;oc : $6b;eb : ao_none;m : Modrm or imulKludge;o1 : ao_imm8s;o2 : ao_wordreg;o3 : 0),
-         (i : A_IMUL;ops : 2;oc : $69;eb : ao_none;m : Modrm or imulKludge;o1 : ao_imm16 or ao_imm32;o2 : ao_wordreg;o3 : 0),
+         (i : A_IMUL;ops : 2;oc : $69;eb : ao_none;m : Modrm or imulKludge;o1 : ao_imm8 or ao_imm16 or ao_imm32;
+           o2 : ao_wordreg;o3 : 0),
          (i : A_DIV;ops : 1;oc : $f6;eb : 6;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : 0;o3 : 0),
          (i : A_DIV;ops : 2;oc : $f6;eb : 6;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : ao_acc;o3 : 0),
          (i : A_IDIV;ops : 1;oc : $f6;eb : 7;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : 0;o3 : 0),
@@ -1724,7 +1725,13 @@ unit i386;
 end.
 {
   $Log$
-  Revision 1.14  1998-10-28 00:08:47  peter
+  Revision 1.15  1998-11-05 23:48:20  peter
+    * recordtype.field support in constant expressions
+    * fixed imul for oa_imm8 which was not allowed
+    * fixed reading of local typed constants
+    * fixed comment reading which is not any longer a separator
+
+  Revision 1.14  1998/10/28 00:08:47  peter
     + leal procsym,eax is now allowed
     + constants are now handled also when starting an expression
     + call *pointer is now allowed

+ 1 - 0
compiler/msgidx.inc

@@ -398,6 +398,7 @@ type tmsgconst=(
   assem_f_too_many_asm_files,
   assem_f_assembler_output_not_supported,
   assem_e_unsupported_symbol_type,
+  assem_e_cannot_index_relative_var,
   exec_w_source_os_redefined,
   exec_i_assembling_pipe,
   exec_d_cant_create_asmfile,

+ 68 - 67
compiler/msgtxt.inc

@@ -1,4 +1,4 @@
-const msgtxt : array[0..00094,1..240] of char=(+
+const msgtxt : array[0..00094,1..240] of char=(
   'T_Compiler: $1'#000+
   'D_Source OS: $1'#000+
   'I_Target OS: $1'#000+
@@ -412,33 +412,34 @@ const msgtxt : array[0..00094,1..240] of char=(+
   'F_Too many assembler files'#000+
   'F_Selected assembler',' output not supported'#000+
   'E_Unsupported symbol type for operand'#000+
+  'E_Cannot index a local var or parameter with a register'#000+
   'W_Source operating system redefined'#000+
   'I_Assembling (pipe) $1'#000+
   'E_Can'#039't create assember file $1'#000+
-  'W_Assembler $1 not found, switching to external assembling'#000+
+  'W_Assembler $1 not found, switchi','ng to external assembling'#000+
   'T_Using assembler: $1'#000+
-  'W_Error ','while assembling exitcode $1'#000+
+  'W_Error while assembling exitcode $1'#000+
   'W_Can'#039't call the assembler, error $1 switching to external assembl'+
   'ing'#000+
   'I_Assembling $1'#000+
   'W_Linker $1 not found, switching to external linking'#000+
-  'T_Using linker: $1'#000+
+  'T_Using linker: ','$1'#000+
   'W_Object $1 not found, Linking may fail !'#000+
-  'W_Library $','1 not found, Linking may fail !'#000+
+  'W_Library $1 not found, Linking may fail !'#000+
   'W_Error while linking'#000+
   'W_Can'#039't call the linker, switching to external linking'#000+
   'I_Linking $1'#000+
   'W_binder not found, switching to external binding'#000+
-  'W_ar not found, switching to external ar'#000+
-  'E_Dynamic Libraries not sup','ported'#000+
+  'W_ar not fou','nd, switching to external ar'#000+
+  'E_Dynamic Libraries not supported'#000+
   'I_Closing script $1'#000+
   'F_Can'#039't post process executable $1'#000+
   'F_Can'#039't open executable $1'#000+
   'X_Size of Code: $1 bytes'#000+
   'X_Size of initialized data: $1 bytes'#000+
-  'X_Size of uninitialized data: $1 bytes'#000+
+  'X_Size of uninitialized data: $1 ','bytes'#000+
   'X_Stack space reserved: $1 bytes'#000+
-  'X_Stack space com','mited: $1 bytes'#000+
+  'X_Stack space commited: $1 bytes'#000+
   'T_Unitsearch: $1'#000+
   'T_PPU Loading $1'#000+
   'U_PPU Name: $1'#000+
@@ -447,8 +448,8 @@ const msgtxt : array[0..00094,1..240] of char=(+
   'U_PPU Time: $1'#000+
   'U_PPU File too short'#000+
   'U_PPU Invalid Header (no PPU at the begin)'#000+
-  'U_PPU Invalid Version $1'#000+
-  'U_PPU is compiled for an other processor'#000,+
+  'U_PPU Inva','lid Version $1'#000+
+  'U_PPU is compiled for an other processor'#000+
   'U_PPU is compiled for an other target'#000+
   'U_PPU Source: $1'#000+
   'U_Writing $1'#000+
@@ -456,181 +457,181 @@ const msgtxt : array[0..00094,1..240] of char=(+
   'F_reading PPU-File'#000+
   'F_unexpected end of PPU-File'#000+
   'F_Invalid PPU-File entry: $1'#000+
-  'F_PPU Dbx count problem'#000+
+  'F_PPU Dbx count ','problem'#000+
   'E_Illegal unit name: $1'#000+
   'F_Too much units'#000+
-  'F_Circu','lar unit reference between $1 and $2'#000+
+  'F_Circular unit reference between $1 and $2'#000+
   'F_Can'#039't compile unit $1, no sources available'#000+
   'W_Compiling the system unit requires the -Us switch'#000+
-  'F_There were $1 errors compiling module, stopping'#000+
+  'F_There were $1 errors compiling module, stopping',#000+
   'U_Load from $1 ($2) unit $3'#000+
-  'U_Recompiling $1, checksum ','changed for $2'#000+
+  'U_Recompiling $1, checksum changed for $2'#000+
   'U_Recompiling unit, static lib is older than ppufile'#000+
   'U_Recompiling unit, shared lib is older than ppufile'#000+
   'U_Recompiling unit, obj and asm are older than ppufile'#000+
-  'U_Recompiling unit, obj is older than asm'#000+
-  'U_Parsing interface of',' $1'#000+
+  'U_Recomp','iling unit, obj is older than asm'#000+
+  'U_Parsing interface of $1'#000+
   'U_Parsing implementation of $1'#000+
   'U_Second load for unit $1'#000+
   'U_PPU Check file $1 time $2'#000+
   '$1 [options] <inputfile> [options]'#000+
   'W_Only one source file supported'#000+
-  'W_DEF file can be created only for OS/2'#000+
+  'W_DEF file can be created o','nly for OS/2'#000+
   'E_nested response files are not supported'#000+
-  'F','_No source file name in command line'#000+
+  'F_No source file name in command line'#000+
   'E_Illegal parameter: $1'#000+
   'H_-? writes help pages'#000+
   'F_Too many config files nested'#000+
   'F_Unable to open file $1'#000+
   'N_Reading further options from $1'#000+
-  'W_Target is already set to: $1'#000+
-  'W_Shared libs not supported on DOS ','platform, reverting to static'#000+
+  'W_Target i','s already set to: $1'#000+
+  'W_Shared libs not supported on DOS platform, reverting to static'#000+
   'F_too many IF(N)DEFs'#000+
   'F_too many ENDIFs'#000+
   'F_open conditional at the end of the file'#000+
   'W_Debug information generation is not supported by this executable'#000+
-  'H_Try recompiling with -dGDB'#000+
-  'W_You are using the obsolete swit','ch $1'#000+
+  'H_Try ','recompiling with -dGDB'#000+
+  'W_You are using the obsolete switch $1'#000+
   'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
   'Copyright (c) 1993-98 by Florian Klaempfl'#000+
   'Free Pascal Compiler version $FPCVER'#000+
   #000+
   'Compiler Date  : $FPCDATE'#000+
-  'Compiler Target: $FPCTARGET'#000+
+  'Compiler ','Target: $FPCTARGET'#000+
   #000+
-  'This program comes under the GNU Gen','eral Public Licence'#000+
+  'This program comes under the GNU General Public Licence'#000+
   'For more information read COPYING.FPC'#000+
   #000+
   'Report bugs,suggestions etc to:'#000+
   '                [email protected]'#000+
-  '**0*_put + after a boolean switch option to enable it, - to disable it'+
-  #000+
-  '**1a_the compiler doesn'#039't del','ete the generated assembler file'#000+
+  '**0*_put + after a boolean switch option to ','enable it, - to disable '+
+  'it'#000+
+  '**1a_the compiler doesn'#039't delete the generated assembler file'#000+
   '**2al_list sourcecode lines in assembler file'#000+
   '*t1b_use EMS'#000+
   '**1B_build all modules'#000+
   '**1C_code generation options'#000+
   '3*2CD_create dynamic library'#000+
-  '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
-  '**2Ci_IO-checki','ng'#000+
+  '**2Ch<n>_<n','> bytes heap (between 1023 and 67107840)'#000+
+  '**2Ci_IO-checking'#000+
   '**2Cn_omit linking stage'#000+
   '**2Co_check overflow of integer operations'#000+
   '**2Cr_range checking'#000+
   '**2Cs<n>_set stack size to <n>'#000+
   '**2Ct_stack checking'#000+
   '3*2CS_create static library'#000+
-  '3*2Cx_use smartlinking'#000+
+  '3*2Cx_use sm','artlinking'#000+
   '**1d<x>_defines the symbol <x>'#000+
-  '*O1D_generate ','a DEF file'#000+
+  '*O1D_generate a DEF file'#000+
   '*O2Dd<x>_set description to <x>'#000+
   '*O2Dw_PM application'#000+
   '**1e<x>_set path to executable'#000+
   '**1E_same as -Cn'#000+
   '**1F_set file names and paths'#000+
-  '**2FD<x>_sets the directory where to search for compiler utilities'#000+
-  '**2Fe<x>_redirect error output ','to <x>'#000+
+  '**2FD<x>_sets the directory where to searc','h for compiler utilities'#000+
+  '**2Fe<x>_redirect error output to <x>'#000+
   '**2FE<x>_set exe/unit output path to <x>'#000+
   '*L2Fg<x>_same as -Fl'#000+
   '**2Fi<x>_adds <x> to include path'#000+
   '**2Fl<x>_adds <x> to library path'#000+
   '*L2FL<x>_uses <x> as dynamic linker'#000+
-  '**2Fo<x>_adds <x> to object path'#000+
-  '**2Fr<x>_load error message file <','x>'#000+
+  '**2Fo<x>_ad','ds <x> to object path'#000+
+  '**2Fr<x>_load error message file <x>'#000+
   '**2Fu<x>_adds <x> to unit path'#000+
   '**2FU<x>_set unit output path to <x>, overrides -FE'#000+
   '*g1g_generate debugger information'#000+
   '*g2gg_use gsym'#000+
   '*g2gd_use dbx'#000+
   '**1i_information'#000+
-  '**1I<x>_adds <x> to include path'#000+
+  '**1I<x>_adds <x> ','to include path'#000+
   '**1k<x>_Pass <x> to the linker'#000+
-  '**1l_writ','e logo'#000+
+  '**1l_write logo'#000+
   '**1n_don'#039't read the default config file'#000+
   '**1o<x>_change the name of the executable produced to <x>'#000+
   '**1pg_generate profile code for gprof'#000+
-  '*L1P_use pipes instead of creating temporary assembler files'#000+
+  '*L1P_use pipes instead of creating tempor','ary assembler files'#000+
   '**1S_syntax options'#000+
-  '**2S2_switch som','e Delphi 2 extensions on'#000+
+  '**2S2_switch some Delphi 2 extensions on'#000+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
   '**2Sd_tries to be Delphi compatible'#000+
   '**2Se_compiler stops after the first error'#000+
   '**2Sg_allow LABEL and GOTO'#000+
-  '**2Si_support C++ stlyed INLINE'#000+
-  '**2Sm_support macros like C',' (global)'#000+
+  '**2','Si_support C++ stlyed INLINE'#000+
+  '**2Sm_support macros like C (global)'#000+
   '**2So_tries to be TP/BP 7.0 compatible'#000+
   '**2Sp_tries to be gpc compatible'#000+
   '**2Ss_constructor name must be init (destructor must be done)'#000+
   '**2St_allow static keyword in objects'#000+
-  '**1s_don'#039't call assembler and linker (only with -a)'#000+
-  '**1u<x','>_undefines the symbol <x>'#000+
+  '**','1s_don'#039't call assembler and linker (only with -a)'#000+
+  '**1u<x>_undefines the symbol <x>'#000+
   '**1U_unit options'#000+
   '**2Un_don'#039't check the unit name'#000+
   '**2Up<x>_same as -Fu<x>'#000+
   '**2Us_compile a system unit'#000+
-  '**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
-  '**2*_e : Show errors (default)       d : Sh','ow debug info'#000+
+  '**1v<x>_Be verbose. <x> is a combination of the followi','ng letters :'#000+
+  '**2*_e : Show errors (default)       d : Show debug info'#000+
   '**2*_w : Show warnings               u : Show unit info'#000+
   '**2*_n : Show notes                  t : Show tried/used files'#000+
-  '**2*_h : Show hints                  m : Show defined macros'#000+
-  '**2*_i : Show general info           p : Show ','compiled procedures'#000+
+  '**2*_h : Show hints                  m : Show defin','ed macros'#000+
+  '**2*_i : Show general info           p : Show compiled procedures'#000+
   '**2*_l : Show linenumbers            c : Show conditionals'#000+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#000+
-  '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#000+
-  '**2*_    declarations',' if an error    x : Executable info (Win32 only'+
-  ')'#000+
+  '**2*_b : Show all procedure        ','  r : Rhide/GCC compatibility mod'+
+  'e'#000+
+  '**2*_    declarations if an error    x : Executable info (Win32 only)'#000+
   '**2*_    occurs'#000+
   '**1X_executable options'#000+
   '*L2Xc_link with the c library'#000+
   '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
-  '**2Xs_strip all symbols from executable'#000+
-  '**2XS_link with stat','ic libraries (defines FPC_LINK_STATIC)'#000+
+  '**2X','s_strip all symbols from executable'#000+
+  '**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
   '**0*_Processor specific options:'#000+
   '3*1A<x>_output format'#000+
   '3*2Ao_coff file using GNU AS'#000+
   '3*2Anasmcoff_coff file using Nasm'#000+
-  '3*2Anasmelf_elf32 (linux) file using Nasm'#000+
+  '3*2Anasmelf_elf32 (linux) f','ile using Nasm'#000+
   '3*2Anasmobj_obj file using Nasm'#000+
-  '3*2Amasm_','obj using Masm (Mircosoft)'#000+
+  '3*2Amasm_obj using Masm (Mircosoft)'#000+
   '3*2Atasm_obj using Tasm (Borland)'#000+
   '3*1R<x>_assembler reading style'#000+
   '3*2Ratt_read AT&T style assembler'#000+
   '3*2Rintel_read Intel style assembler'#000+
-  '3*2Rdirect_copy assembler text directly to assembler file'#000+
-  '3*1O<x>_optimizati','ons'#000+
+  '3*2Rdirect_copy asse','mbler text directly to assembler file'#000+
+  '3*1O<x>_optimizations'#000+
   '3*2Og_generate smaller code'#000+
   '3*2OG_generate faster code (default)'#000+
   '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
   '3*2Ou_enable uncertain optimizations (see docs)'#000+
-  '3*2O1_level 1 optimizations (quick optimizations)'#000+
-  '3*2O2_level 2 ','optimizations (-O1 + slower optimizations)'#000+
+  '3*2O1_le','vel 1 optimizations (quick optimizations)'#000+
+  '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
   '3*2O3_level 3 optimizations (same as -O2u)'#000+
   '3*2Op_target processor'#000+
   '3*3Op1_set target processor to 386/486'#000+
-  '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
-  '3*3Op3_set target processor to PPro/P','II/c6x86/K6 (tm)'#000+
+  '3*3Op2_set target processor to Penti','um/PentiumMMX (tm)'#000+
+  '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
   '3*1T<x>_Target operating system'#000+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
   '3*2TLINUX_Linux'#000+
   '3*2TOS2_OS/2 2.x'#000+
-  '3*2TWin32_Windows 32 Bit'#000+
+  '3*2TWi','n32_Windows 32 Bit'#000+
   '6*1A<x>_output format'#000+
-  '6*2Ao_Unix o-fi','le using GNU AS'#000+
+  '6*2Ao_Unix o-file using GNU AS'#000+
   '6*2Agas_GNU Motorola assembler'#000+
   '6*2Amit_MIT Syntax (old GAS)'#000+
   '6*2Amot_Standard Motorola assembler'#000+
   '6*1O_optimizations'#000+
   '6*2Oa_turn on the optimizer'#000+
-  '6*2Og_generate smaller code'#000+
+  '6*2Og_generate smaller co','de'#000+
   '6*2OG_generate faster code (default)'#000+
-  '6*2Ox_optimize m','aximum (still BUGGY!!!)'#000+
+  '6*2Ox_optimize maximum (still BUGGY!!!)'#000+
   '6*2O2_set target processor to a MC68020+'#000+
   '6*1R<x>_assembler reading style'#000+
   '6*2RMOT_read motorola style assembler'#000+
   '6*1T<x>_Target operating system'#000+
-  '6*2TAMIGA_Commodore Amiga'#000+
+  '6*2TAMIGA_Commodo','re Amiga'#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
-  '6*2TMACOS_Macintosh m','68k'#000+
+  '6*2TMACOS_Macintosh m68k'#000+
   '6*2TLINUX_Linux-68k'#000+
   '**1*_'#000+
   '**1?_shows this help'#000+

+ 113 - 93
compiler/ra386att.pas

@@ -1575,7 +1575,6 @@ const
        end;
      { ------------------------------------------------------------------- }
 
-
     { copy them to local variables }
     { for faster access            }
     optyp1:=operands[1].opinfo;
@@ -2419,6 +2418,62 @@ const
   end;
 
 
+  Procedure GetRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
+  {*********************************************************************}
+  { PROCEDURE GetRecordOffsetSize                                       }
+  {  Description: This routine builds up a record offset after a AS_DOT }
+  {  token is encountered.                                              }
+  {   On entry actasmtoken should be equal to AS_DOT                    }
+  {*********************************************************************}
+  { EXIT CONDITION:  On exit the routine should point to either the     }
+  {       AS_COMMA or AS_SEPARATOR token.                               }
+  { Warning: This is called recursively.                                }
+  {*********************************************************************}
+  var
+    toffset,tsize : longint;
+  Begin
+    offset:=0;
+    size:=0;
+    Consume(AS_DOT);
+    if actasmtoken = AS_ID then
+      Begin
+        if not GetTypeOffsetSize(expr,actasmpattern,toffset,tsize) and
+           not GetVarOffsetSize(expr,actasmpattern,toffset,tsize) then
+         begin
+           Message(assem_e_syntax_error);
+           toffset:=0;
+           tsize:=0;
+         end;
+        inc(offset,toffset);
+        size:=tsize;
+        Consume(AS_ID);
+        case actasmtoken of
+          AS_SEPARATOR,
+          AS_COMMA      : exit;
+          AS_DOT        : begin
+                            GetRecordOffsetSize(expr,toffset,tsize);
+                            inc(offset,toffset);
+                            size:=tsize;
+                          end;
+
+        else
+          Begin
+            Message(assem_e_syntax_error);
+            repeat
+              consume(actasmtoken)
+            until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
+            exit;
+          end;
+        end;
+      end
+    else
+      Begin
+        Message(assem_e_syntax_error);
+        repeat
+          consume(actasmtoken)
+        until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
+      end;
+  end;
 
 
   Function BuildExpression: longint;
@@ -2437,7 +2492,7 @@ const
   {*********************************************************************}
   var expr: string;
       tempstr: string;
-      l : longint;
+      l,k : longint;
       errorflag: boolean;
   Begin
     errorflag := FALSE;
@@ -2498,15 +2553,26 @@ const
                   expr := expr + '|';
                 end;
       AS_ID:    Begin
-                  if NOT SearchIConstant(actasmpattern,l) then
-                  Begin
-                    Message1(assem_e_invalid_const_symbol,actasmpattern);
-                    l := 0;
+                  tempstr:=actasmpattern;
+                  previous_was_id:=TRUE;
+                  consume(AS_ID);
+                  if actasmtoken=AS_DOT then
+                   begin
+                     GetRecordOffsetSize(tempstr,l,k);
+                     str(l, tempstr);
+                     expr := expr + tempstr;
+                   end
+                  else
+                   begin
+                     if SearchIConstant(actasmpattern,l) then
+                      begin
+                        str(l, tempstr);
+                        expr := expr + tempstr;
+                      end
+                     else
+                      Message1(assem_e_invalid_const_symbol,actasmpattern);
+                   end;
                   end;
-                  str(l, tempstr);
-                  expr := expr + tempstr;
-                  Consume(AS_ID);
-                end;
       AS_INTNUM:  Begin
                    expr := expr + actasmpattern;
                    Consume(AS_INTNUM);
@@ -2739,7 +2805,7 @@ const
   {*********************************************************************}
   var tempstr: string;
       expr: string;
-    l : longint;
+    l,k : longint;
     errorflag : boolean;
   Begin
     errorflag := FALSE;
@@ -2806,14 +2872,24 @@ const
                   end;
       AS_ID:
                 Begin
-                  if NOT SearchIConstant(actasmpattern,l) then
-                  Begin
-                    Message1(assem_e_invalid_const_symbol,actasmpattern);
-                    l := 0;
-                  end;
-                  str(l, tempstr);
-                  expr := expr + tempstr;
-                  Consume(AS_ID);
+                  tempstr:=actasmpattern;
+                  consume(AS_ID);
+                  if actasmtoken=AS_DOT then
+                   begin
+                     GetRecordOffsetSize(tempstr,l,k);
+                     str(l, tempstr);
+                     expr := expr + tempstr;
+                   end
+                  else
+                   begin
+                     if SearchIConstant(actasmpattern,l) then
+                      begin
+                        str(l, tempstr);
+                        expr := expr + tempstr;
+                      end
+                     else
+                      Message1(assem_e_invalid_const_symbol,actasmpattern);
+                   end;
                 end;
       AS_INTNUM:  Begin
                    expr := expr + actasmpattern;
@@ -2879,8 +2955,11 @@ const
      Case actasmtoken of
         { // (reg ... // }
         AS_REGISTER: Begin
-                        instr.operands[operandnum].ref.base :=
-                           findregister(actasmpattern);
+                       { Check if there is already a base (mostly ebp,esp) than this is
+                         not allowed,becuase it will give crashing code }
+                        if instr.operands[operandnum].ref.base<>R_NO then
+                         Message(assem_e_cannot_index_relative_var);
+                        instr.operands[operandnum].ref.base := findregister(actasmpattern);
                         Consume(AS_REGISTER);
                         { can either be a register or a right parenthesis }
                          { // (reg)       // }
@@ -3046,75 +3125,6 @@ const
   end;
 
 
-  Procedure BuildRecordOffset(const expr: string; var Instr: TInstruction);
-  {*********************************************************************}
-  { PROCEDURE BuildRecordOffset                                         }
-  {  Description: This routine builds up a record offset after a AS_DOT }
-  {  token is encountered.                                              }
-  {   On entry actasmtoken should be equal to AS_DOT                    }
-  {*********************************************************************}
-  { EXIT CONDITION:  On exit the routine should point to either the     }
-  {       AS_COMMA or AS_SEPARATOR token.                               }
-  { Warning: This is called recursively.                                }
-  {*********************************************************************}
-  var offset: longint;
-  Begin
-    Consume(AS_DOT);
-    if actasmtoken = AS_ID then
-      Begin
-        if GetTypeOffset(instr,expr,actasmpattern,offset,operandnum) then
-         begin
-          instr.operands[operandnum].ref.offset := instr.operands[operandnum].ref.offset + offset;
-          Consume(AS_ID);
-          case actasmtoken of
-            AS_SEPARATOR,AS_COMMA: exit;
-            { one level deeper }
-            AS_DOT: BuildRecordOffset(expr,instr);
-           else
-            Begin
-               Message(assem_e_syntax_error);
-               repeat
-                 consume(actasmtoken)
-               until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
-               exit;
-            end;
-           end;
-         end
-        else
-        if GetVarOffset(instr,expr,actasmpattern,offset,operandnum) then
-         begin
-          instr.operands[operandnum].ref.offset := instr.operands[operandnum].ref.offset + offset;
-          Consume(AS_ID);
-          case actasmtoken of
-            AS_SEPARATOR,AS_COMMA: exit;
-            { one level deeper }
-            AS_DOT: BuildRecordOffset(expr,instr);
-           else
-            Begin
-               Message(assem_e_syntax_error);
-               repeat
-                 consume(actasmtoken)
-               until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
-               exit;
-            end;
-           end;
-         end
-        else
-         Begin
-            Message(assem_e_syntax_error);
-         end;
-      end
-    else
-     Begin
-       Message(assem_e_syntax_error);
-       repeat
-         consume(actasmtoken)
-       until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
-     end;
-  end;
-
-
-
   Procedure BuildOperand(var instr: TInstruction);
   {*********************************************************************}
   { EXIT CONDITION:  On exit the routine should point to either the     }
@@ -3125,6 +3135,8 @@ const
     expr: string;
     lab: Pasmlabel;
     hl: plabel;
+    tsize,
+    toffset : longint;
   Begin
    tempstr := '';
    expr := '';
@@ -3271,7 +3283,7 @@ const
                           Message1(assem_e_unknown_id,actasmpattern);
                       end;
                      { constant expression? }
-                     if instr.operands[operandnum].operandtype=OPR_CONSTANT then
+                     if (instr.operands[operandnum].operandtype=OPR_CONSTANT) then
                       instr.operands[operandnum].val := BuildExpression
                      else
                       begin
@@ -3284,7 +3296,9 @@ const
                                         BuildReference(instr);
                                       end;
                            AS_DOT :  Begin
-                                      BuildRecordOffset(expr,instr);
+                                       GetRecordOffsetSize(expr,toffset,tsize);
+                                       inc(instr.operands[operandnum].ref.offset,toffset);
+                                       SetOperandSize(instr,operandnum,tsize);
                                      end;
                            AS_SEPARATOR,AS_COMMA: ;
                         else
@@ -3875,7 +3889,13 @@ end.
 
 {
   $Log$
-  Revision 1.17  1998-10-28 21:34:39  peter
+  Revision 1.18  1998-11-05 23:48:26  peter
+    * recordtype.field support in constant expressions
+    * fixed imul for oa_imm8 which was not allowed
+    * fixed reading of local typed constants
+    * fixed comment reading which is not any longer a separator
+
+  Revision 1.17  1998/10/28 21:34:39  peter
     * fixed some opsize
 
   Revision 1.16  1998/10/28 00:08:48  peter

+ 109 - 26
compiler/ra386int.pas

@@ -2009,8 +2009,62 @@ var
 
 
 
+  Procedure GetRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
+  {*********************************************************************}
+  { PROCEDURE GetRecordOffsetSize                                       }
+  {  Description: This routine builds up a record offset after a AS_DOT }
+  {  token is encountered.                                              }
+  {   On entry actasmtoken should be equal to AS_DOT                    }
+  {*********************************************************************}
+  { EXIT CONDITION:  On exit the routine should point to either the     }
+  {       AS_COMMA or AS_SEPARATOR token.                               }
+  { Warning: This is called recursively.                                }
+  {*********************************************************************}
+  var
+    toffset,tsize : longint;
+  Begin
+    offset:=0;
+    size:=0;
+    Consume(AS_DOT);
+    if actasmtoken = AS_ID then
+      Begin
+        if not GetTypeOffsetSize(expr,actasmpattern,toffset,tsize) and
+           not GetVarOffsetSize(expr,actasmpattern,toffset,tsize) then
+         begin
+           Message(assem_e_syntax_error);
+           toffset:=0;
+           tsize:=0;
+         end;
+        inc(offset,toffset);
+        size:=tsize;
+        Consume(AS_ID);
+        case actasmtoken of
+          AS_SEPARATOR,
+          AS_COMMA      : exit;
+          AS_DOT        : begin
+                            GetRecordOffsetSize(expr,toffset,tsize);
+                            inc(offset,toffset);
+                            size:=tsize;
+                          end;
 
-
+        else
+          Begin
+            Message(assem_e_syntax_error);
+            repeat
+              consume(actasmtoken)
+            until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
+            exit;
+          end;
+        end;
+      end
+    else
+      Begin
+        Message(assem_e_syntax_error);
+        repeat
+          consume(actasmtoken)
+        until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
+      end;
+  end;
 
 
   Function BuildRefExpression: longint;
@@ -2030,7 +2084,7 @@ var
   {*********************************************************************}
   var tempstr: string;
       expr: string;
-    l : longint;
+    l,k : longint;
     errorflag : boolean;
   Begin
     errorflag := FALSE;
@@ -2106,14 +2160,24 @@ var
                   end;
       AS_ID:
                 Begin
-                  if NOT SearchIConstant(actasmpattern,l) then
-                  Begin
-                    Message1(assem_e_invalid_const_symbol,actasmpattern);
-                    l := 0;
-                  end;
-                  str(l, tempstr);
-                  expr := expr + tempstr;
-                  Consume(AS_ID);
+                  tempstr:=actasmpattern;
+                  consume(AS_ID);
+                  if actasmtoken=AS_DOT then
+                   begin
+                     GetRecordOffsetSize(tempstr,l,k);
+                     str(l, tempstr);
+                     expr := expr + tempstr;
+                   end
+                  else
+                   begin
+                     if SearchIConstant(actasmpattern,l) then
+                      begin
+                        str(l, tempstr);
+                        expr := expr + tempstr;
+                      end
+                     else
+                      Message1(assem_e_invalid_const_symbol,actasmpattern);
+                   end;
                 end;
       AS_INTNUM:  Begin
                    expr := expr + actasmpattern;
@@ -2174,6 +2238,7 @@ var
   var
     firstpass: boolean;
     offset: longint;
+    tsize,toffset : longint;
     basetypename : string;
   Begin
     basetypename := '';
@@ -2191,12 +2256,13 @@ var
                   { // var_name.typefield.typefield // }
                   if (varname <> '') then
                   Begin
-                    if not GetVarOffset(instr,varname,actasmpattern,offset,operandnum) then
+                    if GetVarOffsetSize(varname,actasmpattern,toffset,tsize) then
                     Begin
-                      Message1(assem_e_unknown_id,actasmpattern);
+                      Inc(instr.operands[operandnum].ref.offset,tOffset);
+                      SetOperandSize(instr,operandnum,tsize);
                     end
                     else
-                      Inc(instr.operands[operandnum].ref.offset,Offset);
+                      Message1(assem_e_unknown_id,actasmpattern);
                   end
                   else
                  {    [ref].var_name.typefield.typefield ...                }
@@ -2224,12 +2290,13 @@ var
                  {    [ref].typefield.typefield ...                         }
                  {  basetpyename is already set up... now look for fields.  }
                   Begin
-                     if not GetTypeOffset(instr,basetypename,actasmpattern,Offset,operandnum) then
+                     if GetTypeOffsetSize(basetypename,actasmpattern,tOffset,Tsize) then
                      Begin
-                      Message1(assem_e_unknown_id,actasmpattern);
+                       Inc(instr.operands[operandnum].ref.offset,tOffset);
+                       SetOperandSize(instr,operandnum,Tsize);
                      end
                      else
-                       Inc(instr.operands[operandnum].ref.offset,Offset);
+                      Message1(assem_e_unknown_id,actasmpattern);
                   end;
                   Consume(AS_ID);
                  { Take care of index register on this variable }
@@ -2287,7 +2354,7 @@ var
   {*********************************************************************}
   var expr: string;
       tempstr: string;
-      l : longint;
+      l,k : longint;
       errorflag: boolean;
   Begin
     errorflag := FALSE;
@@ -2350,14 +2417,24 @@ var
                   expr := expr + '|';
                 end;
       AS_ID:    Begin
-                  if NOT SearchIConstant(actasmpattern,l) then
-                  Begin
-                    Message1(assem_e_invalid_const_symbol,actasmpattern);
-                    l := 0;
-                  end;
-                  str(l, tempstr);
-                  expr := expr + tempstr;
-                  Consume(AS_ID);
+                  tempstr:=actasmpattern;
+                  consume(AS_ID);
+                  if actasmtoken=AS_DOT then
+                   begin
+                     GetRecordOffsetSize(tempstr,l,k);
+                     str(l, tempstr);
+                     expr := expr + tempstr;
+                   end
+                  else
+                   begin
+                     if SearchIConstant(actasmpattern,l) then
+                      begin
+                        str(l, tempstr);
+                        expr := expr + tempstr;
+                      end
+                     else
+                      Message1(assem_e_invalid_const_symbol,actasmpattern);
+                   end;
                 end;
       AS_INTNUM:  Begin
                    expr := expr + actasmpattern;
@@ -3395,7 +3472,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  1998-10-13 16:50:17  pierre
+  Revision 1.10  1998-11-05 23:48:27  peter
+    * recordtype.field support in constant expressions
+    * fixed imul for oa_imm8 which was not allowed
+    * fixed reading of local typed constants
+    * fixed comment reading which is not any longer a separator
+
+  Revision 1.9  1998/10/13 16:50:17  pierre
     * undid some changes of Peter that made the compiler wrong
       for m68k (I had to reinsert some ifdefs)
     * removed several memory leaks under m68k

+ 18 - 9
compiler/scanner.pas

@@ -1479,8 +1479,7 @@ exit_label:
          case c of
           '{' : begin
                   skipcomment;
-                  lastasmgetchar:=c;
-                  asmgetchar:=';';
+                  asmgetchar:=c;
                   exit;
                 end;
           '/' : begin
@@ -1488,11 +1487,13 @@ exit_label:
                   if c='/' then
                    begin
                      skipdelphicomment;
-                     asmgetchar:=';';
+                     asmgetchar:=c;
                    end
                   else
-                   asmgetchar:='/';
-                  lastasmgetchar:=c;
+                   begin
+                     asmgetchar:='/';
+                     lastasmgetchar:=c;
+                   end;
                   exit;
                 end;
           '(' : begin
@@ -1500,11 +1501,13 @@ exit_label:
                   if c='*' then
                    begin
                      skipoldtpcomment;
-                     asmgetchar:=';';
+                     asmgetchar:=c;
                    end
                   else
-                   asmgetchar:='(';
-                  lastasmgetchar:=c;
+                   begin
+                     asmgetchar:='(';
+                     lastasmgetchar:=c;
+                   end;
                   exit;
                 end;
          else
@@ -1519,7 +1522,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.65  1998-11-03 11:35:02  peter
+  Revision 1.66  1998-11-05 23:48:29  peter
+    * recordtype.field support in constant expressions
+    * fixed imul for oa_imm8 which was not allowed
+    * fixed reading of local typed constants
+    * fixed comment reading which is not any longer a separator
+
+  Revision 1.65  1998/11/03 11:35:02  peter
     * don't check for endif if error
 
   Revision 1.64  1998/10/21 20:16:05  peter