* almost all second pass typeconvnode helpers are now processor independent

  * fixed converting boolean to int64/qword
  * fixed register allocation bugs which could cause internalerror 10
  * isnode and asnode are completely processor indepent now as well
  * fpc_do_as now returns its class argument (necessary to be able to use it
    properly with compilerproc)

compiler/i386/cpunode.pas

@@ -29,7 +29,7 @@ unit cpunode;
   implementation
 
     uses
-       ncgbas,ncgflw,
+       ncgbas,ncgflw,ncgcnv,
        n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem,
        n386set,n386inl,n386opt,
        { this not really a node }
@@ -38,7 +38,15 @@ unit cpunode;
 end.
 {
   $Log$
-  Revision 1.5  2001-09-28 20:39:33  jonas
+  Revision 1.6  2001-09-29 21:32:47  jonas
+    * almost all second pass typeconvnode helpers are now processor independent
+    * fixed converting boolean to int64/qword
+    * fixed register allocation bugs which could cause internalerror 10
+    * isnode and asnode are completely processor indepent now as well
+    * fpc_do_as now returns its class argument (necessary to be able to use it
+      properly with compilerproc)
+
+  Revision 1.5  2001/09/28 20:39:33  jonas
     * changed all flow control structures (except for exception handling
       related things) to processor independent code (in new ncgflw unit)
     + generic cgobj unit which contains lots of code generator helpers with

compiler/i386/n386cnv.pas

@@ -27,30 +27,30 @@ unit n386cnv;
 interface
 
     uses
-      node,ncnv,types;
+      node,ncnv,ncgcnv,types;
 
     type
-       ti386typeconvnode = class(ttypeconvnode)
-          procedure second_int_to_int;virtual;
-         { procedure second_string_to_string;virtual; }
-          procedure second_cstring_to_pchar;virtual;
-          procedure second_string_to_chararray;virtual;
-          procedure second_array_to_pointer;virtual;
-          procedure second_pointer_to_array;virtual;
-         { procedure second_chararray_to_string;virtual; }
-          procedure second_char_to_string;virtual;
-          procedure second_int_to_real;virtual;
-          procedure second_real_to_real;virtual;
-          procedure second_cord_to_pointer;virtual;
-          procedure second_proc_to_procvar;virtual;
-          procedure second_bool_to_int;virtual;
-          procedure second_int_to_bool;virtual;
-          procedure second_load_smallset;virtual;
-          procedure second_ansistring_to_pchar;virtual;
-         { procedure second_pchar_to_string;virtual; }
-          procedure second_class_to_intf;virtual;
-          procedure second_char_to_char;virtual;
-          procedure second_nothing;virtual;
+       ti386typeconvnode = class(tcgtypeconvnode)
+         protected
+          procedure second_int_to_int;override;
+         { procedure second_string_to_string;override; }
+         { procedure second_cstring_to_pchar;override; }
+         { procedure second_string_to_chararray;override; }
+         { procedure second_array_to_pointer;override; }
+         { procedure second_pointer_to_array;override; }
+         { procedure second_chararray_to_string;override; }
+         { procedure second_char_to_string;override; }
+          procedure second_int_to_real;override;
+         { procedure second_real_to_real;override; }
+         { procedure second_cord_to_pointer;override; }
+         { procedure second_proc_to_procvar;override; }
+         { procedure second_bool_to_int;override; }
+          procedure second_int_to_bool;override;
+         { procedure second_load_smallset;override;  }
+         { procedure second_ansistring_to_pchar;override; }
+         { procedure second_pchar_to_string;override; }
+         { procedure second_class_to_intf;override;  }
+         { procedure second_char_to_char;override; }
           procedure pass_2;override;
           procedure second_call_helper(c : tconverttype);
        end;
@@ -201,141 +201,6 @@ implementation
       end;
 
 
-    procedure ti386typeconvnode.second_cstring_to_pchar;
-      var
-        hr : preference;
-      begin
-         clear_location(location);
-         location.loc:=LOC_REGISTER;
-         case tstringdef(left.resulttype.def).string_typ of
-           st_shortstring :
-             begin
-               inc(left.location.reference.offset);
-               del_reference(left.location.reference);
-               location.register:=getregister32;
-               emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
-                 location.register);
-             end;
-           st_ansistring :
-             begin
-               if (left.nodetype=stringconstn) and
-                  (str_length(left)=0) then
-                begin
-                  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
-                begin
-                  del_reference(left.location.reference);
-                  location.register:=getregister32;
-                  emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
-                    location.register);
-                end;
-             end;
-           st_longstring:
-             begin
-               {!!!!!!!}
-               internalerror(8888);
-             end;
-           st_widestring:
-             begin
-               if (left.nodetype=stringconstn) and
-                  (str_length(left)=0) then
-                begin
-                  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
-                begin
-                  del_reference(left.location.reference);
-                  location.register:=getregister32;
-                  emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
-                    location.register);
-                end;
-             end;
-         end;
-      end;
-
-
-    procedure ti386typeconvnode.second_string_to_chararray;
-      var
-        arrsize: longint;
-      begin
-         with tarraydef(resulttype.def) do
-           arrsize := highrange-lowrange+1;
-         if (left.nodetype = stringconstn) and
-            { left.length+1 since there's always a terminating #0 character (JM) }
-            (tstringconstnode(left).len+1 >= arrsize) and
-            (tstringdef(left.resulttype.def).string_typ=st_shortstring) then
-           begin
-             inc(location.reference.offset);
-             exit;
-           end
-         else
-           { should be handled already in resulttype pass (JM) }
-           internalerror(200108292);
-      end;
-
-
-    procedure ti386typeconvnode.second_array_to_pointer;
-      begin
-         del_reference(left.location.reference);
-         clear_location(location);
-         location.loc:=LOC_REGISTER;
-         location.register:=getregister32;
-         emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
-           location.register);
-      end;
-
-
-    procedure ti386typeconvnode.second_pointer_to_array;
-      begin
-        clear_location(location);
-        location.loc:=LOC_REFERENCE;
-        reset_reference(location.reference);
-        case left.location.loc of
-          LOC_REGISTER :
-            location.reference.base:=left.location.register;
-          LOC_CREGISTER :
-            begin
-              location.reference.base:=getregister32;
-              emit_reg_reg(A_MOV,S_L,left.location.register,location.reference.base);
-            end
-         else
-            begin
-              del_reference(left.location.reference);
-              location.reference.base:=getregister32;
-              emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
-                location.reference.base);
-            end;
-        end;
-      end;
-
-
-    procedure ti386typeconvnode.second_char_to_string;
-
-      begin
-         clear_location(location);
-         location.loc:=LOC_MEM;
-         case tstringdef(resulttype.def).string_typ of
-           st_shortstring :
-             begin
-               gettempofsizereference(256,location.reference);
-               loadshortstring(left,self);
-             end;
-           { the rest is removed in the resulttype pass and coverted to compilerprocs }
-           else
-            internalerror(4179);
-        end;
-      end;
-
-
     procedure ti386typeconvnode.second_int_to_real;
 
       var
