فهرست منبع

* m68k updates from v10 merged

peter 24 سال پیش
والد
کامیت
c4b84ce276

+ 30 - 1
compiler/cutils.pas

@@ -37,6 +37,8 @@ interface
 
     function min(a,b : longint) : longint;
     function max(a,b : longint) : longint;
+    function SwapLong(x : longint): longint;
+    function SwapWord(x : word): word;
     function align(i,a:longint):longint;
     function used_align(varalign,minalign,maxalign:longint):longint;
     function size_2_align(len : longint) : longint;
@@ -136,6 +138,30 @@ uses
       end;
 
 
+    Function SwapLong(x : longint): longint;
+      var
+        y : word;
+        z : word;
+      Begin
+        y := (x shr 16) and $FFFF;
+        y := ((y shl 8) and $FFFF) or ((y shr 8) and $ff);
+        z := x and $FFFF;
+        z := ((z shl 8) and $FFFF) or ((z shr 8) and $ff);
+        SwapLong := (longint(z) shl 16) or longint(y);
+      End;
+
+
+    Function SwapWord(x : word): word;
+      var
+        z : byte;
+      Begin
+        z := (x shr 8) and $ff;
+        x := x and $ff;
+        x := (x shl 8);
+        SwapWord := x or z;
+      End;
+
+
     function align(i,a:longint):longint;
     {
       return value <i> aligned <a> boundary
@@ -708,7 +734,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.8  2001-07-01 20:16:15  peter
+  Revision 1.9  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.8  2001/07/01 20:16:15  peter
     * alignmentinfo record added
     * -Oa argument supports more alignment settings that can be specified
       per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN

+ 5 - 2
compiler/globtype.pas

@@ -42,7 +42,7 @@ interface
        ts32real = single;
        ts64real = double;
        ts80real = extended;
-       ts64comp = comp;
+       ts64comp = extended;
 {$endif}
 {$ifdef alpha}
        bestreal = extended;
@@ -208,7 +208,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  2001-07-01 20:16:15  peter
+  Revision 1.14  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.13  2001/07/01 20:16:15  peter
     * alignmentinfo record added
     * -Oa argument supports more alignment settings that can be specified
       per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN

+ 14 - 7
compiler/i386/cgai386.pas

@@ -1431,17 +1431,19 @@ implementation
             LOC_REGISTER,LOC_CREGISTER:
                 begin
                     case orddef.typ of
-                        u8bit:
+                        u8bit,uchar,bool8bit:
                             tai:=Taicpu.Op_reg_reg(A_MOVZX,S_BL,location.register,destreg);
                         s8bit:
                             tai:=Taicpu.Op_reg_reg(A_MOVSX,S_BL,location.register,destreg);
-                        u16bit:
+                        u16bit,uwidechar,bool16bit:
                             tai:=Taicpu.Op_reg_reg(A_MOVZX,S_WL,location.register,destreg);
                         s16bit:
                             tai:=Taicpu.Op_reg_reg(A_MOVSX,S_WL,location.register,destreg);
-                        u32bit,s32bit:
+                        u32bit,bool32bit,s32bit:
                             if location.register <> destreg then
                               tai:=Taicpu.Op_reg_reg(A_MOV,S_L,location.register,destreg);
+                        else
+                          internalerror(330);
                     end;
                     if delloc then
                         ungetregister(location.register);
@@ -1455,18 +1457,20 @@ implementation
                      begin
                        r:=newreference(location.reference);
                        case orddef.typ of
-                         u8bit:
+                         u8bit,uchar,bool8bit:
                             tai:=Taicpu.Op_ref_reg(A_MOVZX,S_BL,r,destreg);
                          s8bit:
                             tai:=Taicpu.Op_ref_reg(A_MOVSX,S_BL,r,destreg);
-                         u16bit:
+                         u16bit,uwidechar,bool16bit:
                             tai:=Taicpu.Op_ref_reg(A_MOVZX,S_WL,r,destreg);
                          s16bit:
                             tai:=Taicpu.Op_ref_reg(A_MOVSX,S_WL,r,destreg);
-                         u32bit:
+                         u32bit,bool32bit:
                             tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg);
                          s32bit:
                             tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg);
+                         else
+                           internalerror(330);
                        end;
                      end;
                     if delloc then
