* synchronized with trunk

git-svn-id: branches/wasm@46887 -

.gitattributes

@@ -16617,6 +16617,7 @@ tests/webtbf/tw37460.pp svneol=native#text/pascal
 tests/webtbf/tw37462.pp svneol=native#text/pascal
 tests/webtbf/tw37475.pp svneol=native#text/pascal
 tests/webtbf/tw37476.pp svneol=native#text/pascal
+tests/webtbf/tw37763.pp svneol=native#text/pascal
 tests/webtbf/tw3790.pp svneol=native#text/plain
 tests/webtbf/tw3812.pp svneol=native#text/plain
 tests/webtbf/tw3930a.pp svneol=native#text/plain
@@ -16758,6 +16759,7 @@ tests/webtbf/uw4541.pp svneol=native#text/pascal
 tests/webtbf/uw6922.pp svneol=native#text/plain
 tests/webtbf/uw8738a.pas svneol=native#text/plain
 tests/webtbf/uw8738b.pas svneol=native#text/plain
+tests/webtbs/DAT_TW37415 svneol=native#text/plain
 tests/webtbs/Integer.ns.pp svneol=native#text/pascal
 tests/webtbs/Integer.pp svneol=native#text/pascal
 tests/webtbs/tu2002.pp svneol=native#text/plain
@@ -18477,6 +18479,7 @@ tests/webtbs/tw37393.pp svneol=native#text/pascal
 tests/webtbs/tw37397.pp svneol=native#text/plain
 tests/webtbs/tw37398.pp svneol=native#text/pascal
 tests/webtbs/tw37400.pp svneol=native#text/pascal
+tests/webtbs/tw37415.pp svneol=native#text/plain
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw37423.pp svneol=native#text/plain
 tests/webtbs/tw37427.pp svneol=native#text/pascal

compiler/aarch64/cgcpu.pas

@@ -2507,7 +2507,7 @@ implementation
 
     procedure tcgaarch64.g_check_for_fpu_exception(list: TAsmList;force,clear : boolean);
       var
-        r : TRegister;
+        r, tmpreg: TRegister;
         ai: taicpu;
         l1,l2: TAsmLabel;
       begin
@@ -2516,18 +2516,17 @@ implementation
             (force or current_procinfo.FPUExceptionCheckNeeded)) then
           begin
             r:=getintregister(list,OS_INT);
+            tmpreg:=getintregister(list,OS_INT);
             list.concat(taicpu.op_reg_reg(A_MRS,r,NR_FPSR));
-            list.concat(taicpu.op_reg_const(A_TST,r,$1f));
+            list.concat(taicpu.op_reg_reg_const(A_AND,tmpreg,r,$1f));
             current_asmdata.getjumplabel(l1);
             current_asmdata.getjumplabel(l2);
-            ai:=taicpu.op_sym(A_B,l1);
+            ai:=taicpu.op_reg_sym_ofs(A_CBNZ,tmpreg,l1,0);
             ai.is_jmp:=true;
-            ai.condition:=C_NE;
             list.concat(ai);
-            list.concat(taicpu.op_reg_const(A_TST,r,$80));
-            ai:=taicpu.op_sym(A_B,l2);
+            list.concat(taicpu.op_reg_reg_const(A_AND,tmpreg,r,$80));
+            ai:=taicpu.op_reg_sym_ofs(A_CBZ,tmpreg,l2,0);
             ai.is_jmp:=true;
-            ai.condition:=C_EQ;
             list.concat(ai);
             a_label(list,l1);
             alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));

compiler/aoptobj.pas

@@ -344,6 +344,9 @@ Unit AoptObj;
         { removes p from asml, updates registers and replaces p with hp1 (if the next instruction was known beforehand) }
         procedure RemoveCurrentP(var p: tai; const hp1: tai); inline;
 
+        { removes hp from asml then frees it }
+        procedure RemoveInstruction(const hp: tai); inline;
+
        { traces sucessive jumps to their final destination and sets it, e.g.
          je l1                je l3
          <code>               <code>
@@ -1510,6 +1513,13 @@ Unit AoptObj;
       end;
 
 
+    procedure TAOptObj.RemoveInstruction(const hp: tai); inline;
+      begin
+        AsmL.Remove(hp);
+        hp.Free;
+      end;
+
+
     function FindLiveLabel(hp: tai; var l: tasmlabel): Boolean;
       var
         next: tai;

compiler/m68k/n68kmem.pas

@@ -99,7 +99,7 @@ implementation
 
         if (location.reference.base=NR_NO) and not (scaled) and not assigned(location.reference.symbol) then
           begin
-           { prefer an address reg, if we will be a base, for indexes any register works }
+            { prefer an address reg, if we will be a base, for indexes any register works }
             if isintregister(maybe_const_reg) then
               begin
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: copytoa')));
@@ -109,26 +109,33 @@ implementation
               end;
             location.reference.base:=maybe_const_reg;
           end
-        else if location.reference.index=NR_NO then
-          begin
-            location.reference.index:=maybe_const_reg;
-            if (scaled) then
-              location.reference.scalefactor:=l;
-          end
         else
           begin
-            hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
-            cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg);
-            reference_reset_base(location.reference,hreg,0,location.reference.temppos,location.reference.alignment,location.reference.volatility);
+            if location.reference.index<>NR_NO then
+              begin
+                { if we already have an index register, dereference the ref to a new base, to be able to insert an index }
+                hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg);
+                reference_reset_base(location.reference,hreg,0,location.reference.temppos,location.reference.alignment,location.reference.volatility);
+              end;
+            if def_cgsize(regsize) in [OS_8,OS_16] then
+              begin
+                { index registers are always sign extended on m68k, so we have to zero extend by hand,
+                  if the index variable is unsigned, and its width is less than the whole register }
+                //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: index zero extend')));
+                hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,def_cgsize(regsize),OS_ADDR,maybe_const_reg,hreg);
+                maybe_const_reg:=hreg;
+              end;
             { insert new index register }
             location.reference.index:=maybe_const_reg;
             if (scaled) then
               location.reference.scalefactor:=l;
           end;
-          { update alignment }
-          if (location.reference.alignment=0) then
-            internalerror(2009020704);
-          location.reference.alignment:=newalignment(location.reference.alignment,l);
+        { update alignment }
+        if (location.reference.alignment=0) then
+          internalerror(2009020704);
+        location.reference.alignment:=newalignment(location.reference.alignment,l);
       end;
 
      { see remarks for tcgvecnode.update_reference_reg_mul above }

compiler/msg/errore.msg

@@ -2064,6 +2064,9 @@ type_e_forward_interface_type_does_not_match=04127_E_The interface type of the f
 type_e_generic_const_type_not_allowed=04128_E_Type not allowed for generic constant parameter: $1
 % Only types that can also be used (indirectly) for untyped constants can be used as a
 % type for a generic constant parameter.
+type_e_cant_read_write_type_in_iso_mode=04129_E_Can't read or write variables of this type in iso mode
+% You are trying to \var{read} or \var{write} a variable from or to a
+% file of type text, which doesn't support that variable's type in the selected language mode (iso mode).
 % \end{description}
 #
 # Symtable

compiler/msgidx.inc

@@ -585,6 +585,7 @@ const
   type_e_cblock_callconv=04126;
   type_e_forward_interface_type_does_not_match=04127;
   type_e_generic_const_type_not_allowed=04128;
+  type_e_cant_read_write_type_in_iso_mode=04129;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -1126,9 +1127,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 85732;
+  MsgTxtSize = 85795;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,356,129,99,63,143,36,223,68,
+    28,106,356,130,99,63,143,36,223,68,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/ngenutil.pas

@@ -105,9 +105,9 @@ interface
       class procedure insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint; _typ: Tasmsymtype); virtual;
 
       { initialization of iso styled program parameters }
-      class procedure initialize_textrec(p : TObject; statn : pointer);
+      class procedure initialize_filerecs(p : TObject; statn : pointer);
       { finalization of iso styled program parameters }
-      class procedure finalize_textrec(p : TObject; statn : pointer);
+      class procedure finalize_filerecs(p : TObject; statn : pointer);
      public
       class procedure insertbssdata(sym : tstaticvarsym); virtual;
 
@@ -546,49 +546,83 @@ implementation
     end;
 
 
-  class procedure tnodeutils.initialize_textrec(p:TObject;statn:pointer);
+  class procedure tnodeutils.initialize_filerecs(p:TObject;statn:pointer);
     var
       stat: ^tstatementnode absolute statn;
     begin
       if (tsym(p).typ=staticvarsym) and
-       (tstaticvarsym(p).vardef.typ=filedef) and
-       (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
-       (tstaticvarsym(p).isoindex<>0) then
-       begin
-         if cs_transparent_file_names in current_settings.globalswitches then
-           addstatement(stat^,ccallnode.createintern('fpc_textinit_filename_iso',
-             ccallparanode.create(
-               cstringconstnode.createstr(tstaticvarsym(p).Name),
-             ccallparanode.create(
-               cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
-             ccallparanode.create(
-               cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
-             nil)))))
-         else
-           addstatement(stat^,ccallnode.createintern('fpc_textinit_iso',
-             ccallparanode.create(
-               cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
-             ccallparanode.create(
-               cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
-             nil))));
-       end;
+        (tstaticvarsym(p).vardef.typ=filedef) and
+        (tstaticvarsym(p).isoindex<>0) then
+        case tfiledef(tstaticvarsym(p).vardef).filetyp of
+          ft_text:
+            begin
+              if cs_transparent_file_names in current_settings.globalswitches then
+                addstatement(stat^,ccallnode.createintern('fpc_textinit_filename_iso',
+                  ccallparanode.create(
+                    cstringconstnode.createstr(tstaticvarsym(p).Name),
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil)))))
+              else
+                addstatement(stat^,ccallnode.createintern('fpc_textinit_iso',
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil))));
+            end;
+          ft_typed:
+            begin
+              if cs_transparent_file_names in current_settings.globalswitches then
+                addstatement(stat^,ccallnode.createintern('fpc_typedfile_init_filename_iso',
+                  ccallparanode.create(
+                    cstringconstnode.createstr(tstaticvarsym(p).Name),
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil)))))
+              else
+                addstatement(stat^,ccallnode.createintern('fpc_typedfile_init_iso',
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil))));
+            end;
+          else
+            ;
+        end;
     end;
 
 