@@ -454,175 +319,6 @@ implementation
       end;
 
 
-    procedure ti386typeconvnode.second_real_to_real;
-      begin
-         case left.location.loc of
-            LOC_FPU : ;
-            LOC_CFPUREGISTER:
-              begin
-                 location:=left.location;
-                 exit;
-              end;
-            LOC_MEM,
-            LOC_REFERENCE:
-              begin
-                 floatload(tfloatdef(left.resulttype.def).typ,
-                   left.location.reference);
-                 { we have to free the reference }
-                 del_reference(left.location.reference);
-              end;
-         end;
-         clear_location(location);
-         location.loc:=LOC_FPU;
-      end;
-
-
-    procedure ti386typeconvnode.second_cord_to_pointer;
-      begin
-        { this can't happend, because constants are already processed in
-          pass 1 }
-        internalerror(47423985);
-      end;
-
-
-    procedure ti386typeconvnode.second_proc_to_procvar;
-      begin
-        { method pointer ? }
-        if assigned(tcallnode(left).left) then
-          begin
-             set_location(location,left.location);
-          end
-        else
-          begin
-             clear_location(location);
-             location.loc:=LOC_REGISTER;
-             location.register:=getregister32;
-             del_reference(left.location.reference);
-             emit_ref_reg(A_LEA,S_L,
-               newreference(left.location.reference),location.register);
-          end;
-      end;
-
-
-    procedure ti386typeconvnode.second_bool_to_int;
-      var
-         oldtruelabel,oldfalselabel,hlabel : tasmlabel;
-         hregister : tregister;
-         newsize,
-         opsize : topsize;
-         op     : tasmop;
-      begin
-         oldtruelabel:=truelabel;
-         oldfalselabel:=falselabel;
-         getlabel(truelabel);
-         getlabel(falselabel);
-         secondpass(left);
-         { byte(boolean) or word(wordbool) or longint(longbool) must
-         be accepted for var parameters }
-         if (nf_explizit in flags) and
-            (left.resulttype.def.size=resulttype.def.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
-           begin
-              set_location(location,left.location);
-              truelabel:=oldtruelabel;
-              falselabel:=oldfalselabel;
-              exit;
-           end;
-         clear_location(location);
-         location.loc:=LOC_REGISTER;
-         del_reference(left.location.reference);
-         case left.resulttype.def.size of
-          1 : begin
-                case resulttype.def.size of
-                 1 : opsize:=S_B;
-                 2 : opsize:=S_BW;
-                 4 : opsize:=S_BL;
-                end;
-              end;
-          2 : begin
-                case resulttype.def.size of
-                 1 : begin
-                       if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                        left.location.register:=reg16toreg8(left.location.register);
-                       opsize:=S_B;
-                     end;
-                 2 : opsize:=S_W;
-                 4 : opsize:=S_WL;
-                end;
-              end;
-          4 : begin
-                case resulttype.def.size of
-                 1 : begin
-                       if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                        left.location.register:=reg32toreg8(left.location.register);
-                       opsize:=S_B;
-                     end;
-                 2 : begin
-                       if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                        left.location.register:=reg32toreg16(left.location.register);
-                       opsize:=S_W;
-                     end;
-                 4 : opsize:=S_L;
-                end;
-              end;
-         end;
-         if opsize in [S_B,S_W,S_L] then
-          op:=A_MOV
-         else
-          if is_signed(resulttype.def) then
-           op:=A_MOVSX
-          else
-           op:=A_MOVZX;
-         hregister:=getregister32;
-         case resulttype.def.size of
-          1 : begin
-                location.register:=reg32toreg8(hregister);
-                newsize:=S_B;
-              end;
-          2 : begin
-                location.register:=reg32toreg16(hregister);
-                newsize:=S_W;
-              end;
-          4 : begin
-                location.register:=hregister;
-                newsize:=S_L;
-              end;
-         else
-          internalerror(10060);
-         end;
-
-         case left.location.loc of
-            LOC_MEM,
-      LOC_REFERENCE : emit_ref_reg(op,opsize,
-                        newreference(left.location.reference),location.register);
-       LOC_REGISTER,
-      LOC_CREGISTER : begin
-                      { remove things like movb %al,%al }
-                        if left.location.register<>location.register then
-                          emit_reg_reg(op,opsize,
-                            left.location.register,location.register);
-                      end;
-          LOC_FLAGS : begin
-                        emit_flag2reg(left.location.resflags,location.register);
-                      end;
-           LOC_JUMP : begin
-                        getlabel(hlabel);
-                        emitlab(truelabel);
-                        emit_const_reg(A_MOV,newsize,1,location.register);
-                        emitjmp(C_None,hlabel);
-                        emitlab(falselabel);
-                        emit_reg_reg(A_XOR,newsize,location.register,
-                          location.register);
-                        emitlab(hlabel);
-                      end;
-         else
-           internalerror(10061);
-         end;
-         truelabel:=oldtruelabel;
-         falselabel:=oldfalselabel;
-      end;
-
-
     procedure ti386typeconvnode.second_int_to_bool;
       var
         hregister : tregister;
@@ -630,8 +326,8 @@ implementation
         opsize    : topsize;
       begin
          clear_location(location);
-         { byte(boolean) or word(wordbool) or longint(longbool) must
-         be accepted for var parameters }
+         { byte(boolean) or word(wordbool) or longint(longbool) must }
+         { be accepted for var parameters                            }
          if (nf_explizit in flags) and
             (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
@@ -640,7 +336,7 @@ implementation
               exit;
            end;
          location.loc:=LOC_REGISTER;
-         del_reference(left.location.reference);
+         del_location(left.location);
          opsize:=def_opsize(left.resulttype.def);
          case left.location.loc of
             LOC_MEM,LOC_REFERENCE :
@@ -676,103 +372,6 @@ implementation
       end;
 
 
-    procedure ti386typeconvnode.second_load_smallset;
-      var
-        href : treference;
-        pushedregs : tpushed;
-      begin
-        href.symbol:=nil;
-        pushusedregisters(pushedregs,$ff);
-        gettempofsizereference(32,href);
-        emit_push_mem_size(left.location.reference,4);
-        emitpushreferenceaddr(href);
-        saveregvars($ff);
-        emitcall('FPC_SET_LOAD_SMALL');
-        maybe_loadself;
-        popusedregisters(pushedregs);
-        clear_location(location);
-        location.loc:=LOC_MEM;
-        location.reference:=href;
-      end;
-
-
-    procedure ti386typeconvnode.second_ansistring_to_pchar;
-      var
-         l1 : tasmlabel;
-         hr : preference;
-      begin
-         clear_location(location);
-         location.loc:=LOC_REGISTER;
-         getlabel(l1);
-         case left.location.loc of
-            LOC_CREGISTER,LOC_REGISTER:
-              location.register:=left.location.register;
-            LOC_MEM,LOC_REFERENCE:
-              begin
-                location.register:=getregister32;
-                emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
-                  location.register);
-                del_reference(left.location.reference);
-              end;
-         end;
-         emit_const_reg(A_CMP,S_L,0,location.register);
-         emitjmp(C_NZ,l1);
-         new(hr);
-         reset_reference(hr^);
-         hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
-         emit_ref_reg(A_LEA,S_L,hr,location.register);
-         emitlab(l1);
-      end;
-
-
-    procedure ti386typeconvnode.second_class_to_intf;
-      var
-         hreg : tregister;
-         l1 : tasmlabel;
-      begin
-         case left.location.loc of
-            LOC_MEM,
-            LOC_REFERENCE:
-              begin
-                 del_reference(left.location.reference);
-                 hreg:=getregister32;
-                 exprasmList.concat(Taicpu.Op_ref_reg(
-                   A_MOV,S_L,newreference(left.location.reference),hreg));
-              end;
-            LOC_CREGISTER:
-              begin
-                 hreg:=getregister32;
-                 exprasmList.concat(Taicpu.Op_reg_reg(
-                   A_MOV,S_L,left.location.register,hreg));
-              end;
-            LOC_REGISTER:
-              hreg:=left.location.register;
-            else internalerror(121120001);
-         end;
-         emit_reg_reg(A_TEST,S_L,hreg,hreg);
-         getlabel(l1);
-         emitjmp(C_Z,l1);
-         emit_const_reg(A_ADD,S_L,tobjectdef(left.resulttype.def).implementedinterfaces.ioffsets(
-           tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(resulttype.def))^,hreg);
-         emitlab(l1);
-         location.loc:=LOC_REGISTER;
-         location.register:=hreg;
-      end;
-
-
-    procedure ti386typeconvnode.second_char_to_char;
-      begin
-        {$warning todo: add RTL routine for widechar-char conversion }
-        { Quick hack to atleast generate 'working' code (PFV) }
-        second_int_to_int;
-      end;
-
-
-    procedure ti386typeconvnode.second_nothing;
-      begin
-      end;
-
-
 {****************************************************************************
                            TI386TYPECONVNODE
 ****************************************************************************}
@@ -781,33 +380,33 @@ implementation
 
       const
          secondconvert : array[tconverttype] of pointer = (
-           @ti386typeconvnode.second_nothing, {equal}
-           @ti386typeconvnode.second_nothing, {not_possible}
-           @ti386typeconvnode.second_nothing, {second_string_to_string, handled in resulttype pass }
-           @ti386typeconvnode.second_char_to_string,
-           @ti386typeconvnode.second_nothing, { pchar_to_string, handled in resulttype pass }
-           @ti386typeconvnode.second_nothing, {cchar_to_pchar}
-           @ti386typeconvnode.second_cstring_to_pchar,
-           @ti386typeconvnode.second_ansistring_to_pchar,
-           @ti386typeconvnode.second_string_to_chararray,
-           @ti386typeconvnode.second_nothing, { chararray_to_string, handled in resulttype pass }
-           @ti386typeconvnode.second_array_to_pointer,
-           @ti386typeconvnode.second_pointer_to_array,
-           @ti386typeconvnode.second_int_to_int,
-           @ti386typeconvnode.second_int_to_bool,
-           @ti386typeconvnode.second_bool_to_int, { bool_to_bool }
-           @ti386typeconvnode.second_bool_to_int,
-           @ti386typeconvnode.second_real_to_real,
-           @ti386typeconvnode.second_int_to_real,
-           @ti386typeconvnode.second_proc_to_procvar,
-           @ti386typeconvnode.second_nothing, {arrayconstructor_to_set}
-           @ti386typeconvnode.second_load_smallset,
-           @ti386typeconvnode.second_cord_to_pointer,
-           @ti386typeconvnode.second_nothing, { interface 2 string }
-           @ti386typeconvnode.second_nothing, { interface 2 guid   }
-           @ti386typeconvnode.second_class_to_intf,
-           @ti386typeconvnode.second_char_to_char,
-           @ti386typeconvnode.second_nothing  { normal_2_smallset }
+           @second_nothing, {equal}
+           @second_nothing, {not_possible}
+           @second_nothing, {second_string_to_string, handled in resulttype pass }
+           @second_char_to_string,
+           @second_nothing, { pchar_to_string, handled in resulttype pass }
+           @second_nothing, {cchar_to_pchar}
+           @second_cstring_to_pchar,
+           @second_ansistring_to_pchar,
+           @second_string_to_chararray,
+           @second_nothing, { chararray_to_string, handled in resulttype pass }
+           @second_array_to_pointer,
+           @second_pointer_to_array,
+           @second_int_to_int,
+           @second_int_to_bool,
+           @second_bool_to_int, { bool_to_bool }
+           @second_bool_to_int,
+           @second_real_to_real,
+           @second_int_to_real,
+           @second_proc_to_procvar,
+           @second_nothing, { arrayconstructor_to_set }
+           @second_nothing, { second_load_smallset, handled in first pass }
+           @second_cord_to_pointer,
+           @second_nothing, { interface 2 string }
+           @second_nothing, { interface 2 guid   }
+           @second_class_to_intf,
+           @second_char_to_char,
+           @second_nothing  { normal_2_smallset }
          );
       type
          tprocedureofobject = procedure of object;
@@ -1001,7 +600,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.23  2001-09-03 13:27:42  jonas
+  Revision 1.24  2001-09-29 21:32:47  jonas
+    * almost all second pass typeconvnode helpers are now processor independent
+    * fixed converting boolean to int64/qword
+    * fixed register allocation bugs which could cause internalerror 10
+    * isnode and asnode are completely processor indepent now as well
+    * fpc_do_as now returns its class argument (necessary to be able to use it
+      properly with compilerproc)
+
+  Revision 1.23  2001/09/03 13:27:42  jonas
     * compilerproc implementation of set addition/substraction/...
     * changed the declaration of some set helpers somewhat to accomodate the
       above change

compiler/ncgcnv.pas

@@ -0,0 +1,436 @@
+{
+    $Id$
+    Copyright (c) 2000 by Florian Klaempfl
+
+    Generate assembler for nodes that handle type conversions which are
+    the same for all (most) processors
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgcnv;
+
+{$i defines.inc}
+
+interface
+
+    uses
+       node,ncnv;
+
+    type
+       tcgtypeconvnode = class(ttypeconvnode)
+         procedure second_cstring_to_pchar;override;
+         procedure second_string_to_chararray;override;
+         procedure second_array_to_pointer;override;
+         procedure second_pointer_to_array;override;
+         procedure second_char_to_string;override;
+         procedure second_real_to_real;override;
+         procedure second_cord_to_pointer;override;
+         procedure second_proc_to_procvar;override;
+         procedure second_bool_to_int;override;
+         procedure second_ansistring_to_pchar;override;
+         procedure second_class_to_intf;override;
+         procedure second_char_to_char;override;
+       end;
+
+  implementation
+
+    uses
+      globtype,
+      cutils,cclasses,globals,verbose,
+      aasm,symconst,symsym,symtable,symdef,symtype,types,
+      ncon,ncal,
+      htypechk,
+      cpubase,cpuasm,
+      pass_2,
+      cgbase,
+      cga,cgobj,cgcpu,
+{$ifdef i386}
+      n386util,
+{$endif i386}
+      tgcpu,temp_gen
+      ;
+
+
+    procedure tcgtypeconvnode.second_cstring_to_pchar;
+
+      var
+        hr : treference;
+
+      begin
+         clear_location(location);
+         location.loc:=LOC_REGISTER;
+         case tstringdef(left.resulttype.def).string_typ of
+           st_shortstring :
+             begin
+               inc(left.location.reference.offset);
+               del_reference(left.location.reference);
+               location.register:=getregister32;
+               cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
+                 location.register);
+             end;
+           st_ansistring :
+             begin
+               if (left.nodetype=stringconstn) and
+                  (str_length(left)=0) then
+                begin
+                  reset_reference(hr);
+                  hr.symbol:=newasmsymbol('FPC_EMPTYCHAR');
+                  location.register:=getregister32;
+                  cg.a_loadaddress_ref_reg(exprasmlist,hr,location.register);
+                end
+               else
+                begin
+                  del_reference(left.location.reference);
+                  location.register:=getregister32;
+                  cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
+                    location.register);
+                end;
+             end;
+           st_longstring:
+             begin
+               {!!!!!!!}
+               internalerror(8888);
+             end;
+           st_widestring:
+             begin
+               if (left.nodetype=stringconstn) and
+                  (str_length(left)=0) then
+                begin
+                  reset_reference(hr);
+                  hr.symbol:=newasmsymbol('FPC_EMPTYCHAR');
+                  location.register:=getregister32;
+                  cg.a_loadaddress_ref_reg(exprasmlist,hr,location.register);
+                end
+               else
+                begin
+                  del_reference(left.location.reference);
+                  location.register:=getregister32;
+{$warning Todo: convert widestrings to ascii when typecasting them to pchars}
+                  cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
+                    location.register);
+                end;
+             end;
+         end;
+      end;
+
+
+    procedure tcgtypeconvnode.second_string_to_chararray;
+
+      var
+        arrsize: longint;
+
+      begin
+         with tarraydef(resulttype.def) do
+           arrsize := highrange-lowrange+1;
+         if (left.nodetype = stringconstn) and
+            { left.length+1 since there's always a terminating #0 character (JM) }
+            (tstringconstnode(left).len+1 >= arrsize) and
+            (tstringdef(left.resulttype.def).string_typ=st_shortstring) then
+           begin
+             inc(location.reference.offset);
+             exit;
+           end
+         else
+           { should be handled already in resulttype pass (JM) }
+           internalerror(200108292);
+      end;
+
+
+    procedure tcgtypeconvnode.second_array_to_pointer;
+
+      begin
+         del_reference(left.location.reference);
+         clear_location(location);
+         location.loc:=LOC_REGISTER;
+         location.register:=getregister32;
+         cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
+           location.register);
+      end;
+
+
+    procedure tcgtypeconvnode.second_pointer_to_array;
+
+      begin
+        clear_location(location);
+        location.loc:=LOC_REFERENCE;
+        reset_reference(location.reference);
+        case left.location.loc of
+          LOC_REGISTER :
+            location.reference.base:=left.location.register;
+          LOC_CREGISTER :
+            begin
+              location.reference.base:=getregister32;
+              cg.a_load_reg_reg(exprasmlist,OS_32,left.location.register,
+                location.reference.base);
+            end
+         else
+            begin
+              del_reference(left.location.reference);
+              location.reference.base:=getregister32;
+              cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
+                location.reference.base);
+            end;
+        end;
+      end;
+
+
+    procedure tcgtypeconvnode.second_char_to_string;
+
+      begin
+         clear_location(location);
+         location.loc:=LOC_MEM;
+         case tstringdef(resulttype.def).string_typ of
+           st_shortstring :
+             begin
+               gettempofsizereference(256,location.reference);
+               loadshortstring(left,self);
+             end;
+           { the rest is removed in the resulttype pass and converted to compilerprocs }
+           else
+            internalerror(4179);
+        end;
+      end;
+
+
+    procedure tcgtypeconvnode.second_real_to_real;
+      begin
+         case left.location.loc of
+            LOC_FPU : ;
+            LOC_CFPUREGISTER:
+              begin
+                 location:=left.location;
+                 exit;
+              end;
+            LOC_MEM,
+            LOC_REFERENCE:
+              begin
+                 floatload(tfloatdef(left.resulttype.def).typ,
+                   left.location.reference);
+                 { we have to free the reference }
+                 del_reference(left.location.reference);
+              end;
+         end;
+         clear_location(location);
+         location.loc:=LOC_FPU;
+      end;
+
+
+    procedure tcgtypeconvnode.second_cord_to_pointer;
+      begin
+        { this can't happen because constants are already processed in
+          pass 1 }
+        internalerror(47423985);
+      end;
+
+
+    procedure tcgtypeconvnode.second_proc_to_procvar;
+
+      begin
+        { method pointer ? }
+        if assigned(tcallnode(left).left) then
+          begin
+             set_location(location,left.location);
+          end
+        else
+          begin
+             clear_location(location);
+             location.loc:=LOC_REGISTER;
+             del_reference(left.location.reference);
+             location.register:=getregister32;
+             cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
+               location.register);
+          end;
+      end;
+
+
+    procedure tcgtypeconvnode.second_bool_to_int;
+
+      var
+         oldtruelabel,oldfalselabel,hlabel : tasmlabel;
+         newsize,
+         opsize : tcgsize;
+
+      begin
+         oldtruelabel:=truelabel;
+         oldfalselabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         secondpass(left);
+         { byte(boolean) or word(wordbool) or longint(longbool) must }
+         { be accepted for var parameters                            }
+         if (nf_explizit in flags) and
+            (left.resulttype.def.size=resulttype.def.size) and
+            (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
+           begin
+              set_location(location,left.location);
+              truelabel:=oldtruelabel;
+              falselabel:=oldfalselabel;
+              exit;
+           end;
+         clear_location(location);
+         location.loc:=LOC_REGISTER;
+         del_location(left.location);
+         location.register:=getregister32;
+         { size of the boolean we're converting }
+         opsize := def_cgsize(left.resulttype.def);
+         { size of the destination }
+         newsize := def_cgsize(resulttype.def);
+         { the the source size is bigger than the destination, we can }
+         { simply decrease the sources size (since wordbool(true) =   }
+         { boolean(true) etc... (JM)                                  }
+         case newsize of
+           OS_8,OS_S8:
+             begin
+               opsize := OS_8;
+{$ifdef i386}
+               location.register := makereg8(location.register);
+               if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                 makereg8(left.location.register);
+{$endif i386}
+             end;
+           OS_16,OS_S16:
+             begin
+{$ifdef i386}
+               location.register := makereg16(location.register);
+{$endif i386}
+               if opsize in [OS_32,OS_S32] then
+                 begin
+                   opsize := OS_16;
+{$ifdef i386}
+                   if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                     makereg16(left.location.register);
+{$endif i386}
+                 end
+             end;
+         end;
+         case left.location.loc of
+            LOC_MEM,
+      LOC_REFERENCE :
+           cg.a_load_ref_reg(exprasmlist,opsize,left.location.reference,
+             location.register);
+       LOC_REGISTER,
+      LOC_CREGISTER :
+           if left.location.register<>location.register then
+             cg.a_load_reg_reg(exprasmlist,opsize,left.location.register,
+               location.register);
+          LOC_FLAGS :
+            cg.g_flags2reg(exprasmlist,left.location.resflags,location.register);
+           LOC_JUMP :
+             begin
+               getlabel(hlabel);
+               cg.a_label(exprasmlist,truelabel);
+               cg.a_load_const_reg(exprasmlist,newsize,1,location.register);
+               cg.a_jmp_cond(exprasmlist,OC_NONE,hlabel);
+               cg.a_label(exprasmlist,falselabel);
+               cg.a_load_const_reg(exprasmlist,newsize,0,location.register);
+               cg.a_label(exprasmlist,hlabel);
+             end;
+         else
+           internalerror(10061);
+         end;
+         truelabel:=oldtruelabel;
+         falselabel:=oldfalselabel;
+      end;
+
+
+    procedure tcgtypeconvnode.second_ansistring_to_pchar;
+      var
+         l1 : tasmlabel;
+         hr : treference;
+      begin
+         clear_location(location);
+         location.loc:=LOC_REGISTER;
+         getlabel(l1);
+         case left.location.loc of
+            LOC_CREGISTER,LOC_REGISTER:
+              location.register:=left.location.register;
+            LOC_MEM,LOC_REFERENCE:
+              begin
+                del_reference(left.location.reference);
+                location.register:=getregister32;
+                cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
+                  location.register);
+              end;
+         end;
+         cg.a_cmp_const_reg_label(exprasmlist,OS_32,OC_NE,0,location.register,
+           l1);
+         reset_reference(hr);
+         hr.symbol:=newasmsymbol('FPC_EMPTYCHAR');
+         cg.a_loadaddress_ref_reg(exprasmlist,hr,location.register);
+         cg.a_label(exprasmlist,l1);
+      end;
+
+
+    procedure tcgtypeconvnode.second_class_to_intf;
+      var
+         hreg : tregister;
+         l1 : tasmlabel;
+      begin
+         case left.location.loc of
+            LOC_MEM,
+            LOC_REFERENCE:
+              begin
+                 del_reference(left.location.reference);
+                 hreg:=getregister32;
+                 cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
+                   hreg);
+              end;
+            LOC_CREGISTER:
+              begin
+                 hreg:=getregister32;
+                 cg.a_load_reg_reg(exprasmlist,OS_32,left.location.register,
+                   hreg);
+              end;
+            LOC_REGISTER:
+              hreg:=left.location.register;
+            else internalerror(121120001);
+         end;
+         getlabel(l1);
+         cg.a_cmp_const_reg_label(exprasmlist,OS_32,OC_EQ,0,hreg,l1);
+         cg.a_op_const_reg(exprasmlist,OP_ADD,
+           tobjectdef(left.resulttype.def).implementedinterfaces.ioffsets(
+           tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(
+           resulttype.def))^,hreg);
+         cg.a_label(exprasmlist,l1);
+         location.loc:=LOC_REGISTER;
+         location.register:=hreg;
+      end;
+
+
+    procedure tcgtypeconvnode.second_char_to_char;
+      begin
+        {$warning todo: add RTL routine for widechar-char conversion }
+        { Quick hack to atleast generate 'working' code (PFV) }
+        second_int_to_int;
+      end;
+
+begin
+  ctypeconvnode := tcgtypeconvnode;
+end.
+
+{
+  $Log$
+  Revision 1.1  2001-09-29 21:32:47  jonas
+    * almost all second pass typeconvnode helpers are now processor independent
+    * fixed converting boolean to int64/qword
+    * fixed register allocation bugs which could cause internalerror 10
+    * isnode and asnode are completely processor indepent now as well
+    * fpc_do_as now returns its class argument (necessary to be able to use it
+      properly with compilerproc)
+
+
+}

compiler/ncnv.pas

@@ -76,6 +76,28 @@ interface
           function first_class_to_intf : tnode;virtual;
           function first_char_to_char : tnode;virtual;
           function first_call_helper(c : tconverttype) : tnode;
+
+          procedure second_int_to_int;virtual;abstract;
+          procedure second_string_to_string;virtual;abstract;
+          procedure second_cstring_to_pchar;virtual;abstract;
+          procedure second_string_to_chararray;virtual;abstract;
+          procedure second_array_to_pointer;virtual;abstract;
+          procedure second_pointer_to_array;virtual;abstract;
+          procedure second_chararray_to_string;virtual;abstract;
+          procedure second_char_to_string;virtual;abstract;
+          procedure second_int_to_real;virtual;abstract;
+          procedure second_real_to_real;virtual;abstract;
+          procedure second_cord_to_pointer;virtual;abstract;
+          procedure second_proc_to_procvar;virtual;abstract;
+          procedure second_bool_to_int;virtual;abstract;
+          procedure second_int_to_bool;virtual;abstract;
+          procedure second_load_smallset;virtual;abstract;
+          procedure second_ansistring_to_pchar;virtual;abstract;
+          procedure second_pchar_to_string;virtual;abstract;
+          procedure second_class_to_intf;virtual;abstract;
+          procedure second_char_to_char;virtual;abstract;
+          procedure second_nothing; virtual;
+
        end;
        ttypeconvnodeclass = class of ttypeconvnode;
 
@@ -117,6 +139,7 @@ implementation
 *****************************************************************************}
 
     procedure inserttypeconv(var p:tnode;const t:ttype);