@@ -2996,7 +3000,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  2001-07-01 20:16:18  peter
+  Revision 1.26  2001-07-30 20:59:28  peter
+    * m68k updates from v10 merged
+
+  Revision 1.25  2001/07/01 20:16:18  peter
     * alignmentinfo record added
     * -Oa argument supports more alignment settings that can be specified
       per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN

+ 5 - 1
compiler/i386/n386cnv.pas

@@ -372,6 +372,7 @@ implementation
                   new(hr);
                   reset_reference(hr^);
                   hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
+                  location.register:=getregister32;
                   emit_ref_reg(A_LEA,S_L,hr,location.register);
                 end
                else
@@ -1423,7 +1424,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-07-16 13:19:08  jonas
+  Revision 1.18  2001-07-30 20:59:29  peter
+    * m68k updates from v10 merged
+
+  Revision 1.17  2001/07/16 13:19:08  jonas
     * fixed allocation of register before release in second_cstring_to_pchar
 
   Revision 1.16  2001/07/08 21:00:17  peter

+ 23 - 7
compiler/ncnv.pas

@@ -190,12 +190,13 @@ implementation
            constsethi:=pos;
           if pos<constsetlo then
            constsetlo:=pos;
-          l:=pos shr 3;
-          mask:=1 shl (pos mod 8);
+          { to do this correctly we use the 32bit array }
+          l:=pos shr 5;
+          mask:=1 shl (pos mod 32);
           { do we allow the same twice }
-          if (constset^[l] and mask)<>0 then
+          if (pconst32bitset(constset)^[l] and mask)<>0 then
            Message(parser_e_illegal_set_expr);
-          constset^[l]:=constset^[l] or mask;
+          pconst32bitset(constset)^[l]:=pconst32bitset(constset)^[l] or mask;
         end;
 
       var
@@ -1044,8 +1045,20 @@ implementation
     function ttypeconvnode.first_int_to_real : tnode;
       begin
         first_int_to_real:=nil;
-        if registersfpu<1 then
-         registersfpu:=1;
+{$ifdef m68k}
+         if (cs_fp_emulation in aktmoduleswitches) or
+            (tfloatdef(resulttype.def).typ=s32real) then
+           begin
+             if registers32<1 then
+               registers32:=1;
+           end
+         else
+           if registersfpu<1 then
+             registersfpu:=1;
+{$else not m68k}
+         if registersfpu<1 then
+          registersfpu:=1;
+{$endif not m68k}
         location.loc:=LOC_FPU;
       end;
 
@@ -1415,7 +1428,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2001-07-08 21:00:15  peter
+  Revision 1.30  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.29  2001/07/08 21:00:15  peter
     * various widestring updates, it works now mostly without charset
       mapping supported
 

+ 6 - 1
compiler/node.pas

@@ -36,6 +36,8 @@ interface
     type
        pconstset = ^tconstset;
        tconstset = array[0..31] of byte;
+       pconst32bitset = ^tconst32bitset;
+       tconst32bitset = array[0..7] of longint;
 
        tnodetype = (
           addn,     {Represents the + operator.}
@@ -795,7 +797,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2001-06-04 18:14:16  peter
+  Revision 1.18  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.17  2001/06/04 18:14:16  peter
     * store blocktype info in tnode
 
   Revision 1.16  2001/06/04 11:53:13  peter

+ 5 - 2
compiler/parser.pas

@@ -98,7 +98,7 @@ implementation
           stacksize:=target_info.stacksize;
 
          { open assembler response }
-         AsmRes:=TAsmScript.Create(outputexedir+'ppas');
+         GenerateAsmRes(outputexedir+'ppas');
 
          { open deffile }
          DefFile:=TDefFile.Create(outputexedir+inputfile+target_info.defext);
@@ -617,7 +617,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2001-07-01 20:16:16  peter
+  Revision 1.21  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.20  2001/07/01 20:16:16  peter
     * alignmentinfo record added
     * -Oa argument supports more alignment settings that can be specified
       per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN

+ 5 - 2
compiler/pmodules.pas

@@ -297,7 +297,7 @@ implementation
 {$ifdef m68k}
          if target_info.target<>target_m68k_PalmOS then
            begin
-              dataSegment.concat(Tai_symbol.Createdataname_global('HEAP_SIZE',0));
+              dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4));
               dataSegment.concat(Tai_const.Create_32bit(heapsize));
            end;
 {$else m68k}