-  class procedure tnodeutils.finalize_textrec(p:TObject;statn:pointer);
+  class procedure tnodeutils.finalize_filerecs(p:TObject;statn:pointer);
     var
       stat: ^tstatementnode absolute statn;
     begin
       if (tsym(p).typ=staticvarsym) and
-       (tstaticvarsym(p).vardef.typ=filedef) and
-       (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
-       (tstaticvarsym(p).isoindex<>0) then
-       begin
-         addstatement(stat^,ccallnode.createintern('fpc_textclose_iso',
-           ccallparanode.create(
-             cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
-           nil)));
-       end;
+        (tstaticvarsym(p).vardef.typ=filedef) and
+        (tstaticvarsym(p).isoindex<>0) then
+        case tfiledef(tstaticvarsym(p).vardef).filetyp of
+          ft_text:
+            begin
+              addstatement(stat^,ccallnode.createintern('fpc_textclose_iso',
+                ccallparanode.create(
+                  cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                nil)));
+            end;
+          ft_typed:
+            begin
+              addstatement(stat^,ccallnode.createintern('fpc_typedfile_close_iso',
+                ccallparanode.create(
+                  cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                nil)));
+            end;
+          else
+            ;
+        end;
     end;
 
 
@@ -637,9 +671,9 @@ implementation
         (pd.proctypeoption=potype_proginit) then
         begin
           block:=internalstatements(stat);
-          pd.localst.SymList.ForEachCall(@initialize_textrec,@stat);
+          pd.localst.SymList.ForEachCall(@initialize_filerecs,@stat);
           addstatement(stat,result);
-          pd.localst.SymList.ForEachCall(@finalize_textrec,@stat);
+          pd.localst.SymList.ForEachCall(@finalize_filerecs,@stat);
           result:=block;
         end;
 

compiler/ninl.pas

@@ -765,7 +765,14 @@ implementation
           else
             case para.left.resultdef.typ of
               stringdef :
-                name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname;
+                begin
+                  name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname;
+                  if (m_isolike_io in current_settings.modeswitches) and (tstringdef(para.left.resultdef).stringtype<>st_shortstring) then
+                    begin
+                      CGMessagePos(para.fileinfo,type_e_cant_read_write_type_in_iso_mode);
+                      error_para := true;
+                    end;
+                end;
               pointerdef :
                 begin
                   if (not is_pchar(para.left.resultdef)) or do_read then

compiler/ogcoff.pas

@@ -914,6 +914,64 @@ const pemagic : array[0..3] of byte = (
       end;
 
 
+    function encodeBase64(p:aword):string;
+      const
+        alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
+                   'abcdefghijklmnopqrstuvwxyz' +
+                   '0123456789+/';
+      var
+        i,
+        idx,
+        rem : longint;
+      begin
+        setlength(result,6);
+
+        idx := 6;
+        for i:=0 to 5 do
+          begin
+            rem:=p mod 64;
+            p:=p div 64;
+            result[idx]:=alphabet[rem+1];
+            dec(idx);
+          end;
+
+        if p<>0 then
+          internalerror(2020091601);
+      end;
+
+
+    function decodeBase64(const s:string;out p:longint):boolean;
+      var
+        i : longint;
+        v : aword;
+      begin
+        if length(s)>6 then
+          exit(false);
+
+        p:=0;
+        for i:=1 to length(s) do
+          begin
+            v:=0;
+            if (s[i]>='A') and (s[i]<='Z') then // 0..25
+              v:=Ord(s[i])-Ord('A')
+            else if (s[i]>='a') and (s[i]<='z') then // 26..51
+              v:=Ord(s[i])-Ord('a')+26
+            else if (s[i]>='0') and (s[i]<='9') then // 52..61
+              v:=Ord(s[i])-Ord('0')+52
+            else if s[i]='+' then // 62
+              v:=62
+            else if s[i]='/' then // 63
+              v:=63
+            else
+              exit(false);
+
+            p:=(p*64)+v;
+          end;
+
+        result:=true;
+      end;
+
+
 {****************************************************************************
                                TCoffObjSection
 ****************************************************************************}
@@ -1652,7 +1710,12 @@ const pemagic : array[0..3] of byte = (
                strpos:=FCoffStrs.size+4;
                FCoffStrs.writestr(s);
                FCoffStrs.writestr(#0);
-               s:='/'+ToStr(strpos);
+               if strpos>=10000000 then
+                 s:='//'+encodeBase64(strpos)
+               else
+                 s:='/'+ToStr(strpos);
+               if length(s)>8 then
+                 internalerror(2020091501);
              end;
             move(s[1],sechdr.name,length(s));
             if not win32 then
@@ -2323,13 +2386,26 @@ const pemagic : array[0..3] of byte = (
                secname:=strpas(secnamebuf);
                if secname[1]='/' then
                  begin
-                   Val(Copy(secname,2,8),strpos,code);
-                   if code=0 then
-                     secname:=Read_str(strpos)
+                   if secname[2]='/' then
+                     begin
+                       if not decodeBase64(copy(secname,3,8),strpos) then
+                         begin
+                           InputError('Error reading COFF Section Headers');
+                           secname:='error';
+                         end
+                       else
+                         secname:=Read_str(strpos);
+                     end
                    else
                      begin
-                       InputError('Error reading COFF Section Headers');
-                       secname:='error';
+                       Val(Copy(secname,2,8),strpos,code);
+                       if code=0 then
+                         secname:=Read_str(strpos)
+                       else
+                         begin
+                           InputError('Error reading COFF Section Headers');
+                           secname:='error';
+                         end;
                      end;
                  end;
                if win32 then

compiler/x86/aoptx86.pas

@@ -1090,8 +1090,7 @@ unit aoptx86;
                   else
                     Internalerror(2017050701)
                 end;
-                asml.remove(hp1);
-                hp1.free;
+                RemoveInstruction(hp1);
               end;
           end;
       end;
@@ -1383,8 +1382,7 @@ unit aoptx86;
                (getregtype(tai_regalloc(hp2).reg) = R_INTREGISTER) and
                (getsupreg(tai_regalloc(hp2).reg) = supreg) then
               begin
-                asml.remove(hp2);
-                hp2.free;
+                RemoveInstruction(hp2);
                 break;
               end;
           until not(assigned(hp2)) or regInInstruction(newreg(R_INTREGISTER,supreg,R_SUBWHOLE),hp2);
@@ -1444,8 +1442,7 @@ unit aoptx86;
                       begin
                         DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVA*2(V)MOVA* 1',p);
                         taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
-                        asml.Remove(hp1);
-                        hp1.Free;
+                        RemoveInstruction(hp1);
                         result:=true;
                         exit;
                       end
@@ -1457,8 +1454,7 @@ unit aoptx86;
                     else if MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[1]^) then
                       begin
                         DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVA*2(V)MOVA* 2',p);
-                        asml.Remove(hp1);
-                        hp1.Free;
+                        RemoveInstruction(hp1);
                         result:=true;
                         exit;
                       end
@@ -1482,8 +1478,7 @@ unit aoptx86;
                       DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVS*2(V)MOVS* 1',p);
                       taicpu(p).opcode:=taicpu(hp1).opcode;
                       taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
-                      asml.Remove(hp1);
-                      hp1.Free;
+                      RemoveInstruction(hp1);
                       result:=true;
                       exit;
                     end
@@ -1566,8 +1561,7 @@ unit aoptx86;
                       begin
                         taicpu(hp1).loadoper(2,taicpu(p).oper[0]^);
                         RemoveCurrentP(p, hp1); // <-- Is this actually safe? hp1 is not necessarily the next instruction. [Kit]
-                        asml.Remove(hp2);
-                        hp2.Free;
+                        RemoveInstruction(hp2);
                       end;
                   end
                 else if (hp1.typ = ait_instruction) and
@@ -1606,8 +1600,7 @@ unit aoptx86;
                           RemoveCurrentP(p, nil);
                         p:=hp1;
                         taicpu(hp1).loadoper(1, taicpu(hp2).oper[1]^);
-                        asml.remove(hp2);
-                        hp2.Free;
+                        RemoveInstruction(hp2);
                         result:=true;
                       end;
                   end;
@@ -1643,8 +1636,7 @@ unit aoptx86;
               begin
                 taicpu(p).loadoper(2,taicpu(hp1).oper[1]^);
                 DebugMsg(SPeepholeOptimization + 'VOpVmov2VOp done',p);
-                asml.Remove(hp1);
-                hp1.Free;
+                RemoveInstruction(hp1);
                 result:=true;
               end;
           end;
@@ -1972,9 +1964,7 @@ unit aoptx86;
                   begin
                     { We can remove the original MOV }
                     DebugMsg(SPeepholeOptimization + 'Mov2Nop 3 done',p);
-                    Asml.Remove(p);
-                    p.Free;
-                    p := hp1;
+                    RemoveCurrentp(p, hp1);
 
                     { TmpUsedRegs contains the results of "UpdateUsedRegs(tai(p.Next))" already,
                       so just restore it to UsedRegs instead of calculating it again }
@@ -2042,8 +2032,7 @@ unit aoptx86;
                       begin
                         GetNextInstruction_p := GetNextInstruction(hp1, hp2);
                         DebugMsg(SPeepholeOptimization + 'Mov2Nop 4 done',hp1);
-                        asml.remove(hp1);
-                        hp1.free;
+                        RemoveInstruction(hp1);
 
                         { The instruction after what was hp1 is now the immediate next instruction,
                           so we can continue to make optimisations if it's present }
@@ -2130,8 +2119,7 @@ unit aoptx86;
                               InternalError(2020021001);
                           end;
                           DebugMsg(SPeepholeOptimization + 'MovMovXX2MovXX 2 done',p);
-                          asml.Remove(hp1);
-                          hp1.Free;
+                          RemoveInstruction(hp1);
                           Result := True;
                           Exit;
                         end;
@@ -2186,8 +2174,7 @@ unit aoptx86;
                             and ffffffffh, %reg
                         }
                         DebugMsg(SPeepholeOptimization + 'MovAnd2Mov 1 done',p);
-                        asml.remove(hp1);
-                        hp1.free;
+                        RemoveInstruction(hp1);
                         Result:=true;
                         exit;
                       end;
@@ -2199,8 +2186,7 @@ unit aoptx86;
                             and ffffffffffffffffh, %reg
                         }
                         DebugMsg(SPeepholeOptimization + 'MovAnd2Mov 2 done',p);
-                        asml.remove(hp1);
-                        hp1.free;
+                        RemoveInstruction(hp1);
                         Result:=true;
                         exit;
                       end;
@@ -2225,8 +2211,7 @@ unit aoptx86;
                         DebugMsg(SPeepholeOptimization + 'MovAndTest2Test done',p);
                         taicpu(hp1).loadoper(1,taicpu(p).oper[0]^);
                         taicpu(hp1).opcode:=A_TEST;
-                        asml.Remove(hp2);
-                        hp2.free;
+                        RemoveInstruction(hp2);
                         RemoveCurrentP(p, hp1);
                         Result:=true;
                         exit;
@@ -2325,8 +2310,7 @@ unit aoptx86;
                         DebugMsg(SPeepholeOptimization + PreMessage + '; and' + debug_opsize2str(taicpu(hp1).opsize) + ' $' + MaskNum + ',' + RegName2 +
                           ' -> movz' + debug_opsize2str(NewSize) + ' ' + InputVal + ',' + RegName2, p);
 
-                        asml.Remove(hp1);
-                        hp1.Free;
+                        RemoveInstruction(hp1);
                       end;
 
                     Result := True;
@@ -2375,8 +2359,7 @@ unit aoptx86;
                                 AllocRegBetween(taicpu(hp1).oper[1]^.reg,p,hp1,usedregs);
                               taicpu(p).loadOper(1,taicpu(hp1).oper[1]^);
                               DebugMsg(SPeepholeOptimization + 'MovMov2Mov 5 done',p);
-                              asml.remove(hp1);
-                              hp1.free;
+                              RemoveInstruction(hp1);
                               Result:=true;
                               Exit;
                             end;
@@ -2394,8 +2377,7 @@ unit aoptx86;
                             }
                             taicpu(p).loadreg(1, taicpu(hp1).oper[1]^.reg);
                             DebugMsg(SPeepholeOptimization + 'MovMov2Mov 3 done',p);
-                            asml.remove(hp1);
-                            hp1.free;
+                            RemoveInstruction(hp1);
                             Result:=true;
                             Exit;
                           end;
@@ -2438,8 +2420,7 @@ unit aoptx86;
                         if taicpu(p).oper[0]^.typ=top_reg then
                           AllocRegBetween(taicpu(p).oper[0]^.reg,p,hp1,usedregs);
                         DebugMsg(SPeepholeOptimization + 'MovMov2Mov 1',p);
-                        asml.remove(hp1);
-                        hp1.free;
+                        RemoveInstruction(hp1);
                         Result:=true;
                         exit;
                       end
@@ -2462,8 +2443,7 @@ unit aoptx86;
                              cmp mem1, reg1
                            }
                           begin
-                            asml.remove(hp2);
-                            hp2.free;
+                            RemoveInstruction(hp2);
                             taicpu(hp1).opcode := A_CMP;
                             taicpu(hp1).loadref(1,taicpu(hp1).oper[0]^.ref^);
                             taicpu(hp1).loadreg(0,taicpu(p).oper[0]^.reg);
@@ -2502,8 +2482,7 @@ unit aoptx86;
                           DebugMsg(SPeepholeOptimization + 'MovMovMov2MovMov 1 done',p);
                           taicpu(p).loadoper(1,taicpu(hp2).oper[1]^);
                           taicpu(hp1).loadoper(0,taicpu(hp2).oper[1]^);
-                          asml.remove(hp2);
-                          hp2.free;
+                          RemoveInstruction(hp2);
                         end
 {$ifdef i386}
                       { this is enabled for i386 only, as the rules to create the reg sets below
@@ -2548,8 +2527,7 @@ unit aoptx86;
                         end
                       else
                         begin
-                          asml.remove(hp2);
-                          hp2.free;
+                          RemoveInstruction(hp2);
                         end
 {$endif i386}
                         ;
@@ -2663,13 +2641,11 @@ unit aoptx86;
                                 begin
                                   DebugMsg(SPeepholeOptimization + debug_regname(CurrentReg) + ' = ' + RegName1 + '; removed unnecessary instruction (MovMov2MovNop 6b}',hp2);
                                   AllocRegBetween(CurrentReg, p, hp2, UsedRegs);
-                                  asml.remove(hp2);
-                                  hp2.Free;
+                                  RemoveInstruction(hp2);
                                 end
                               else
                                 begin
-                                  asml.remove(hp2);
-                                  hp2.Free;
+                                  RemoveInstruction(hp2);
 
                                   { We can remove the original MOV too }
                                   DebugMsg(SPeepholeOptimization + 'MovMov2NopNop 6b done',p);
@@ -2769,8 +2745,7 @@ unit aoptx86;
 
                     DebugMsg(SPeepholeOptimization + 'Removed movs/z instruction and extended earlier write (MovMovs/z2Mov/s/z)', hp2);
                     AllocRegBetween(taicpu(hp2).oper[1]^.reg, p, hp2, UsedRegs);
-                    AsmL.Remove(hp2);
-                    hp2.Free;
+                    RemoveInstruction(hp2);
 
                     Result := True;
                     Exit;
@@ -2800,8 +2775,7 @@ unit aoptx86;
                         and ffffffffh, %reg
                     }
                     DebugMsg(SPeepholeOptimization + 'MovAnd2Mov 3 done',p);
-                    asml.remove(hp2);
-                    hp2.free;
+                    RemoveInstruction(hp2);
                     Result:=true;
                     exit;
                   end;
@@ -2833,9 +2807,7 @@ unit aoptx86;
             )
           ) then
           begin