+
       begin
         if not assigned(p.resulttype.def) then
          begin
@@ -397,8 +420,10 @@ implementation
 
 
     function ttypeconvnode.resulttype_cord_to_pointer : tnode;
+
       var
         t : tnode;
+
       begin
         result:=nil;
         if left.nodetype=ordconstn then
@@ -427,6 +452,7 @@ implementation
       end;
 
     function ttypeconvnode.resulttype_chararray_to_string : tnode;
+
       begin
         result := ccallnode.createinternres(
           'fpc_chararray_to_'+lower(tstringdef(resulttype.def).stringtypname),
@@ -435,8 +461,10 @@ implementation
       end;
 
     function ttypeconvnode.resulttype_string_to_chararray : tnode;
+
       var
         arrsize: longint;
+
       begin
          with tarraydef(resulttype.def) do
           begin
@@ -460,12 +488,15 @@ implementation
         left := nil;
       end;
 
+
     function ttypeconvnode.resulttype_string_to_string : tnode;
+
       var
         procname: string[31];
         stringpara : tcallparanode;
         pw : pcompilerwidestring;
         pc : pchar;
+
       begin
          result:=nil;
          if left.nodetype=stringconstn then
@@ -520,11 +551,13 @@ implementation
 
 
     function ttypeconvnode.resulttype_char_to_string : tnode;
+
       var
          procname: string[31];
          para : tcallparanode;
          hp : tstringconstnode;
          ws : pcompilerwidestring;
+
       begin
          result:=nil;
          if left.nodetype=ordconstn then
@@ -559,8 +592,10 @@ implementation
 
 
     function ttypeconvnode.resulttype_char_to_char : tnode;
+
       var
          hp : tordconstnode;
+
       begin
          result:=nil;
          if left.nodetype=ordconstn then
@@ -587,8 +622,10 @@ implementation
 
 
     function ttypeconvnode.resulttype_int_to_real : tnode;
+
       var
         t : trealconstnode;
+
       begin
         result:=nil;
         if left.nodetype=ordconstn then
@@ -601,8 +638,10 @@ implementation
 
 
     function ttypeconvnode.resulttype_real_to_real : tnode;
+
       var
         t : tnode;
+
       begin
          result:=nil;
          if left.nodetype=realconstn then
@@ -614,6 +653,7 @@ implementation
 
 
     function ttypeconvnode.resulttype_cchar_to_pchar : tnode;
+
       begin
          result:=nil;
          if is_pwidechar(resulttype.def) then
@@ -628,6 +668,7 @@ implementation
 
 
     function ttypeconvnode.resulttype_cstring_to_pchar : tnode;
+
       begin
          result:=nil;
          if is_pwidechar(resulttype.def) then
@@ -636,8 +677,10 @@ implementation
 
 
     function ttypeconvnode.resulttype_arrayconstructor_to_set : tnode;
+
       var
         hp : tnode;
+
       begin
         result:=nil;
         if left.nodetype<>arrayconstructorn then
@@ -652,6 +695,7 @@ implementation
 
 
     function ttypeconvnode.resulttype_pchar_to_string : tnode;
+
       begin
         result := ccallnode.createinternres(
           'fpc_pchar_to_'+lower(tstringdef(resulttype.def).stringtypname),
@@ -711,9 +755,11 @@ implementation
 
 
     function ttypeconvnode.det_resulttype:tnode;
+
       var
         hp : tnode;
         aprocdef : tprocdef;
+
       begin
         result:=nil;
         resulttype:=totype;
@@ -1048,6 +1094,7 @@ implementation
 
 
     function ttypeconvnode.first_cord_to_pointer : tnode;
+
       begin
         result:=nil;
         internalerror(200104043);
@@ -1055,6 +1102,7 @@ implementation
 
 
     function ttypeconvnode.first_int_to_int : tnode;
+
       begin
         first_int_to_int:=nil;
         if (left.location.loc<>LOC_REGISTER) and
@@ -1068,6 +1116,7 @@ implementation
 
 
     function ttypeconvnode.first_cstring_to_pchar : tnode;
+
       begin
          first_cstring_to_pchar:=nil;
          registers32:=1;
@@ -1076,6 +1125,7 @@ implementation
 
 
     function ttypeconvnode.first_string_to_chararray : tnode;
+
       begin
          first_string_to_chararray:=nil;
          registers32:=1;
@@ -1084,6 +1134,7 @@ implementation
 
 
     function ttypeconvnode.first_char_to_string : tnode;
+
       begin
          first_char_to_string:=nil;
          location.loc:=LOC_MEM;
@@ -1098,6 +1149,7 @@ implementation
 
 
     function ttypeconvnode.first_array_to_pointer : tnode;
+
       begin
          first_array_to_pointer:=nil;
          if registers32<1 then
@@ -1107,6 +1159,7 @@ implementation
 
 
     function ttypeconvnode.first_int_to_real : tnode;
+
       begin
         first_int_to_real:=nil;
 {$ifdef m68k}
@@ -1144,6 +1197,7 @@ implementation
 
 
     function ttypeconvnode.first_pointer_to_array : tnode;
+
       begin
          first_pointer_to_array:=nil;
          if registers32<1 then
@@ -1153,6 +1207,7 @@ implementation
 
 
     function ttypeconvnode.first_cchar_to_pchar : tnode;
+
       begin
          first_cchar_to_pchar:=nil;
          internalerror(200104021);
@@ -1160,6 +1215,7 @@ implementation
 
 
     function ttypeconvnode.first_bool_to_int : tnode;
+
       begin
          first_bool_to_int:=nil;
          { byte(boolean) or word(wordbool) or longint(longbool) must
@@ -1168,6 +1224,17 @@ implementation
             (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
            exit;
+         { when converting to 64bit, first convert to a 32bit int and then   }
+         { convert to a 64bit int (only necessary for 32bit processors) (JM) }
+         if resulttype.def.size > sizeof(aword) then
+           begin
+             result := ctypeconvnode.create(left,u32bittype);
+             result.toggleflag(nf_explizit);
+             result := ctypeconvnode.create(result,resulttype);
+             left := nil;
+             firstpass(result);
+             exit;
+           end;
          location.loc:=LOC_REGISTER;
          if registers32<1 then
            registers32:=1;
@@ -1175,6 +1242,7 @@ implementation
 
 
     function ttypeconvnode.first_int_to_bool : tnode;
+
       begin
          first_int_to_bool:=nil;
          { byte(boolean) or word(wordbool) or longint(longbool) must
@@ -1204,6 +1272,7 @@ implementation
 
 
     function ttypeconvnode.first_char_to_char : tnode;
+
       begin
          first_char_to_char:=nil;
          location.loc:=LOC_REGISTER;
@@ -1225,12 +1294,29 @@ implementation
 
 
     function ttypeconvnode.first_load_smallset : tnode;
+
+      var
+        srsym: ttypesym;
+        p: tcallparanode;
+
       begin
-         first_load_smallset:=nil;
+        if not searchsystype('FPC_SMALL_SET',srsym) then
+          internalerror(200108313);
+        p := ccallparanode.create(left,nil);
+        { reused }
+        left := nil;
+        { convert parameter explicitely to fpc_small_set }
+        p.left := ctypeconvnode.create(p.left,srsym.restype);
+        p.left.toggleflag(nf_explizit);
+        { create call, adjust resulttype }
+        result :=
+          ccallnode.createinternres('fpc_set_load_small',p,resulttype);
+        firstpass(result);
       end;
 
 
     function ttypeconvnode.first_ansistring_to_pchar : tnode;
+
       begin
          first_ansistring_to_pchar:=nil;
          location.loc:=LOC_REGISTER;
@@ -1254,6 +1340,7 @@ implementation
            registers32:=1;
       end;
 
+
     function ttypeconvnode.first_call_helper(c : tconverttype) : tnode;
 
       const
@@ -1345,6 +1432,19 @@ implementation
       end;
 
 
+    function ttypeconvnode.docompare(p: tnode) : boolean;
+      begin
+        docompare :=
+          inherited docompare(p) and
+          (convtype = ttypeconvnode(p).convtype);
+      end;
+
+
+    procedure ttypeconvnode.second_nothing;
+      begin
+      end;
+
+
 {*****************************************************************************
                                 TISNODE
 *****************************************************************************}
@@ -1391,16 +1491,16 @@ implementation
 
 
     function tisnode.pass_1 : tnode;
-      begin
-         result:=nil;
-         firstpass(left);
-         firstpass(right);
-         if codegenerror then
-           exit;
 
-         left_right_max;
+      var
+        paras: tcallparanode;
 
-         location.loc:=LOC_FLAGS;
+      begin
+         paras := ccallparanode.create(left,ccallparanode.create(right,nil));
+         left := nil;
+         right := nil;
+         result := ccallnode.createintern('fpc_do_is',paras);
+         firstpass(result);
       end;
 
 
@@ -1449,26 +1549,20 @@ implementation
 
 
     function tasnode.pass_1 : tnode;
-      begin
-         result:=nil;
-         firstpass(right);
-         firstpass(left);
-         if codegenerror then
-           exit;
-
-         left_right_max;
-
-         set_location(location,left.location);
-      end;
 
+      var
+        paras: tcallparanode;
 
-    function ttypeconvnode.docompare(p: tnode) : boolean;
       begin
-        docompare :=
-          inherited docompare(p) and
-          (convtype = ttypeconvnode(p).convtype);
+         paras := ccallparanode.create(left,ccallparanode.create(right,nil));
+         left := nil;
+         right := nil;
+         result := ccallnode.createinternres('fpc_do_as',paras,
+           resulttype);
+         firstpass(result);
       end;
 
+
 begin
    ctypeconvnode:=ttypeconvnode;
    casnode:=tasnode;
@@ -1476,7 +1570,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.37  2001-09-03 13:27:42  jonas
+  Revision 1.38  2001-09-29 21:32:46  jonas
+    * almost all second pass typeconvnode helpers are now processor independent
+    * fixed converting boolean to int64/qword
+    * fixed register allocation bugs which could cause internalerror 10
+    * isnode and asnode are completely processor indepent now as well
+    * fpc_do_as now returns its class argument (necessary to be able to use it
+      properly with compilerproc)
+
+  Revision 1.37  2001/09/03 13:27:42  jonas
     * compilerproc implementation of set addition/substraction/...
     * changed the declaration of some set helpers somewhat to accomodate the
       above change

rtl/inc/compproc.inc

@@ -99,7 +99,7 @@ Procedure fpc_widestr_Unique(Var S : WideString); compilerproc;
 Function fpc_Val_Real_AnsiStr(Const S : AnsiString; Var Code : ValSInt): ValReal; compilerproc;
 Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; Var Code : ValSInt): ValUInt; compilerproc;
 Function fpc_Val_SInt_AnsiStr (DestSize: longint; Const S : AnsiString; Var Code : ValSInt): ValSInt; compilerproc;
-Function fpc_Val_qword_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword;compilerproc; 
+Function fpc_Val_qword_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword;compilerproc;
 Function fpc_Val_int64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): Int64; compilerproc;
 procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring); compilerproc;
 Procedure fpc_AnsiStr_Cardinal(C : Cardinal;Len : Longint; Var S : AnsiString); compilerproc;
@@ -165,7 +165,7 @@ function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword; compiler
 function fpc_mul_int64(f1,f2 : int64;checkoverflow : longbool) : int64; compilerproc;
 
 function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
-procedure fpc_do_as(aclass : tclass;aobject : tobject); compilerproc;
+function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
 procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
 procedure fpc_intf_incr_ref(const i: pointer); compilerproc;
 procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
@@ -247,7 +247,15 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
 
 {
   $Log$
-  Revision 1.10  2001-09-05 15:22:09  jonas
+  Revision 1.11  2001-09-29 21:32:47  jonas
+    * almost all second pass typeconvnode helpers are now processor independent
+    * fixed converting boolean to int64/qword
+    * fixed register allocation bugs which could cause internalerror 10
+    * isnode and asnode are completely processor indepent now as well
+    * fpc_do_as now returns its class argument (necessary to be able to use it
+      properly with compilerproc)
+
+  Revision 1.10  2001/09/05 15:22:09  jonas
     * made multiplying, dividing and mod'ing of int64 and qword processor
       independent with compilerprocs (+ small optimizations by using shift/and
       where possible)

rtl/inc/objpas.inc

@@ -27,10 +27,11 @@
 
 
     { the reverse order of the parameters make code generation easier }
-    procedure fpc_do_as(aclass : tclass;aobject : tobject);[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+    function fpc_do_as(aclass : tclass;aobject : tobject): tobject;[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
       begin
          if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
-           handleerror(219);
+           handleerrorframe(219,get_frame);
+         result := aobject;
       end;
 
 {$ifndef HASINTF}
@@ -692,7 +693,15 @@
 
 {
   $Log$
-  Revision 1.16  2001-08-01 15:00:10  jonas
+  Revision 1.17  2001-09-29 21:32:47  jonas
+    * almost all second pass typeconvnode helpers are now processor independent
+    * fixed converting boolean to int64/qword
+    * fixed register allocation bugs which could cause internalerror 10
+    * isnode and asnode are completely processor indepent now as well
+    * fpc_do_as now returns its class argument (necessary to be able to use it
+      properly with compilerproc)
+
+  Revision 1.16  2001/08/01 15:00:10  jonas
     + "compproc" helpers
     * renamed several helpers so that their name is the same as their
       "public alias", which should facilitate the conversion of processor