@@ -1335,7 +1335,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2001-06-18 20:36:25  peter
+  Revision 1.38  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.37  2001/06/18 20:36:25  peter
     * -Ur switch (merged)
     * masm fixes (merged)
     * quoted filenames for go32v2 and win32

+ 12 - 4
compiler/psystem.pas

@@ -247,11 +247,16 @@ begin
 {$endif}
 {$ifdef m68k}
   s32floattype.setdef(tfloatdef.create(s32real));
-  s64floattype.setdef(tfloatdef.create(s32real));
   if (cs_fp_emulation in aktmoduleswitches) then
-   s80floattype.setdef(tfloatdef.create(s32real)))
+   begin
+     s64floattype.setdef(tfloatdef.create(s32real));
+     s80floattype.setdef(tfloatdef.create(s32real)))
+   end
   else
-   s80floattype.setdef(tfloatdef.create(s80real));
+   begin
+     s64floattype.setdef(tfloatdef.create(s64real));
+     s80floattype.setdef(tfloatdef.create(s80real));
+   end;
 {$endif}
   { some other definitions }
   voidpointertype.setdef(tpointerdef.create(voidtype));
@@ -266,7 +271,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.17  2001-07-09 21:15:41  peter
+  Revision 1.18  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.17  2001/07/09 21:15:41  peter
     * Length made internal
     * Add array support for Length
 

+ 13 - 6
compiler/ptconst.pas

@@ -70,6 +70,7 @@ implementation
          curconstsegment : TAAsmoutput;
          ll        : tasmlabel;
          s         : string;
+         c         : char;
          ca        : pchar;
          tmpguid   : tguid;
          aktpos    : longint;
@@ -370,15 +371,14 @@ implementation
                         { untrue - because they are considered }
                         { arrays of 32-bit values CEC          }
 
-                        { store as longint values in little-endian format }
-                        if target_info.endian = endian_little then
+                        if source_info.endian = target_info.endian then
                           begin
                             for l:= 0 to p.resulttype.def.size-1 do
                                curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[l]));
                           end
                         else
                           begin
-                            { store as longint values in big-endian format }
+                            { store as longint values in swaped format }
                             j:=0;
                             for l:=0 to ((p.resulttype.def.size-1) div 4) do
                               begin
@@ -430,7 +430,10 @@ implementation
                 end
               else if is_constcharnode(p) then
                 begin
-                  strval:=pchar(@tordconstnode(p).value);
+                  { strval:=pchar(@tordconstnode(p).value);
+                    THIS FAIL on BIG_ENDIAN MACHINES PM }
+                  c:=chr(tordconstnode(p).value and $ff);
+                  strval:=@c;
                   strlength:=1
                 end
               else if is_constresourcestringnode(p) then
@@ -560,7 +563,8 @@ implementation
                    else
                      if is_constcharnode(p) then
                       begin
-                        ca:=pchar(@tordconstnode(p).value);
+                        c:=chr(tordconstnode(p).value and $ff);
+                        ca:=@c;
                         len:=1;
                       end
                    else
@@ -885,7 +889,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2001-07-08 21:00:15  peter
+  Revision 1.28  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.27  2001/07/08 21:00:15  peter
     * various widestring updates, it works now mostly without charset
       mapping supported
 

+ 8 - 2
compiler/scanner.pas

@@ -1356,7 +1356,10 @@ implementation
                if t.is_conditional then
                 handleconditional(t)
                else
-                t.proc{$ifdef FPCPROCVAR}(){$endif};
+                begin
+                  Message1(scan_d_handling_switch,'$'+hs);
+                  t.proc{$ifdef FPCPROCVAR}(){$endif};
+                end;
              end
             else
              begin
@@ -2599,7 +2602,10 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.20  2001-07-15 11:56:21  peter
+  Revision 1.21  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.20  2001/07/15 11:56:21  peter
     * merged fixed relative path fix
 
   Revision 1.19  2001/07/08 21:00:16  peter

+ 201 - 37
compiler/script.pas

@@ -44,10 +44,37 @@ type
   end;
 
   TAsmScript = class (TScript)