-            asml.remove(p);
-            p.free;
-            p:=hp1;
+            RemoveCurrentp(p, hp1);
             DebugMsg(SPeepholeOptimization + 'removed deadstore before leave/ret',p);
             RemoveLastDeallocForFuncRes(p);
             Result:=true;
@@ -2975,8 +2947,7 @@ unit aoptx86;
                       ->
                         decw    %si             addw    %dx,%si       p
                     }
-                    asml.remove(hp2);
-                    hp2.Free;
+                    RemoveInstruction(hp2);
                     RemoveCurrentP(p, hp1);
                     Result:=True;
                     Exit;
@@ -3060,8 +3031,7 @@ unit aoptx86;
                       ->
                         decw    %si             addw    %dx,%si       p
                     }
-                    asml.remove(hp2);
-                    hp2.Free;
+                    RemoveInstruction(hp2);
                   end;
               end;
 
@@ -3080,9 +3050,7 @@ unit aoptx86;
             Taicpu(hp2).opcode:=A_MOV;
             asml.remove(hp1);
             insertllitem(hp2,hp2.next,hp1);
-            asml.remove(p);
-            p.free;
-            p:=hp1;
+            RemoveCurrentp(p, hp1);
             Result:=true;
             exit;
           end;
@@ -3124,15 +3092,15 @@ unit aoptx86;
                         if (taicpu(p).oper[1]^.typ=top_reg) and
                           not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,UsedRegs)) then
                           begin
-                            asml.remove(p);
-                            p.free;
-                            GetNextInstruction(hp1,p);
                             DebugMsg(SPeepholeOptimization + 'MovXXMovXX2Nop 1 done',p);
+                            RemoveInstruction(hp1);
+                            RemoveCurrentp(p); { p will now be equal to the instruction that follows what was hp1 }
                           end
                         else
-                          DebugMsg(SPeepholeOptimization + 'MovXXMovXX2MoVXX 1 done',p);
-                        asml.remove(hp1);
-                        hp1.free;
+                          begin
+                            DebugMsg(SPeepholeOptimization + 'MovXXMovXX2MoVXX 1 done',p);
+                            RemoveInstruction(hp1);
+                          end;
                         Result:=true;
                         exit;
                       end
@@ -3171,8 +3139,7 @@ unit aoptx86;
                 taicpu(p).loadoper(0,taicpu(hp1).oper[0]^);
                 taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
                 DebugMsg(SPeepholeOptimization + 'OpMov2Op done',p);
-                asml.Remove(hp1);
-                hp1.Free;
+                RemoveInstruction(hp1);
                 result:=true;
               end;
           end;
@@ -3243,8 +3210,7 @@ unit aoptx86;
               begin
                 taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
                 DebugMsg(SPeepholeOptimization + 'LeaMov2Lea done',p);
-                asml.Remove(hp1);
-                hp1.Free;
+                RemoveInstruction(hp1);
                 result:=true;
               end;
           end;
@@ -3403,16 +3369,14 @@ unit aoptx86;
                 MatchOperand(taicpu(hp1).oper[0]^,taicpu(p).oper[1]^) then
                 begin
                   taicpu(p).loadConst(0,taicpu(p).oper[0]^.val+1);
-                  asml.remove(hp1);
-                  hp1.free;
+                  RemoveInstruction(hp1);
                 end;
              A_SUB:
                if MatchOpType(taicpu(hp1),top_const,top_reg) and
                  MatchOperand(taicpu(hp1).oper[1]^,taicpu(p).oper[1]^) then
                  begin
                    taicpu(p).loadConst(0,taicpu(p).oper[0]^.val+taicpu(hp1).oper[0]^.val);
-                   asml.remove(hp1);
-                   hp1.free;
+                   RemoveInstruction(hp1);
                  end;
              A_ADD:
                begin