-    Constructor Create(Const ScriptName : String);
-    Procedure AddAsmCommand (Const Command, Options,FileName : String);
-    Procedure AddLinkCommand (Const Command, Options, FileName : String);
-    Procedure AddDeleteCommand (Const FileName : String);
+    Constructor Create(Const ScriptName : String); virtual;
+    Procedure AddAsmCommand (Const Command, Options,FileName : String);virtual;abstract;
+    Procedure AddLinkCommand (Const Command, Options, FileName : String);virtual;abstract;
+    Procedure AddDeleteCommand (Const FileName : String);virtual;abstract;
+    Procedure AddDeleteDirCommand (Const FileName : String);virtual;abstract;
+  end;
+
+  TAsmScriptDos = class (TAsmScript)
+    Constructor Create (Const ScriptName : String); override;
+    Procedure AddAsmCommand (Const Command, Options,FileName : String);override;
+    Procedure AddLinkCommand (Const Command, Options, FileName : String);override;
+    Procedure AddDeleteCommand (Const FileName : String);override;
+    Procedure AddDeleteDirCommand (Const FileName : String);override;
+    Procedure WriteToDisk;override;
+  end;
+
+  TAsmScriptAmiga = class (TAsmScript)
+    Constructor Create (Const ScriptName : String); override;
+    Procedure AddAsmCommand (Const Command, Options,FileName : String);override;
+    Procedure AddLinkCommand (Const Command, Options, FileName : String);override;
+    Procedure AddDeleteCommand (Const FileName : String);override;
+    Procedure AddDeleteDirCommand (Const FileName : String);override;
+    Procedure WriteToDisk;override;
+  end;
+
+  TAsmScriptUnix = class (TAsmScript)
+    Constructor Create (Const ScriptName : String);override;
+    Procedure AddAsmCommand (Const Command, Options,FileName : String);override;
+    Procedure AddLinkCommand (Const Command, Options, FileName : String);override;
+    Procedure AddDeleteCommand (Const FileName : String);override;
+    Procedure AddDeleteDirCommand (Const FileName : String);override;
     Procedure WriteToDisk;override;
   end;
 
@@ -59,6 +86,8 @@ type
 var
   AsmRes : TAsmScript;
 
+Procedure GenerateAsmRes(const st : string);
+
 
 implementation
 
@@ -87,7 +116,7 @@ end;
 
 constructor TScript.CreateExec(const s:string);
 begin
-  fn:=FixFileName(s)+source_info.scriptext;
+  fn:=FixFileName(s)+target_info.scriptext;
   executable:=true;
   data:=TStringList.Create;
 end;
@@ -143,14 +172,18 @@ begin
 end;
 
 
-Procedure TAsmScript.AddAsmCommand (Const Command, Options,FileName : String);
+{****************************************************************************
+                                  Asm Response
+****************************************************************************}
+
+Constructor TAsmScriptDos.Create (Const ScriptName : String);
+begin
+  Inherited Create(ScriptName);
+end;
+
+
+Procedure TAsmScriptDos.AddAsmCommand (Const Command, Options,FileName : String);
 begin
-{$ifdef Unix}
-  if FileName<>'' then
-   Add('echo Assembling '+FileName);
-  Add (Command+' '+Options);
-  Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi');
-{$else}
   if FileName<>'' then
    begin
      Add('SET THEFILE='+FileName);
@@ -158,18 +191,11 @@ begin
    end;
   Add(command+' '+Options);
   Add('if errorlevel 1 goto asmend');
-{$endif}
 end;
 
 
-Procedure TasmScript.AddLinkCommand (Const Command, Options, FileName : String);
+Procedure TAsmScriptDos.AddLinkCommand (Const Command, Options, FileName : String);
 begin
-{$ifdef Unix}
-  if FileName<>'' then
-   Add('echo Linking '+FileName);
-  Add (Command+' '+Options);
-  Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi');
-{$else}
   if FileName<>'' then
    begin
      Add('SET THEFILE='+FileName);
@@ -177,29 +203,23 @@ begin
    end;
   Add (Command+' '+Options);
   Add('if errorlevel 1 goto linkend');
-{$endif}
 end;
 
 
-Procedure TAsmScript.AddDeleteCommand (Const FileName : String);
+Procedure TAsmScriptDos.AddDeleteCommand (Const FileName : String);
 begin
-{$ifdef Unix}
-  Add('rm '+FileName);
-{$else}
-  Add('Del '+FileName);
-{$endif}
+ Add('Del '+FileName);
 end;
 
 
-Procedure TAsmScript.WriteToDisk;
+Procedure TAsmScriptDos.AddDeleteDirCommand (Const FileName : String);
+begin
+ Add('Rmdir '+FileName);
+end;
+
+
+Procedure TAsmScriptDos.WriteToDisk;
 Begin
-{$ifdef Unix}
-  AddStart('{ echo "An error occurred while linking $1"; exit 1; }');
-  AddStart('DoExitLink ()');
-  AddStart('{ echo "An error occurred while assembling $1"; exit 1; }');
-  AddStart('DoExitAsm ()');
-  AddStart('#!/bin/sh');
-{$else}
   AddStart('@echo off');
   Add('goto end');
   Add(':asmend');
@@ -208,10 +228,151 @@ Begin
   Add(':linkend');
   Add('echo An error occured while linking %THEFILE%');
   Add(':end');
-{$endif}
   inherited WriteToDisk;
 end;
 
+{****************************************************************************
+                                  Amiga Asm Response
+****************************************************************************}
+
+Constructor TAsmScriptAmiga.Create (Const ScriptName : String);
+begin
+  Inherited Create(ScriptName);
+end;
+
+
+Procedure TAsmScriptAmiga.AddAsmCommand (Const Command, Options,FileName : String);
+begin
+  if FileName<>'' then
+   begin
+     Add('SET THEFILE '+FileName);
+     Add('echo Assembling $THEFILE');
+   end;
+  Add(command+' '+Options);
+  Add('if error');
+  Add('skip asmend');
+  Add('endif');
+end;
+
+
+Procedure TAsmScriptAmiga.AddLinkCommand (Const Command, Options, FileName : String);
+begin
+  if FileName<>'' then
+   begin
+     Add('SET THEFILE '+FileName);
+     Add('echo Linking $THEFILE');
+   end;
+  Add (Command+' '+Options);
+  Add('if error');
+  Add('skip linkend');
+  Add('endif');
+end;
+
+
+Procedure TAsmScriptAmiga.AddDeleteCommand (Const FileName : String);
+begin
+ Add('Delete '+FileName);
+end;
+
+
+Procedure TAsmScriptAmiga.AddDeleteDirCommand (Const FileName : String);
+begin
+ Add('Delete '+FileName);
+end;
+
+
+Procedure TAsmScriptAmiga.WriteToDisk;
+Begin
+  Add('skip end');
+  Add('lab asmend');
+  Add('echo An error occured while assembling $THEFILE');
+  Add('skip end');
+  Add('lab linkend');
+  Add('echo An error occured while linking $THEFILE');
+  Add('lab end');
+  inherited WriteToDisk;
+end;
+
+
+{****************************************************************************
+                              Unix Asm Response
+****************************************************************************}
+
+Constructor TAsmScriptUnix.Create (Const ScriptName : String);
+begin
+  Inherited Create(ScriptName);
+end;
+
+
+Procedure TAsmScriptUnix.AddAsmCommand (Const Command, Options,FileName : String);
+begin
+  if FileName<>'' then
+   Add('echo Assembling '+FileName);
+  Add (Command+' '+Options);
+  Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi');
+end;
+
+
+Procedure TAsmScriptUnix.AddLinkCommand (Const Command, Options, FileName : String);
+begin
+  if FileName<>'' then
+   Add('echo Linking '+FileName);
+  Add (Command+' '+Options);
+  Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi');
+end;
+
+
+Procedure TAsmScriptUnix.AddDeleteCommand (Const FileName : String);
+begin
+ Add('rm '+FileName);
+end;
+
+
+Procedure TAsmScriptUnix.AddDeleteDirCommand (Const FileName : String);
+begin
+ Add('rmdir '+FileName);
+end;
+
+
+Procedure TAsmScriptUnix.WriteToDisk;
+Begin
+  AddStart('{ echo "An error occurred while linking $1"; exit 1; }');
+  AddStart('DoExitLink ()');
+  AddStart('{ echo "An error occurred while assembling $1"; exit 1; }');
+  AddStart('DoExitAsm ()');
+  AddStart('#!/bin/sh');
+  inherited WriteToDisk;
+end;
+
+
+Procedure GenerateAsmRes(const st : string);
+begin
+{$ifdef i386}
+  case target_info.target of
+    target_i386_linux,
+    target_i386_freebsd,
+    target_i386_sunos,
+    target_i386_beos :
+      AsmRes:=TAsmScriptUnix.Create(st);
+    else
+      AsmRes:=TAsmScriptDos.Create(st);
+  end;
+{$else not i386}
+{$ifdef m68k}
+  case target_info.target of
+    target_m68k_amiga :
+      AsmRes:=TAsmScriptAmiga.Create(st);
+    target_m68k_linux :
+      AsmRes:=TAsmScriptUnix.Create(st);
+    else
+      AsmRes:=TAsmScriptDos.Create(st);
+  end;
+{$else not m68k}
+  AsmRes:=TAsmScriptUnix.Create(st);
+{$endif not m68k}
+{$endif not i386}
+end;
+
 
 {****************************************************************************
                                   Link Response
@@ -237,7 +398,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  2001-07-10 21:01:35  peter
+  Revision 1.11  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.10  2001/07/10 21:01:35  peter
     * fixed crash with writing of the linker script
 
   Revision 1.9  2001/04/18 22:01:58  peter

+ 5 - 4
compiler/symdef.pas

@@ -684,7 +684,7 @@ interface
        pbestrealtype : ^ttype = @s80floattype;
 {$endif}
 {$ifdef m68k}
-       pbestrealtype : ^ttype = @s32floattype;
+       pbestrealtype : ^ttype = @s64floattype;
 {$endif}
 {$ifdef alpha}
        pbestrealtype : ^ttype = @s64floattype;
@@ -1930,11 +1930,9 @@ implementation
             { found this solution in stabsread.c from GDB v4.16 }
             s64comp : stabstring := strpnew('r'+
                tstoreddef(s32bittype.def).numberstring+';-'+tostr(savesize)+';0;');
-{$ifdef i386}
             { under dos at least you must give a size of twelve instead of 10 !! }
             { this is probably do to the fact that in gcc all is pushed in 4 bytes size }
             s80real : stabstring := strpnew('r'+tstoreddef(s32bittype.def).numberstring+';12;0;');
-{$endif i386}
             else
               internalerror(10005);
          end;
@@ -5525,7 +5523,10 @@ Const local_symtable_index : longint = $8001;
 end.
 {
   $Log$
-  Revision 1.37  2001-07-30 11:52:57  jonas
+  Revision 1.38  2001-07-30 20:59:27  peter
+    * m68k updates from v10 merged
+
+  Revision 1.37  2001/07/30 11:52:57  jonas
     * fixed web bugs 1563/1564: procvars of object can't be regvars (merged)
 
   Revision 1.36  2001/07/01 20:16:16  peter

+ 12 - 4
compiler/tokens.pas

@@ -460,19 +460,24 @@ procedure create_tokenidx;
   length, so a search only will be done in that small part }
 var
   t : ttoken;
+  i : longint;
+  c : char;
 begin
   fillchar(tokenidx^,sizeof(tokenidx^),0);
   for t:=low(ttoken) to high(ttoken) do
    begin
      if not arraytokeninfo[t].special then
       begin
-        if ord(tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].first)=0 then
-         tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].first:=t;
-        tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].last:=t;
+        i:=length(arraytokeninfo[t].str);
+        c:=arraytokeninfo[t].str[1];
+        if ord(tokenidx^[i,c].first)=0 then
+         tokenidx^[i,c].first:=t;
+        tokenidx^[i,c].last:=t;
       end;
    end;
 end;
 
+
 procedure inittokens;
 begin
   tokeninfo:=@arraytokeninfo;
@@ -490,7 +495,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.11  2001-06-03 21:57:38  peter
+  Revision 1.12  2001-07-30 20:59:28  peter
+    * m68k updates from v10 merged
+
+  Revision 1.11  2001/06/03 21:57:38  peter
     + hint directive parsing support
 
   Revision 1.10  2001/05/06 17:12:43  jonas