@@ -3420,13 +3384,11 @@ unit aoptx86;
                    MatchOperand(taicpu(hp1).oper[1]^,taicpu(p).oper[1]^) then
                    begin
                      taicpu(p).loadConst(0,taicpu(p).oper[0]^.val-taicpu(hp1).oper[0]^.val);
-                     asml.remove(hp1);
-                     hp1.free;
+                     RemoveInstruction(hp1);
                      if (taicpu(p).oper[0]^.val = 0) then
                        begin
                          hp1 := tai(p.next);
-                         asml.remove(p);
-                         p.free;
+                         RemoveInstruction(p); { Note, the choice to not use RemoveCurrentp is deliberate }
                          if not GetLastInstruction(hp1, p) then
                            p := hp1;
                          DoSubAddOpt := True;
@@ -3474,9 +3436,7 @@ unit aoptx86;
                     if taicpu(hp1).oper[0]^.typ=top_reg then
                       setsubreg(taicpu(hp1).oper[0]^.reg,R_SUBWHOLE);
                     hp1 := tai(p.next);
-                    asml.remove(p);
-                    p.free;
-                    p := hp1;
+                    RemoveCurrentp(p, hp1);
                     Result:=true;
                     exit;
                   end;
@@ -3546,8 +3506,7 @@ unit aoptx86;
                         if taicpu(hp1).oper[0]^.ref^.scalefactor<>0 then
                           tmpref.scalefactor:=tmpref.scalefactor*taicpu(hp1).oper[0]^.ref^.scalefactor;
                         TmpRef.base := taicpu(hp1).oper[0]^.ref^.base;
-                        asml.remove(hp1);
-                        hp1.free;
+                        RemoveInstruction(hp1);
                       end
                   end
                 else if (taicpu(hp1).oper[0]^.typ = Top_Const) then
@@ -3562,8 +3521,7 @@ unit aoptx86;
                       else
                         internalerror(2019050536);
                     end;
-                    asml.remove(hp1);
-                    hp1.free;
+                    RemoveInstruction(hp1);
                   end
                 else
                   if (taicpu(hp1).oper[0]^.typ = Top_Reg) and
@@ -3584,8 +3542,7 @@ unit aoptx86;
                         else
                           internalerror(2019050535);
                       end;
-                      asml.remove(hp1);
-                      hp1.free;
+                      RemoveInstruction(hp1);
                     end;
               end;
             if TmpBool2
@@ -3715,14 +3672,12 @@ unit aoptx86;
                         { Don't remove the 'mov' instruction if its register is used elsewhere }
                         if not(RegUsedAfterInstruction(taicpu(hp1).oper[1]^.reg, hp2, TmpUsedRegs)) then
                           begin
-                            asml.Remove(hp1);
-                            hp1.Free;
+                            RemoveInstruction(hp1);
                             Result := True;
                           end;
 
                         { Only set Result to True if the 'mov' instruction was removed }
-                        asml.Remove(hp2);
-                        hp2.Free;
+                        RemoveInstruction(hp2);
                       end;
                   end
                 else
@@ -3734,8 +3689,7 @@ unit aoptx86;
                     if not(RegUsedAfterInstruction(NR_DEFAULTFLAGS, hp1, TmpUsedRegs)) then
                       begin
                         DebugMsg(SPeepholeOptimization + 'ShlAnd2Shl', p);
-                        asml.Remove(hp1);
-                        hp1.Free;
+                        RemoveInstruction(hp1);
                         Result := True;
                       end;
                   end;
@@ -3825,8 +3779,7 @@ unit aoptx86;
                   Exit;
               end;
 
-            asml.Remove(hp1);
-            hp1.Free;
+            RemoveInstruction(hp1);
 
             if Unconditional then
               MakeUnconditional(taicpu(hp2))
@@ -3840,11 +3793,8 @@ unit aoptx86;
 
             if not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp2, TmpUsedRegs) then
               begin
-                asml.Remove(p);
-                UpdateUsedRegs(next);
-                p.Free;
+                RemoveCurrentp(p, hp2);
                 Result := True;
-                p := hp2;
               end;
 
             DebugMsg(SPeepholeOptimization + 'SETcc/TESTCmp/Jcc -> Jcc',p);
@@ -3879,11 +3829,8 @@ unit aoptx86;
                    (taicpu(p).oper[0]^.ref^.offset < tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)) and
                (taicpu(p).oper[0]^.ref^.index = NR_NO) then
               begin
-                asml.remove(p);
-                asml.remove(hp1);
-                p.free;
-                hp1.free;
-                p := hp2;
+                RemoveInstruction(hp1);
+                RemoveCurrentP(p, hp2);
                 RemoveLastDeallocForFuncRes(p);
                 Result := true;
               end
@@ -3896,8 +3843,7 @@ unit aoptx86;
                   if (taicpu(p).opcode = A_FSTP) then
                     taicpu(p).opcode := A_FST
                   else taicpu(p).opcode := A_FIST;
-                  asml.remove(hp1);
-                  hp1.free;
+                  RemoveInstruction(hp1);
                 end
             *)
           end;
@@ -3937,9 +3883,7 @@ unit aoptx86;
                     end;
                     taicpu(hp1).oper[0]^.reg := taicpu(p).oper[0]^.reg;
                     taicpu(hp1).oper[1]^.reg := NR_ST;
-                    asml.remove(p);
-                    p.free;
-                    p := hp1;
+                    RemoveCurrentP(p, hp1);
                     Result:=true;
                     exit;
                   end;
@@ -3967,9 +3911,7 @@ unit aoptx86;
                   faddp/                       fmul     st, st
                   fmulp  st, st1 (hp2) }
                 begin
-                  asml.remove(p);
-                  p.free;
-                  p := hp1;
+                  RemoveCurrentP(p, hp1);
                   if (taicpu(hp2).opcode = A_FADDP) then
                     taicpu(hp2).opcode := A_FADD
                   else
@@ -4004,8 +3946,7 @@ unit aoptx86;
                         else
                           internalerror(2019050533);
                       end;
-                      asml.remove(hp2);
-                      hp2.free;
+                      RemoveInstruction(hp2);
                     end
                   else
                     ;
@@ -4055,8 +3996,7 @@ unit aoptx86;
                              begin
                                DebugMsg(SPeepholeOptimization + 'Cmpcc2Testcc - condition B/C/NAE/O --> Never (jump removed)', hp1);
                                TAsmLabel(taicpu(hp1).oper[0]^.ref^.symbol).decrefs;
-                               AsmL.Remove(hp1);
-                               hp1.Free;
+                               RemoveInstruction(hp1);
                                { Since hp1 was deleted, hp2 must not be updated }
                                Continue;
                              end
@@ -4221,8 +4161,7 @@ unit aoptx86;
          MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^) then
          begin
            DebugMsg(SPeepholeOptimization + 'PXorPXor2PXor done',hp1);
-           asml.Remove(hp1);
-           hp1.Free;
+           RemoveInstruction(hp1);
            Result:=true;
            Exit;
          end;
@@ -4249,8 +4188,7 @@ unit aoptx86;
          MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^,taicpu(hp1).oper[2]^) then
          begin
            DebugMsg(SPeepholeOptimization + 'VPXorVPXor2PXor done',hp1);
-           asml.Remove(hp1);
-           hp1.Free;
+           RemoveInstruction(hp1);
            Result:=true;
            Exit;
          end;
@@ -4348,8 +4286,7 @@ unit aoptx86;
                 taicpu(p).opcode := A_LEA;
                 taicpu(p).loadref(0, NewRef);
 
-                Asml.Remove(hp1);
-                hp1.Free;
+                RemoveInstruction(hp1);
 
                 Result := True;
                 Exit;
@@ -4379,9 +4316,7 @@ unit aoptx86;
               not RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)
             then
               begin
-                asml.remove(p);
-                p.free;
-                p := hp1;
+                RemoveCurrentP(p, hp1);
                 Result:=true;
               end;
 
@@ -4420,12 +4355,9 @@ unit aoptx86;
                 AllocRegBetween(taicpu(hp2).oper[1]^.reg, p, hp1, UsedRegs);
                 taicpu(hp1).opcode := A_XCHG;
 
-                asml.Remove(p);
-                asml.Remove(hp2);
-                p.Free;
-                hp2.Free;
+                RemoveCurrentP(p, hp1);
+                RemoveInstruction(hp2);
 
-                p := hp1;
                 Result := True;
                 Exit;
               end;
@@ -4449,8 +4381,7 @@ unit aoptx86;
                             cltd
                         }
                         DebugMsg(SPeepholeOptimization + 'MovSar2Cltd', p);
-                        Asml.Remove(hp1);
-                        hp1.Free;
+                        RemoveInstruction(hp1);
                         taicpu(p).opcode := A_CDQ;
                         taicpu(p).opsize := S_NO;
                         taicpu(p).clearop(1);
@@ -4531,8 +4462,7 @@ unit aoptx86;
                             taicpu(p).clearop(0);
                             taicpu(p).ops:=0;
 
-                            AsmL.Remove(hp1);
-                            hp1.Free;
+                            RemoveInstruction(hp1);
 
                             taicpu(hp2).loadreg(0, NR_EDX);
                             taicpu(hp2).loadreg(1, NR_EAX);
@@ -4578,8 +4508,7 @@ unit aoptx86;
                         cqto
                     }
                     DebugMsg(SPeepholeOptimization + 'MovSar2Cqto', p);
-                    Asml.Remove(hp1);
-                    hp1.Free;
+                    RemoveInstruction(hp1);
                     taicpu(p).opcode := A_CQO;
                     taicpu(p).opsize := S_NO;
                     taicpu(p).clearop(1);
@@ -4660,8 +4589,7 @@ unit aoptx86;
                     taicpu(hp1).clearop(0);
                     taicpu(hp1).ops:=0;
 
-                    AsmL.Remove(hp2);
-                    hp2.Free;
+                    RemoveInstruction(hp2);
 (*
 {$ifdef x86_64}
                   end
@@ -4708,8 +4636,7 @@ unit aoptx86;
                     taicpu(hp1).clearop(0);
                     taicpu(hp1).ops:=0;
 
-                    AsmL.Remove(hp2);
-                    hp2.Free;
+                    RemoveInstruction(hp2);
 {$endif x86_64}
 *)
                   end;
@@ -4799,8 +4726,7 @@ unit aoptx86;
             taicpu(hp1).opcode := A_ADD;
 
             { Delete old ADD/LEA instruction }
-            asml.remove(hp2);
-            hp2.free;
+            RemoveInstruction(hp2);
 
             { Convert "shrq $1, reg1q" to "rcr $1, reg1d" }
             taicpu(hp3).opcode := A_RCR;
@@ -4839,8 +4765,7 @@ unit aoptx86;
                 taicpu(p).loadreg(2,taicpu(p).oper[1]^.reg);
                 taicpu(p).loadreg(1,taicpu(hp1).oper[0]^.reg);
                 DebugMsg(SPeepholeOptimization + 'MovImul2Imul done',p);
-                asml.remove(hp1);
-                hp1.free;
+                RemoveInstruction(hp1);
                 result:=true;
               end;
           end;
@@ -5270,8 +5195,7 @@ unit aoptx86;
                           DebugMsg(SPeepholeOptimization+'JccMov2CMov',p);
 
                           { Remove the original jump }
-                          asml.Remove(p);
-                          p.Free;
+                          RemoveInstruction(p); { Note, the choice to not use RemoveCurrentp is deliberate }
 
                           GetNextInstruction(hp2, p); { Instruction after the label }
 
@@ -5369,8 +5293,7 @@ unit aoptx86;
                                 DebugMsg(SPeepholeOptimization+'JccMovJmpMov2CMovCMov',hp1);
 
                                 { remove jCC }
-                                asml.remove(hp1);
-                                hp1.free;
+                                RemoveInstruction(hp1);
 
                                 { Now we can safely decrement it }
                                 tasmlabel(symbol).decrefs;
@@ -5381,8 +5304,7 @@ unit aoptx86;
                                 { remove jmp }
                                 symbol := taicpu(hp2).oper[0]^.ref^.symbol;
 
-                                asml.remove(hp2);
-                                hp2.free;
+                                RemoveInstruction(hp2);
 
                                 { As before, now we can safely decrement it }
                                 tasmlabel(symbol).decrefs;
@@ -5483,11 +5405,8 @@ unit aoptx86;
                 decw    %si             addw    %dx,%si       p
             }
             DebugMsg(SPeepholeOptimization + 'var3',p);
-            asml.remove(p);
-            asml.remove(hp2);
-            p.free;
-            hp2.free;
-            p:=hp1;
+            RemoveCurrentP(p, hp1);
+            RemoveInstruction(hp2);
           end
         else if reg_and_hp1_is_instr and
           (taicpu(hp1).opcode = A_MOV) and
@@ -5525,8 +5444,7 @@ unit aoptx86;
                 else
 {$endif x86_64}
                   taicpu(p).loadreg(1,taicpu(hp1).oper[1]^.reg);
-                asml.remove(hp1);
-                hp1.Free;
+                RemoveInstruction(hp1);
               end;
           end
         else if reg_and_hp1_is_instr and
@@ -5571,15 +5489,13 @@ unit aoptx86;
                     if (taicpu(hp1).oper[0]^.val = $ff) then
                       begin
                         DebugMsg(SPeepholeOptimization + 'var4',p);
-                        asml.remove(hp1);
-                        hp1.free;
+                        RemoveInstruction(hp1);
                       end;
                     S_WL{$ifdef x86_64}, S_WQ{$endif x86_64}:
                       if (taicpu(hp1).oper[0]^.val = $ffff) then
                         begin
                           DebugMsg(SPeepholeOptimization + 'var5',p);
-                          asml.remove(hp1);
-                          hp1.free;
+                          RemoveInstruction(hp1);
                         end;
 {$ifdef x86_64}
                     S_LQ:
@@ -5587,8 +5503,7 @@ unit aoptx86;
                         begin
                           if (cs_asm_source in current_settings.globalswitches) then
                             asml.insertbefore(tai_comment.create(strpnew(SPeepholeOptimization + 'var6')),p);
-                          asml.remove(hp1);
-                          hp1.Free;
+                          RemoveInstruction(hp1);
                         end;
 {$endif x86_64}
                   else
@@ -5781,9 +5696,7 @@ unit aoptx86;
               begin
                 taicpu(hp1).loadConst(0, taicpu(p).oper[0]^.val and taicpu(hp1).oper[0]^.val);
                 DebugMsg(SPeepholeOptimization + 'AndAnd2And done',hp1);
-                asml.remove(p);
-                p.Free;
-                p:=hp1;
+                RemoveCurrentP(p, hp1);
                 Result:=true;
                 exit;
               end
@@ -5819,8 +5732,7 @@ unit aoptx86;
                         }
                         DebugMsg(SPeepholeOptimization + 'AndMovzToAnd done',p);
 
-                        asml.remove(hp1);
-                        hp1.free;
+                        RemoveInstruction(hp1);
                         Exit;
                       end;
                   end
@@ -5880,8 +5792,7 @@ unit aoptx86;
                        then
                        begin
                          DebugMsg(SPeepholeOptimization + 'AndMovsxToAnd',p);
-                         asml.remove(hp1);
-                         hp1.free;
+                         RemoveInstruction(hp1);
                          Exit;
                        end;
                   end
@@ -6074,10 +5985,8 @@ unit aoptx86;
             taicpu(hp1).is_jmp := true;
             DebugMsg(SPeepholeOptimization + 'LeaCallLeaRet2Jmp done',p);
             RemoveCurrentP(p, hp4);
-            AsmL.Remove(hp2);
-            hp2.free;
-            AsmL.Remove(hp3);
-            hp3.free;
+            RemoveInstruction(hp2);
+            RemoveInstruction(hp3);
             Result:=true;
           end;
       end;
@@ -6127,10 +6036,8 @@ unit aoptx86;
             taicpu(hp1).is_jmp := true;
             DebugMsg(SPeepholeOptimization + 'PushCallPushRet2Jmp done',p);
             RemoveCurrentP(p, hp4);
-            AsmL.Remove(hp2);
-            hp2.free;
-            AsmL.Remove(hp3);
-            hp3.free;
+            RemoveInstruction(hp2);
+            RemoveInstruction(hp3);
             Result:=true;
           end;
 {$endif x86_64}
@@ -6283,10 +6190,7 @@ unit aoptx86;
                     ((taicpu(hp1).opcode <> A_ADD) and
                      (taicpu(hp1).opcode <> A_SUB))) then
                   begin
-                    hp1 := tai(p.next);
-                    asml.remove(p);
-                    p.free;
-                    p := tai(hp1);
+                    RemoveCurrentP(p, hp2);
                     Result:=true;
                   end;
               end;
@@ -6302,10 +6206,7 @@ unit aoptx86;
                   { and in case of carry for A(E)/B(E)/C/NC                  }
                    (taicpu(hp2).condition in [C_Z,C_NZ,C_E,C_NE]) then
                   begin
-                    hp1 := tai(p.next);
-                    asml.remove(p);
-                    p.free;
-                    p := tai(hp1);
+                    RemoveCurrentP(p, hp2);
                     Result:=true;
                   end;
               end;
@@ -6333,10 +6234,7 @@ unit aoptx86;
                       else
                         ;
                     end;
-                    hp1 := tai(p.next);
-                    asml.remove(p);
-                    p.free;
-                    p := tai(hp1);
+                    RemoveCurrentP(p, hp2);
                     Result:=true;
                   end;
               end
@@ -6373,8 +6271,7 @@ unit aoptx86;
             InsertLLItem(p.previous, p, hp2);
             taicpu(p).opcode := A_JMP;
             taicpu(p).is_jmp := true;
-            asml.remove(hp1);
-            hp1.free;
+            RemoveInstruction(hp1);
             Result:=true;
           end
         else
@@ -6405,8 +6302,7 @@ unit aoptx86;
               end
             else
               DebugMsg(SPeepholeOptimization + 'CallRet2Call done',p);
-            asml.remove(hp1);
-            hp1.free;
+            RemoveInstruction(hp1);
             Result:=true;
           end;
       end;

packages/fcl-passrc/src/pastree.pp

@@ -5724,7 +5724,7 @@ begin
       Result:=Result+', ';
     Result:=Result+Params[I].GetDeclaration(Full);  
     end;
-  if Kind = pekSet then
+  if Kind in [pekSet,pekArrayParams] then
     Result := '[' + Result + ']'
   else
     Result := '(' + Result + ')';

packages/fcl-passrc/src/paswrite.pp

@@ -1241,31 +1241,38 @@ begin
 end;
 
 procedure TPasWriter.WriteImplIfElse(AIfElse: TPasImplIfElse);
+
+Var
+  DoBeginEnd : Boolean;
+
 begin
   Add('if ' + AIfElse.Condition + ' then');
   if Assigned(AIfElse.IfBranch) then
-  begin
+    begin
     AddLn;
-    if (AIfElse.IfBranch.ClassType = TPasImplCommands) or
-      (AIfElse.IfBranch.ClassType = TPasImplBlock) then
+    DoBeginEnd:=(AIfElse.IfBranch.ClassType = TPasImplCommands) or
+                (AIfElse.IfBranch.ClassType = TPasImplBlock) or
+                Assigned(aIfElse.ElseBranch);
+    if DoBeginEnd then
       AddLn('begin');
     IncIndent;
     WriteImplElement(AIfElse.IfBranch, False);
     DecIndent;
-    if (AIfElse.IfBranch.ClassType = TPasImplCommands) or
-      (AIfElse.IfBranch.ClassType = TPasImplBlock) then
+    if DoBeginEnd then
+      begin
       if Assigned(AIfElse.ElseBranch) then
         Add('end ')
       else
         AddLn('end;')
+      end
     else
       if Assigned(AIfElse.ElseBranch) then
         AddLn;
-  end else
-    if not Assigned(AIfElse.ElseBranch) then
-      AddLn(';')
-    else
-      AddLn;
+    end
+  else if not Assigned(AIfElse.ElseBranch) then
+    AddLn(';')
+  else
+    AddLn;
 
   if Assigned(AIfElse.ElseBranch) then
     if AIfElse.ElseBranch.ClassType = TPasImplIfElse then
@@ -1277,10 +1284,10 @@ begin
       AddLn('else');
       IncIndent;
       WriteImplElement(AIfElse.ElseBranch, True);
-      if (not Assigned(AIfElse.Parent)) or
+{      if (not Assigned(AIfElse.Parent)) or
         (AIfElse.Parent.ClassType <> TPasImplIfElse) or
         (TPasImplIfElse(AIfElse.Parent).IfBranch <> AIfElse) then
-        AddLn(';');
+        AddLn(';');}
       DecIndent;
     end;
 end;

rtl/aarch64/mathu.inc

@@ -103,21 +103,23 @@ function GetExceptionMask: TFPUExceptionMask;
     if ((fpcr and fpu_ide)=0) then
       result := result+[exDenormalized];
     }
+    { as the fpcr flags might be RAZ, the softfloat exception mask
+      is considered as the authoritative mask }
     result:=softfloat_exception_mask;
   end;
 
 
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
-  {
   var
     newfpcr: dword;
-  }
   begin
-    { as I am not aware of any hardware exception supporting AArch64 implementation,
-      and else the trapping enable flags are RAZ, work solely with softfloat_exception_mask (FK)
-    }
+    { clear "exception happened" flags }
+    ClearExceptions(false);
     softfloat_exception_mask:=mask;
-    {
+
+    { at least the ThunderX AArch64 support apperently hardware exceptions,
+      so set fpcr correctly, thought it might be WI on most implementations it does not hurt
+    }
     newfpcr:=fpu_exception_mask;
     if exInvalidOp in Mask then
       newfpcr:=newfpcr and not(fpu_ioe);
@@ -131,14 +133,10 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
       newfpcr:=newfpcr and not(fpu_ixe);
     if exDenormalized in Mask then
       newfpcr:=newfpcr and not(fpu_ide);
-    }
-    { clear "exception happened" flags }
-    ClearExceptions(false);
-    { set new exception mask }
-//    setfpcr((getfpcr and not(fpu_exception_mask)) or newfpcr);
-    { unsupported mask bits will remain 0 -> read exception mask again }
-//    result:=GetExceptionMask;
-//    softfloat_exception_mask:=result;
+    setfpcr((getfpcr and not(fpu_exception_mask)) or newfpcr);
+
+    { as the fpcr flags might be RAZ, the softfloat exception mask
+      is considered as the authoritative mask }
     result:=softfloat_exception_mask;
   end;
 

rtl/aix/sysos.inc

@@ -96,10 +96,15 @@ end;
 *****************************************************************************}
 
 function do_isdevice(handle:longint):boolean;
+var
+  StatRec: Stat;
 begin
-  do_isdevice:= (handle=StdInputHandle) or
-                (handle=StdOutputHandle) or
-                (handle=StdErrorHandle);
+  fpFStat (Handle, StatRec);
+  case StatRec.st_Mode and S_IFMT of
+   S_IFCHR, S_IFIFO, S_IFSOCK: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;
 
 

rtl/beos/sysos.inc

@@ -132,17 +132,14 @@ end;
 *****************************************************************************}
 
 Function Do_IsDevice(Handle:Longint):boolean;
-{
-  Interface to Unix ioctl call.
-  Performs various operations on the filedescriptor Handle.
-  Ndx describes the operation to perform.
-  Data points to data needed for the Ndx function. The structure of this
-  data is function-dependent.
-}
-CONST
-  IOCtl_TCGETS=$5401;
 var
-  Data : array[0..255] of byte; {Large enough for termios info}
+  StatRec: Stat;
 begin
-  Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+  fpFStat (Handle, StatRec);
+  case StatRec.st_Mode and S_IFMT of
+(* S_IFSOCK supposedly not available under BeOS, thus omitted *)
+   S_IFCHR, S_IFIFO: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;

rtl/bsd/sysos.inc

@@ -156,19 +156,15 @@ end;
 *****************************************************************************}
 
 Function Do_IsDevice(Handle:Longint):boolean;
-{
-  Interface to Unix ioctl call.
-  Performs various operations on the filedescriptor Handle.
-  Ndx describes the operation to perform.
-  Data points to data needed for the Ndx function. The structure of this
-  data is function-dependent.
-}
-CONST
-  IOCtl_TCGETS=$40000000+$2C7400+ 19;
 var
-  Data : array[0..255] of byte; {Large enough for termios info}
+  StatRec: Stat;
 begin
-  Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+  fpFStat (Handle, StatRec);
+  case StatRec.st_Mode and S_IFMT of
+   S_IFCHR, S_IFIFO, S_IFSOCK: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;
 
 

rtl/emx/sysfile.inc

@@ -397,7 +397,7 @@ asm
     call syscall
     mov eax, 1
     jc @IsDevEnd
-    test edx, 80h           { verify if it is a file  }
+    test edx, 80h           { bit 7 is set if it is a device or a pipe }
     jnz @IsDevEnd
     dec eax                 { nope, so result is zero }
 @IsDevEnd:

rtl/gba/sysfile.inc

@@ -74,7 +74,14 @@ begin
 end;
 
 function do_isdevice(handle: longint): boolean;
+var
+  StatRec: TStat;
 begin
-  result := false;
+  FStat (Handle, StatRec);
+  case StatRec.st_Mode and _IFMT of
+   _IFCHR, _IFIFO, _IFSOCK: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;
 

rtl/haiku/sysos.inc

@@ -108,15 +108,13 @@ end;
 *****************************************************************************}
 
 Function Do_IsDevice(Handle:Longint):boolean;
-{
-  Interface to Unix ioctl call.
-  Performs various operations on the filedescriptor Handle.
-  Ndx describes the operation to perform.
-  Data points to data needed for the Ndx function. The structure of this
-  data is function-dependent.
-}
+var
+  StatRec: Stat;
 begin
-  do_isdevice:= (handle=StdInputHandle) or
-                (handle=StdOutputHandle) or
-                (handle=StdErrorHandle);
+  fpFStat (Handle, StatRec);
+  case StatRec.st_Mode and S_IFMT of
+   S_IFCHR, S_IFIFO, S_IFSOCK: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;

rtl/inc/compproc.inc

@@ -806,6 +806,11 @@ Procedure fpc_rewrite_typed_name_iso(var f : TypedFile;const FileName : String;S
 Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf); compilerproc;
 Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
 Procedure fpc_typed_read_iso(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
+
+Procedure fpc_typedfile_init_iso(var t : TypedFile;nr : DWord);compilerproc;
+Procedure fpc_typedfile_init_filename_iso(var t : TypedFile;nr : DWord;const filename : string); compilerproc;
+Procedure fpc_typedfile_close_iso(var t : TypedFile); compilerproc;
+
 {$endif FPC_HAS_FEATURE_FILEIO}
 
 {$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}

rtl/inc/text.inc

@@ -96,12 +96,6 @@ end;
 Procedure Assign(out t:Text;const s : UnicodeString);
 begin
   InitText(t);
-  if Length (S) >= Length (TextRec.Name) then
-{ The last character of TextRec.Name needs to be #0 }
-   begin
-     InOutRes:=3;
-     Exit;
-   end;
 {$ifdef FPC_ANSI_TEXTFILEREC}
   TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
 {$else FPC_ANSI_TEXTFILEREC}
@@ -115,29 +109,12 @@ end;
 
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure Assign(out t:Text;const s: RawByteString);
-{$ifdef FPC_ANSI_TEXTFILEREC}
-var
-  R: RawByteString;
-{$endif FPC_ANSI_TEXTFILEREC}
 Begin
   InitText(t);
 {$ifdef FPC_ANSI_TEXTFILEREC}
   { ensure the characters in the record's filename are encoded correctly }
-  R:=ToSingleByteFileSystemEncodedFileName(S);
-  if Length (R) >= Length (TextRec.Name) then
-{ The last character of TextRec.Name needs to be #0 }
-   begin
-     InOutRes:=3;
-     Exit;
-   end;
-  TextRec(t).Name:=R;
+  TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
 {$else FPC_ANSI_TEXTFILEREC}
-  if Length (S) >= Length (TextRec.Name) then
-{ The last character of TextRec.Name needs to be #0 }
-   begin
-     InOutRes:=3;
-     Exit;
-   end;
   TextRec(t).Name:=S;
 {$endif FPC_ANSI_TEXTFILEREC}
   { null terminate, since the name array is regularly used as p(wide)char }
@@ -161,61 +138,27 @@ End;
 
 
 Procedure Assign(out t:Text;const p: PAnsiChar);
-var
-{$IFDEF FPC_HAS_FEATURE_ANSISTRINGS}
-  S: ansistring;
-{$ELSE FPC_HAS_FEATURE_ANSISTRINGS}
-  Counter: SizeInt;
-{$ENDIF FPC_HAS_FEATURE_ANSISTRINGS}
 Begin
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-  S := AnsiString (P);
-  if Length (S) >= Length (TextRec.Name) then
-{ The last character of TextRec.Name needs to be #0 }
-   begin
-     InOutRes:=3;
-     Exit;
-   end;
-  Assign(t,S);
+  Assign(t,AnsiString(p));
 {$else FPC_HAS_FEATURE_ANSISTRINGS}
   { no use in making this the one that does the work, since the name field is
     limited to 255 characters anyway }
-{  Assign(t,strpas(p));}
-  { TH: The length of name field may be extended sooner or later, let's play
-    safely }
-  Counter := IndexByte(P^,-1,0);
-  if Counter >= Length (TextRec.Name) then
-{ The last character of TextRec.Name needs to be #0 }
-   begin
-     InOutRes:=3;
-     Exit;
-   end;
-  Move(P^,TextRec(t).Name,counter+1);
+  Assign(t,strpas(p));
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 End;
 
 
 Procedure Assign(out t:Text;const c: AnsiChar);
-{$IFNDEF FPC_HAS_FEATURE_ANSISTRINGS}
-var
-  Counter: SizeInt;
-{$ENDIF FPC_HAS_FEATURE_ANSISTRINGS}
 Begin
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
   Assign(t,AnsiString(c));
 {$else FPC_HAS_FEATURE_ANSISTRINGS}
-  Counter := IndexByte(c,-1,0);
-  if Counter >= Length (TextRec.Name) then
-{ The last character of TextRec.Name needs to be #0 }
-   begin
-     InOutRes:=3;
-     Exit;
-   end;
-  Move(c,TextRec(F).Name,counter+1);
-{  Assign(t,ShortString(c));}
+  Assign(t,ShortString(c));
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 End;
 
+
 Procedure Close(var t : Text);[IOCheck];
 Begin
   if InOutRes<>0 then
@@ -565,7 +508,7 @@ Begin
   if not isdevice then
     { if we didn't modify the buffer, simply restore the BufPos and BufEnd  }
     { (the latter because it's now probably set to zero because nothing was }
-    { read anymore)                                                         }
+    {  was read anymore)                                                    }
     if (reads = 0) then
       begin
         TextRec(t).BufPos:=oldbufpos;

rtl/inc/typefile.inc

@@ -199,3 +199,44 @@ Begin
   Result:=pbyte(@f)+sizeof(TypedFile);
 end;
 
+
+Procedure fpc_typedfile_init_iso(var t : TypedFile;nr : DWord);compilerproc;
+begin
+{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
+  assign(t,paramstr(nr));
+{$else FPC_HAS_FEATURE_COMMANDARGS}
+  { primitive workaround for targets supporting no command line arguments,
+    invent some file name, try to avoid complex procedures like concating strings which might
+    pull-in bigger parts of the rtl }
+  assign(t,chr((nr mod 16)+65));
+{$endif FPC_HAS_FEATURE_COMMANDARGS}
+end;
+
+
+Procedure fpc_typedfile_init_filename_iso(var t : TypedFile;nr : DWord;const filename : string);compilerproc;
+begin
+{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
+  if paramstr(nr)='' then
+    assign(t,filename)
+  else
+    assign(t,paramstr(nr));
+{$else FPC_HAS_FEATURE_COMMANDARGS}
+  { primitive workaround for targets supporting no command line arguments,
+    invent some file name, try to avoid complex procedures like concating strings which might
+    pull-in bigger parts of the rtl }
+  assign(t,chr((nr mod 16)+65));
+{$endif FPC_HAS_FEATURE_COMMANDARGS}
+end;
+
+
+
+Procedure fpc_typedfile_close_iso(var t : TypedFile);compilerproc;
+begin
+  { reset inout result as this procedure is only called by the compiler and no I/O checking is carried out,
+    so further I/O does not fail }
+  inoutres:=0;
+  close(t);
+  inoutres:=0;
+end;
+
+

rtl/linux/aarch64/sighnd.inc

@@ -15,6 +15,8 @@
 
  **********************************************************************}
 
+{ $define SYSTEM_DEBUG}
+
 procedure SignalToRunerror(Sig: longint; SigInfo: PSigInfo; UContext: PUContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 var
@@ -23,7 +25,19 @@ begin
   res:=0;
   case sig of
     SIGFPE:
+      begin
         res:=207;
+{$ifdef SYSTEM_DEBUG}
+        writeln('magic of FPSIMD_Context: $',hexstr(uContext^.uc_mcontext.FPSIMD_Context.head.magic,8));
+        writeln('size of FPSIMD_Context: $',hexstr(uContext^.uc_mcontext.FPSIMD_Context.head.size,8));
+{$endif SYSTEM_DEBUG}
+        if (uContext^.uc_mcontext.FPSIMD_Context.head.magic=$46508001) and
+           (uContext^.uc_mcontext.FPSIMD_Context.head.size=$210) then
+           begin
+             with uContext^.uc_mcontext.FPSIMD_Context do
+               fpsr:=fpsr and not(fpu_exception_mask shr fpu_exception_mask_to_status_mask_shift);
+           end;
+      end;
     SIGILL:
         res:=216;
     SIGSEGV :
@@ -38,7 +52,10 @@ begin
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   if res<>0 then
-    HandleErrorAddrFrame(res,
-      pointer(uContext^.uc_mcontext.pc),
-      pointer(uContext^.uc_mcontext.regs[29]));
+    begin
+      uContext^.uc_mcontext.regs[0]:=res;
+      uContext^.uc_mcontext.regs[1]:=uContext^.uc_mcontext.pc;
+      uContext^.uc_mcontext.regs[2]:=uContext^.uc_mcontext.regs[29];
+      pointer(uContext^.uc_mcontext.pc):=@HandleErrorAddrFrame;
+    end;
 end;

rtl/linux/aarch64/sighndh.inc

@@ -17,6 +17,18 @@
 {$packrecords C}
 
 type
+  TAarch64_ctx = record
+    magic,
+    size : DWord
+  end;
+
+  TFPSIMD_Context = record
+    head : TAarch64_ctx;
+    fpsr,
+    fpcr : DWord;
+    vregs : array[0..31] of array[0..7] of Byte;
+  end;
+
   PSigContext = ^TSigContext;
   TSigContext = record
     fault_address : cULong;
@@ -25,10 +37,12 @@ type
     pc : cULong;
     pstate : cULong;
     __pad : cULong;
-    { The following field should be 16-byte-aligned. Currently the
+    { The following fields should be 16-byte-aligned. Currently the
       directive for specifying alignment is buggy, so the preceding
       field was added so that the record has the right size. }
-    __reserved : array[0..4095] of cUChar;
+    case Byte of
+      1: (__reserved : array[0..4095] of cUChar);
+      2: (FPSIMD_Context : TFPSIMD_Context);
   end;
 
   stack_t = record

rtl/linux/ptypes.inc

@@ -30,7 +30,7 @@ and all three 32-bit systems returned completely identical types too
 introduction)
 }
 {$ifdef CPUSPARC}
-  {$define __USE_LARGEFILE64}
+  { define __USE_LARGEFILE64}
 {$endif}
 
 {$if defined(CPUMIPS) or defined(cpuaarch64) or defined(cpusparc64)}

rtl/linux/sysos.inc

@@ -137,27 +137,15 @@ end;
 *****************************************************************************}
 
 Function Do_IsDevice(Handle:THandle):boolean;
-{
-  Interface to Unix ioctl call.
-  Performs various operations on the filedescriptor Handle.
-  Ndx describes the operation to perform.
-  Data points to data needed for the Ndx function. The structure of this
-  data is function-dependent.
-}
-const
-{$if defined(cpupowerpc) or defined(cpupowerpc64)}
-  IOCtl_TCGETS=$402c7413;
-{$else}
-{$if defined(cpusparc) or defined(cpusparc64)}
-  IOCtl_TCGETS=$40245408;
-{$else}
-  IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
-{$endif}
-{$endif}
 var
-  Data : array[0..255] of byte; {Large enough for termios info}
+  StatRec: Stat;
 begin
-  Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+  fpFStat (Handle, StatRec);
+  case StatRec.st_Mode and S_IFMT of
+   S_IFCHR, S_IFIFO, S_IFSOCK: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;
 
 

rtl/nds/sysfile.inc

@@ -296,9 +296,15 @@ end;
 
 
 function do_isdevice(handle: THandle): boolean;
+var
+  StatRec: TStat;
 begin
-  //result :=  (isatty(fileno(P_FILE(handle))) > 0);
-  do_isdevice := (_isatty(handle) > 0);
+  FStat (Handle, StatRec);
+  case StatRec.st_Mode and _IFMT of
+   _IFCHR, _IFIFO, _IFSOCK: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;
 
 

rtl/os2/sysfile.inc

@@ -343,6 +343,9 @@ function do_isdevice (Handle: THandle): boolean;
 var
   HT, Attr: cardinal;
   RC: cardinal;
+const
+  dhDevice = 1;
+  dhPipe = 2;
 begin
   do_isdevice:=false;
   RC := DosQueryHType(Handle, HT, Attr);
@@ -351,7 +354,7 @@ begin
     OSErrorWatch (RC);
     Exit;
    end;
-  if ht=1 then
+  if (HT = dhDevice) or (HT = dhPipe) then
    do_isdevice:=true;
 end;
 {$ASMMODE ATT}

rtl/solaris/sysos.inc

@@ -97,10 +97,15 @@ end;
 *****************************************************************************}
 
 function do_isdevice(handle:longint):boolean;
+var
+  StatRec: Stat;
 begin
-  do_isdevice:= (handle=StdInputHandle) or
-                (handle=StdOutputHandle) or
-                (handle=StdErrorHandle);
+  fpFStat (Handle, StatRec);
+  case StatRec.st_Mode and S_IFMT of
+   S_IFCHR, S_IFIFO, S_IFSOCK: Do_IsDevice := true
+  else
+   Do_IsDevice := false;
+  end;
 end;
 
 

rtl/unix/scripts/check_rtl_types.sh

@@ -1,7 +1,23 @@
 #!/usr/bin/env bash
 filename="$1"
 shift
-FPC_OPTS="$*"
+
+verbose=0
+i=1
+while [ $i -le $# ] ; do
+  arg="${!i}"
+  echo "Handling arg $i, \"$arg\""
+  if [ "${arg//=}" != "$arg" ] ; then
+    echo "Evaluating \"$arg\""
+    arg2="${arg/=*/}=\"${arg/*=/}\""
+    eval "$arg2"
+  elif [ "$arg" == "-v" ] ; then
+    verbose=1
+  else
+    FPC_OPTS="$FPC_OPTS $arg"
+  fi
+  let i++
+done
 
 if [ ! -f "$filename" ] ; then
   echo "Usage: $0 file.h2paschk"
@@ -58,8 +74,16 @@ if [ $res -ne 0 ] ; then
   exit
 fi
 
-echo "Calling $CC $CC_OPT -o ${filebase}_c ${filebase}.c"
-$CC $CC_OPT -o ${filebase}_c${VERSION} ${filebase}.c > ${filebase}${VERSION}_c.comp.log 2>&1
+TMP_DIR=tmp_$VERSION
+if [ -d $TMP_DIR ] ; then
+  rm -Rf $TMP_DIR
+fi
+mkdir $TMP_DIR
+
+mv ${filebase}.c ${filebase}.pas $TMP_DIR
+cd $TMP_DIR
+echo "Calling $CC $CC_OPT -o ${filebase}_${VERSION}_c ${filebase}.c"
+$CC $CC_OPT -o ${filebase}_${VERSION}_c ${filebase}.c > ${filebase}_${VERSION}_c.comp.log 2>&1
 res=$?
 if [ $res -ne 0 ] ; then
   echo "$CC call failed in $VERSION, res=$res"
@@ -67,15 +91,15 @@ if [ $res -ne 0 ] ; then
   exit
 fi
 
-./${filebase}_c${VERSION} > ${filebase}_c${VERSION}.out
+./${filebase}_${VERSION}_c > ${filebase}_${VERSION}_c.out
 res=$?
 if [ $res -ne 0 ] ; then
-  echo "./${filebase}_c${VERSION} failed in $VERSION, res=$res"
+  echo "./${filebase}_${VERSION}_c failed in $VERSION, res=$res"
   exit
 fi
 
-echo "Calling $MAKE all OPT=\"-n -gwl $FPC_OPTS\" FPC=$FPC"
-$MAKE all OPT="-n -gwl $FPC_OPTS" FPC=$FPC > ${filebase}${VERSION}_make_all.log 2>&1
+echo "Calling $MAKE -C .. all OPT=\"-n -gwl $FPC_OPTS\" FPC=$FPC"
+$MAKE -C .. all OPT="-n -gwl $FPC_OPTS" FPC=$FPC > ${filebase}${VERSION}_make_all.log 2>&1
 res=$?
 if [ $res -ne 0 ] ; then
   echo "$MAKE call failed in $VERSION, res=$res"
@@ -85,24 +109,24 @@ fi
 
 OS_TARGET=`$FPC $FPC_OPTS  -iTO`
 CPU_TARGET=`$FPC $FPC_OPTS -iTP`
-echo "Calling $MAKE -C ${filedir} ${filebaseonly} FPC=$FPC OPT=\"-n -gwl $FPC_OPTS\" -Fu../units/$CPU_TARGET-$OS_TARGET"
-$MAKE -C ${filedir} ${filebaseonly} FPC=$FPC OPT="-n -gwl $FPC_OPTS -Fu../units/$CPU_TARGET-$OS_TARGET" > ${filebase}${VERSION}_pas.comp.log 2>&1
+echo "Calling $MAKE -C .. ${TMP_DIR}/${filebaseonly} FPC=$FPC OPT=\"-n -gwl $FPC_OPTS\" -Fu../units/$CPU_TARGET-$OS_TARGET"
+$MAKE -C .. ${TMP_DIR}/${filebaseonly} FPC=$FPC OPT="-n -gwl $FPC_OPTS -Fu../units/$CPU_TARGET-$OS_TARGET" > ${filebase}_${VERSION}_pas.comp.log 2>&1
 res=$?
 if [ $res -ne 0 ] ; then
   echo "$FPC call failed in $VERSION, res=$res"
-  cat ${filebase}${VERSION}_pas.comp.log
+  cat ${filebase}_${VERSION}_pas.comp.log
   exit
 fi
-mv -f ${filebase} ${filebase}${VERSION}
+mv -f ../${filebase} ./${filebase}_${VERSION}_pas
 
-./${filebase}${VERSION} > ${filebase}_pas${VERSION}.out
+./${filebase}_${VERSION}_pas > ${filebase}_${VERSION}_pas.out
 res=$?
 if [ $res -ne 0 ] ; then
   echo "./${filebase}${VERSION} call failed in $VERSION, res=$res"
   exit
 fi
 
-diff ${filebase}_c${VERSION}.out ${filebase}_pas${VERSION}.out > ${filebase}${VERSION}.diffs
+diff ${filebase}_${VERSION}_c.out ${filebase}_${VERSION}_pas.out > ${filebase}_${VERSION}.diffs
 res=$?
 if [ $res -eq 0 ] ; then
   echo "No difference found!"
@@ -110,19 +134,21 @@ else
   echo "Diffs for ${VERSION} are:"
   echo "< C      results"
   echo "> Pascal results"
-  cat ${filebase}${VERSION}.diffs
+  cat ${filebase}_${VERSION}.diffs
 fi
 # Clean up
-rm -f ${filebase}_c${VERSION}
-rm -f ${filebase}${VERSION}
-rm -f ${filebase}_c${VERSION}.out
-rm -f ${filebase}_pas${VERSION}.out
-rm -f ${filebase}${VERSION}_c.comp.log
-rm -f ${filebase}${VERSION}_pas.comp.log
-rm -f ${filebase}${VERSION}_make_all.log
-rm -f ${filebase}.c
-rm -f ${filebase}.pas
-
+if [ $verbose -eq 0 ] ; then
+  rm -f ${filebase}_${VERSION}_c
+  rm -f ${filebase}_${VERSION}_pas
+  rm -f ${filebase}_${VERSION}_c.out
+  rm -f ${filebase}_pas${VERSION}.out
+  rm -f ${filebase}_${VERSION}_c.comp.log
+  rm -f ${filebase}_${VERSION}_pas.comp.log
+  rm -f ${filebase}_${VERSION}_make_all.log
+  rm -f ${filebase}.c
+  rm -f ${filebase}.pas
+fi
+cd ..
 }
 
 function check_64 ()
@@ -207,10 +233,10 @@ if [ $default_fpc -eq 1 ] ; then
 else
   if [ "${FPC}" == "$FPC64" ] ; then
     check_64
-  fi
-
-  if [ "${FPC}" == "$FPC32" ] ; then
+  elif [ "${FPC}" == "$FPC32" ] ; then
     check_32
+  else
+    echo "Unrecognized FPC=\"$FPC\""
   fi
 fi
 

rtl/win/sysfile.inc

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 2001 by Free Pascal development team
 
-    Low leve file functions
+    Low level file functions
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -19,8 +19,17 @@
 *****************************************************************************}
 
 function do_isdevice(handle:thandle):boolean;
+{$IFNDEF WINCE}
+var
+  HT: dword;
+{$ENDIF WINCE}
 begin
-  do_isdevice:=(handle = StdInputHandle) or (handle = StdOutputHandle) or (handle = StdErrorHandle);
+{$IFDEF WINCE}
+  Do_IsDevice := false;
+{$ELSE WINCE}
+  HT := GetFileType (Handle);
+  Do_IsDevice := (HT = FILE_TYPE_CHAR) or (HT = FILE_TYPE_PIPE);
+{$ENDIF WINCE}
 end;
 
 

rtl/win16/sysfile.inc

@@ -404,6 +404,7 @@ function do_isdevice(handle:THandle):boolean;
 var
   regs: Registers;
 begin
+(* Is this explicit check for the first three handles appropriate here??? *)
   if (handle=StdInputHandle) or (handle=StdOutputHandle) or (handle=StdErrorHandle) then
     begin
       do_isdevice:=true;

tests/webtbf/tw37763.pp

@@ -0,0 +1,7 @@
+{ %fail }
+{$MODE ISO}
+program forum(output);
+var f:rawbytestring;
+begin
+writeln(f)
+end.

tests/webtbs/DAT_TW37415

@@ -0,0 +1 @@
+1234

tests/webtbs/tw37415.pp

@@ -0,0 +1,9 @@
+{ %OPT=-Miso -Sr }
+{ %FILES=DAT_TW37415 }
+program fileTest(dat_tw37415);
+
+var
+  dat_tw37415: file of integer;
+begin
+  reset(dat_tw37415);
+end.

utils/fpcm/fpcmake.ini

@@ -871,11 +871,16 @@ ifneq ($(findstring sparc64,$(shell uname -a)),)
 ifeq ($(BINUTILSPREFIX),)
 GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
 else
+# gcc mips seems not to recognize -m32/-m64
+ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),mips mipsel),)
+CROSSGCCOPT=-mabi=32
+else
 CROSSGCCOPT=-m32
 endif
 endif
 endif
 endif
+endif
 
 # Check if FPCFPMAKE compiler is same target as FPC
 ifdef FPCFPMAKE
@@ -883,6 +888,21 @@ FPCFPMAKE_CPU_TARGET=$(shell $(FPCFPMAKE) -iTP)
 ifeq ($(CPU_TARGET),$(FPCFPMAKE_CPU_TARGET))
 # In that case use GCCLIBDIR value for FPCMAKEGCCLIBDIR
 FPCMAKEGCCLIBDIR:=$(GCCLIBDIR)
+else
+ifneq ($(findstring $(FPCFPMAKE_CPU_TARGET),aarch64 powerpc64 riscv64 sparc64 x86_64),)
+FPCMAKE_CROSSGCCOPT=-m64
+else
+ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),mips64 mips64el),)
+FPCMAKE_CROSSGCCOPT=-mabi=64
+else
+ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),mips mipsel),)
+FPCMAKE_CROSSGCCOPT=-mabi=32
+else
+FPCMAKE_CROSSGCCOPT=-m32
+endif
+endif
+endif
+FPCMAKEGCCLIBDIR:=$(shell dirname `gcc $(FPCMAKE_CROSSGCCOPT) -print-libgcc-file-name`)
 endif
 endif
 

utils/fpcm/revision.inc

@@ -1 +1 @@
-'2020-08-06 rev 46290'
+'2020-09-16 rev 46877'