+ assert() support

compiler/cg386inl.pas

@@ -32,7 +32,7 @@ interface
 implementation
 
     uses
-      cobjects,verbose,globals,systems,
+      cobjects,verbose,globals,systems,files,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       i386,cgai386,tgeni386,cg386ld,cg386cal;
@@ -507,40 +507,45 @@ implementation
 
       var
          r : preference;
+         hp : ptree;
          l : longint;
          ispushed : boolean;
          hregister : tregister;
-         otlabel,oflabel,filenamestring : plabel;
+         otlabel,oflabel   : plabel;
          oldpushedparasize : longint;
       begin
       { save & reset pushedparasize }
          oldpushedparasize:=pushedparasize;
          pushedparasize:=0;
          case p^.inlinenumber of
-            in_assert_x:
+            in_assert_x_y:
               begin
                  otlabel:=truelabel;
                  oflabel:=falselabel;
                  getlabel(truelabel);
                  getlabel(falselabel);
-                 getlabel(filenamestring);
-                 secondpass(p^.left);
-                 if codegenerror then
-                   exit;
+                 secondpass(p^.left^.left);
                  if cs_do_assertion in aktlocalswitches then
                    begin
-                      maketojumpbool(p^.left);
+                      maketojumpbool(p^.left^.left);
                       emitl(A_LABEL,falselabel);
-                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
-                        p^.fileinfo.line)));
-                      { generate string }
-                      { push string
-                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
-                        p^.fileinfo.line)));
-                      }
-                      emitcall('FPC_DO_ASSERT',true);
+                      { erroraddr }
+                      exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
+                      { lineno }
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,aktfilepos.line)));
+                      { filename string }
+                      hp:=genstringconstnode(current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex));
+                      secondpass(hp);
+                      if codegenerror then
+                       exit;
+                      emitpushreferenceaddr(exprasmlist,hp^.location.reference);
+                      disposetree(hp);
+                      { push msg }
+                      secondpass(p^.left^.right^.left);
+                      emitpushreferenceaddr(exprasmlist,p^.left^.right^.left^.location.reference);
+                      { call }
+                      emitcall('FPC_ASSERT',true);
                       emitl(A_LABEL,truelabel);
-
                    end;
                  truelabel:=otlabel;
                  falselabel:=oflabel;
@@ -939,8 +944,8 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  1998-10-02 17:04:51  peter
-    * fix for tp7
+  Revision 1.10  1998-10-05 12:32:44  peter
+    + assert() support
 
   Revision 1.8  1998/10/02 10:35:09  peter
     * support for inc(pointer,value) which now increases with value instead

compiler/innr.inc

@@ -50,7 +50,7 @@ const
    in_exclude_x_y       = 38;
    in_break             = 39;
    in_continue          = 40;
-   in_assert_x          = 41;
+   in_assert_x_y        = 41;
 
 { Internal constant functions }
    in_const_trunc      = 100;
@@ -72,7 +72,10 @@ const
    in_const_sin        = 116;
 {
   $Log$
-  Revision 1.9  1998-10-02 09:24:20  peter
+  Revision 1.10  1998-10-05 12:32:45  peter
+    + assert() support
+
+  Revision 1.9  1998/10/02 09:24:20  peter
     * more constant expression evaluators
 
   Revision 1.4  1998/09/14 10:48:17  peter

compiler/pexpr.pas

@@ -109,289 +109,331 @@ unit pexpr;
 
     function statement_syssym(l : longint;var pd : pdef) : ptree;
       var
-         p1,p2 : ptree;
-         paras : ptree;
-         prev_in_args : boolean;
-         Store_valid : boolean;
+        p1,p2,paras  : ptree;
+        prev_in_args : boolean;
+        Store_valid  : boolean;
       begin
-         prev_in_args:=in_args;
-         Store_valid:=Must_be_valid;
-         case l of
-        in_ord_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     Must_be_valid:=true;
-                     p1:=comp_expr(true);
-                     consume(RKLAMMER);
-                     do_firstpass(p1);
-                     p1:=geninlinenode(in_ord_x,false,p1);
-                     do_firstpass(p1);
-                     statement_syssym := p1;
-                     pd:=p1^.resulttype;
-                   end;
-        in_break : begin
-                     statement_syssym:=genzeronode(breakn);
-                     pd:=voiddef;
-                   end;
-     in_continue : begin
-                     statement_syssym:=genzeronode(continuen);
-                     pd:=voiddef;
-                   end;
-      in_typeof_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     consume(RKLAMMER);
-                     pd:=voidpointerdef;
-                     if p1^.treetype=typen then
-                      begin
-                        if (p1^.resulttype=nil) then
-                         begin
-                           Message(type_e_mismatch);
-                           statement_syssym:=genzeronode(errorn);
-                         end
-                        else
-                         if p1^.resulttype^.deftype=objectdef then
-                          statement_syssym:=geninlinenode(in_typeof_x,false,p1)
-                        else
-                         begin
-                           Message(type_e_mismatch);
-                           statement_syssym:=genzeronode(errorn);
-                         end;
-                      end
-                     else
-                      begin
-                        Must_be_valid:=false;
-                        do_firstpass(p1);
-                        if (p1^.resulttype=nil) then
-                         begin
-                           Message(type_e_mismatch);
-                           statement_syssym:=genzeronode(errorn)
-                         end
-                        else
-                         if p1^.resulttype^.deftype=objectdef then
-                          statement_syssym:=geninlinenode(in_typeof_x,false,p1)
-                        else
-                         begin
-                           Message(type_e_mismatch);
-                           statement_syssym:=genzeronode(errorn)
-                         end;
-                      end;
-                   end;
-     in_sizeof_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     consume(RKLAMMER);
-                     pd:=s32bitdef;
-                     if p1^.treetype=typen then
-                      begin
-                        statement_syssym:=genordinalconstnode(p1^.resulttype^.size,pd);
-                        { p1 not needed !}
-                        disposetree(p1);
-                      end
-                     else
-                      begin
-                        Must_be_valid:=false;
-                        do_firstpass(p1);
-                        if ((p1^.resulttype^.deftype=objectdef) and
-                           ((pobjectdef(p1^.resulttype)^.options and oo_hasvirtual)<>0))
-                          or is_open_array(p1^.resulttype) then
-                         statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
-                        else
-                         begin
-                           statement_syssym:=genordinalconstnode(p1^.resulttype^.size,pd);
-                           { p1 not needed !}
-                           disposetree(p1);
-                         end;
-                      end;
-                   end;
-   in_assigned_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     Must_be_valid:=true;
-                     do_firstpass(p1);
-                     case p1^.resulttype^.deftype of
-                  pointerdef,
-                  procvardef,
-                 classrefdef : ;
-                   objectdef : if not(pobjectdef(p1^.resulttype)^.isclass) then
-                                Message(parser_e_illegal_parameter_list);
-                     else
-                       Message(parser_e_illegal_parameter_list);
-                     end;
-                     p2:=gencallparanode(p1,nil);
-                     p2:=geninlinenode(in_assigned_x,false,p2);
-                     consume(RKLAMMER);
-                     pd:=booldef;
-                     statement_syssym:=p2;
-                   end;
-        in_ofs_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     p1:=gensinglenode(addrn,p1);
-                     Must_be_valid:=false;
-                     do_firstpass(p1);
-                   { Ofs() returns a longint, not a pointer }
-                     p1^.resulttype:=u32bitdef;
-                     pd:=p1^.resulttype;
-                     consume(RKLAMMER);
-                     statement_syssym:=p1;
-                   end;
-        in_seg_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     do_firstpass(p1);
-                     if p1^.location.loc<>LOC_REFERENCE then
-                       Message(cg_e_illegal_expression);
-                     p1:=genordinalconstnode(0,s32bitdef);
-                     Must_be_valid:=false;
-                     pd:=s32bitdef;
-                     consume(RKLAMMER);
-                     statement_syssym:=p1;
-                   end;
-       in_high_x,
-        in_low_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     do_firstpass(p1);
-                     Must_be_valid:=false;
-                     p2:=geninlinenode(l,false,p1);
-                     consume(RKLAMMER);
-                     pd:=s32bitdef;
-                     statement_syssym:=p2;
-                   end;
-       in_succ_x,
-       in_pred_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     do_firstpass(p1);
-                     Must_be_valid:=false;
-                     p2:=geninlinenode(l,false,p1);
-                     consume(RKLAMMER);
-                     pd:=p1^.resulttype;
-                     statement_syssym:=p2;
-                   end;
-        in_inc_x,
-        in_dec_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     Must_be_valid:=false;
-                     if token=COMMA then
-                      begin
-                        consume(COMMA);
-                        p2:=gencallparanode(comp_expr(true),nil);
-                      end
-                     else
-                      p2:=nil;
-                     p2:=gencallparanode(p1,p2);
-                     statement_syssym:=geninlinenode(l,false,p2);
-                     consume(RKLAMMER);
-                     pd:=voiddef;
-                   end;
-     in_concat_x : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p2:=nil;
-                     while true do
-                      begin
-                        p1:=comp_expr(true);
-                        Must_be_valid:=true;
-                        do_firstpass(p1);
-                        if not((p1^.resulttype^.deftype=stringdef) or
-                               ((p1^.resulttype^.deftype=orddef) and
-                                (porddef(p1^.resulttype)^.typ=uchar))) then
-                          Message(parser_e_illegal_parameter_list);
-                        if p2<>nil then
-                         p2:=gennode(addn,p2,p1)
-                        else
-                         p2:=p1;
-                        if token=COMMA then
-                         consume(COMMA)
-                        else
-                         break;
-                      end;
-                     consume(RKLAMMER);
-                     pd:=cstringdef;
-                     statement_syssym:=p2;
-                   end;
-       in_read_x,
-     in_readln_x : begin
-                     if token=LKLAMMER then
-                      begin
-                        consume(LKLAMMER);
-                        in_args:=true;
-                        Must_be_valid:=false;
-                        paras:=parse_paras(false,false);
-                        consume(RKLAMMER);
-                      end
-                     else
-                      paras:=nil;
-                     pd:=voiddef;
-                     p1:=geninlinenode(l,false,paras);
-                     do_firstpass(p1);
-                     statement_syssym := p1;
-                   end;
-      in_write_x,
-    in_writeln_x : begin
-                     if token=LKLAMMER then
-                      begin
-                        consume(LKLAMMER);
-                        in_args:=true;
-                        Must_be_valid:=true;
-                        paras:=parse_paras(true,false);
-                        consume(RKLAMMER);
-                      end
-                     else
-                      paras:=nil;
-                     pd:=voiddef;
-                     p1 := geninlinenode(l,false,paras);
-                     do_firstpass(p1);
-                     statement_syssym := p1;
-                   end;
- in_str_x_string : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     paras:=parse_paras(true,false);
-                     consume(RKLAMMER);
-                     p1 := geninlinenode(l,false,paras);
-                     do_firstpass(p1);
-                     statement_syssym := p1;
-                     pd:=voiddef;
-                   end;
-  in_include_x_y,
-  in_exclude_x_y : begin
-                     consume(LKLAMMER);
-                     in_args:=true;
-                     p1:=comp_expr(true);
-                     Must_be_valid:=false;
-                     consume(COMMA);
-                     p2:=comp_expr(true);
-                     { just a bit lisp feeling }
-                     statement_syssym:=geninlinenode(l,false,gencallparanode(p1,gencallparanode(p2,nil)));
-                     consume(RKLAMMER);
-                     pd:=voiddef;
-                   end;
-       {in_val_x : begin
-                     consume(LKLAMMER);
-                     paras:=parse_paras(false);
-                     consume(RKLAMMER);
-                     p1 := geninlinenode(l,false,paras);
-                     do_firstpass(p1);
-                     statement_syssym := p1;
-                     pd:=voiddef;
-                   end; }
-         else
-           internalerror(15);
-         end;
-         in_args:=prev_in_args;
-         Must_be_valid:=Store_valid;
+        prev_in_args:=in_args;
+        Store_valid:=Must_be_valid;
+        case l of
+          in_ord_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              Must_be_valid:=true;
+              p1:=comp_expr(true);
+              consume(RKLAMMER);
+              do_firstpass(p1);
+              p1:=geninlinenode(in_ord_x,false,p1);
+              do_firstpass(p1);
+              statement_syssym := p1;
+              pd:=p1^.resulttype;
+            end;
+
+          in_break :
+            begin
+              statement_syssym:=genzeronode(breakn);
+              pd:=voiddef;
+            end;
+
+          in_continue :
+            begin
+              statement_syssym:=genzeronode(continuen);
+              pd:=voiddef;
+            end;
+
+          in_typeof_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              consume(RKLAMMER);
+              pd:=voidpointerdef;
+              if p1^.treetype=typen then
+               begin
+                 if (p1^.resulttype=nil) then
+                  begin
+                    Message(type_e_mismatch);
+                    statement_syssym:=genzeronode(errorn);
+                  end
+                 else
+                  if p1^.resulttype^.deftype=objectdef then
+                   statement_syssym:=geninlinenode(in_typeof_x,false,p1)
+                 else
+                  begin
+                    Message(type_e_mismatch);
+                    statement_syssym:=genzeronode(errorn);
+                  end;
+               end
+              else
+               begin
+                 Must_be_valid:=false;
+                 do_firstpass(p1);
+                 if (p1^.resulttype=nil) then
+                  begin
+                    Message(type_e_mismatch);
+                    statement_syssym:=genzeronode(errorn)
+                  end
+                 else
+                  if p1^.resulttype^.deftype=objectdef then
+                   statement_syssym:=geninlinenode(in_typeof_x,false,p1)
+                 else
+                  begin
+                    Message(type_e_mismatch);
+                    statement_syssym:=genzeronode(errorn)
+                  end;
+               end;
+            end;
+
+          in_sizeof_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              consume(RKLAMMER);
+              pd:=s32bitdef;
+              if p1^.treetype=typen then
+               begin
+                 statement_syssym:=genordinalconstnode(p1^.resulttype^.size,pd);
+                 { p1 not needed !}
+                 disposetree(p1);
+               end
+              else
+               begin
+                 Must_be_valid:=false;
+                 do_firstpass(p1);
+                 if ((p1^.resulttype^.deftype=objectdef) and
+                    ((pobjectdef(p1^.resulttype)^.options and oo_hasvirtual)<>0))
+                   or is_open_array(p1^.resulttype) then
+                  statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
+                 else
+                  begin
+                    statement_syssym:=genordinalconstnode(p1^.resulttype^.size,pd);
+                    { p1 not needed !}
+                    disposetree(p1);
+                  end;
+               end;
+            end;
+
+          in_assigned_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              Must_be_valid:=true;
+              do_firstpass(p1);
+              case p1^.resulttype^.deftype of
+           pointerdef,
+           procvardef,
+          classrefdef : ;
+            objectdef : if not(pobjectdef(p1^.resulttype)^.isclass) then
+                         Message(parser_e_illegal_parameter_list);
+              else
+                Message(parser_e_illegal_parameter_list);
+              end;
+              p2:=gencallparanode(p1,nil);
+              p2:=geninlinenode(in_assigned_x,false,p2);
+              consume(RKLAMMER);
+              pd:=booldef;
+              statement_syssym:=p2;
+            end;
+
+          in_ofs_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              p1:=gensinglenode(addrn,p1);
+              Must_be_valid:=false;
+              do_firstpass(p1);
+              { Ofs() returns a longint, not a pointer }
+              p1^.resulttype:=u32bitdef;
+              pd:=p1^.resulttype;
+              consume(RKLAMMER);
+              statement_syssym:=p1;
+            end;
+
+          in_seg_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              do_firstpass(p1);
+              if p1^.location.loc<>LOC_REFERENCE then
+                Message(cg_e_illegal_expression);
+              p1:=genordinalconstnode(0,s32bitdef);
+              Must_be_valid:=false;
+              pd:=s32bitdef;
+              consume(RKLAMMER);
+              statement_syssym:=p1;
+            end;
+
+          in_high_x,
+          in_low_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              do_firstpass(p1);
+              Must_be_valid:=false;
+              p2:=geninlinenode(l,false,p1);
+              consume(RKLAMMER);
+              pd:=s32bitdef;
+              statement_syssym:=p2;
+            end;
+
+          in_succ_x,
+          in_pred_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              do_firstpass(p1);
+              Must_be_valid:=false;
+              p2:=geninlinenode(l,false,p1);
+              consume(RKLAMMER);
+              pd:=p1^.resulttype;
+              statement_syssym:=p2;
+            end;
+
+          in_inc_x,
+          in_dec_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              Must_be_valid:=false;
+              if token=COMMA then
+               begin
+                 consume(COMMA);
+                 p2:=gencallparanode(comp_expr(true),nil);
+               end
+              else
+               p2:=nil;
+              p2:=gencallparanode(p1,p2);
+              statement_syssym:=geninlinenode(l,false,p2);
+              consume(RKLAMMER);
+              pd:=voiddef;
+            end;
+
+          in_concat_x :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p2:=nil;
+              while true do
+               begin
+                 p1:=comp_expr(true);
+                 Must_be_valid:=true;
+                 do_firstpass(p1);
+                 if not((p1^.resulttype^.deftype=stringdef) or
+                        ((p1^.resulttype^.deftype=orddef) and
+                         (porddef(p1^.resulttype)^.typ=uchar))) then
+                   Message(parser_e_illegal_parameter_list);
+                 if p2<>nil then
+                  p2:=gennode(addn,p2,p1)
+                 else
+                  p2:=p1;
+                 if token=COMMA then
+                  consume(COMMA)
+                 else
+                  break;
+               end;
+              consume(RKLAMMER);
+              pd:=cstringdef;
+              statement_syssym:=p2;
+            end;
+
+          in_read_x,
+          in_readln_x :
+            begin
+              if token=LKLAMMER then
+               begin
+                 consume(LKLAMMER);
+                 in_args:=true;
+                 Must_be_valid:=false;
+                 paras:=parse_paras(false,false);
+                 consume(RKLAMMER);
+               end
+              else
+               paras:=nil;
+              pd:=voiddef;
+              p1:=geninlinenode(l,false,paras);
+              do_firstpass(p1);
+              statement_syssym := p1;
+            end;
+
+          in_write_x,
+          in_writeln_x :
+            begin
+              if token=LKLAMMER then
+               begin
+                 consume(LKLAMMER);
+                 in_args:=true;
+                 Must_be_valid:=true;
+                 paras:=parse_paras(true,false);
+                 consume(RKLAMMER);
+               end
+              else
+               paras:=nil;
+              pd:=voiddef;
+              p1 := geninlinenode(l,false,paras);
+              do_firstpass(p1);
+              statement_syssym := p1;
+            end;
+
+          in_str_x_string :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              paras:=parse_paras(true,false);
+              consume(RKLAMMER);
+              p1 := geninlinenode(l,false,paras);
+              do_firstpass(p1);
+              statement_syssym := p1;
+              pd:=voiddef;
+            end;
+
+          in_include_x_y,
+          in_exclude_x_y :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              Must_be_valid:=false;
+              consume(COMMA);
+              p2:=comp_expr(true);
+              statement_syssym:=geninlinenode(l,false,gencallparanode(p1,gencallparanode(p2,nil)));
+              consume(RKLAMMER);
+              pd:=voiddef;
+            end;
+
+          in_assert_x_y :
+            begin
+              consume(LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr(true);
+              if token=COMMA then
+               begin
+                 consume(COMMA);
+                 p2:=comp_expr(true);
+               end
+              else
+               begin
+                 { then insert an empty string }
+                 p2:=genstringconstnode('');
+               end;
+              statement_syssym:=geninlinenode(l,false,gencallparanode(p1,gencallparanode(p2,nil)));
+              consume(RKLAMMER);
+              pd:=voiddef;
+            end;
+
+          else
+            internalerror(15);
+
+        end;
+        in_args:=prev_in_args;
+        Must_be_valid:=Store_valid;
       end;
 
 
@@ -1783,7 +1825,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.59  1998-10-01 14:56:24  peter
+  Revision 1.60  1998-10-05 12:32:46  peter
+    + assert() support
+
+  Revision 1.59  1998/10/01 14:56:24  peter
     * crash preventions
 
   Revision 1.58  1998/09/30 07:40:35  florian

compiler/psystem.pas

@@ -58,11 +58,10 @@ begin
   p^.insert(new(psyssym,init('INCLUDE',in_include_x_y)));
   p^.insert(new(psyssym,init('BREAK',in_break)));
   p^.insert(new(psyssym,init('CONTINUE',in_continue)));
-{$ifndef OLDINC}
   p^.insert(new(psyssym,init('DEC',in_dec_x)));
   p^.insert(new(psyssym,init('INC',in_inc_x)));
-{$endif}
   p^.insert(new(psyssym,init('STR',in_str_x_string)));
+  p^.insert(new(psyssym,init('ASSERT',in_assert_x_y)));
 end;
 
 
@@ -236,7 +235,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  1998-09-24 23:49:17  peter
+  Revision 1.7  1998-10-05 12:32:48  peter
+    + assert() support
+
+  Revision 1.6  1998/09/24 23:49:17  peter
     + aktmodeswitches
 
   Revision 1.5  1998/08/10 14:50:19  peter

compiler/tcinl.pas

@@ -809,8 +809,35 @@ implementation
                     end
                   else
                     CGMessage(type_e_varid_or_typeid_expected);
-               end
-                 else internalerror(8);
+               end;
+
+            in_assert_x_y :
+               begin
+                 p^.resulttype:=voiddef;
+                 if assigned(p^.left) then
+                   begin
+                      firstcallparan(p^.left,nil);
+                      p^.registers32:=p^.left^.registers32;
+                      p^.registersfpu:=p^.left^.registersfpu;
+{$ifdef SUPPORT_MMX}
+                      p^.registersmmx:=p^.left^.registersmmx;
+{$endif SUPPORT_MMX}
+                      { check type }
+                      if is_boolean(p^.left^.resulttype) then
+                        begin
+                           { must always be a string }
+                           p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,cstringdef);
+                           firstpass(p^.left^.right^.left);
+                        end
+                      else
+                        CGMessage(type_e_mismatch);
+                   end
+                 else
+                   CGMessage(type_e_mismatch);
+               end;
+
+              else
+                internalerror(8);
               end;
             end;
            must_be_valid:=store_valid;
@@ -821,7 +848,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-10-02 09:24:23  peter
+  Revision 1.3  1998-10-05 12:32:49  peter
+    + assert() support
+
+  Revision 1.2  1998/10/02 09:24:23  peter
     * more constant expression evaluators
 
   Revision 1.1  1998/09/23 20:42:24  peter

rtl/inc/innr.inc

@@ -50,7 +50,7 @@ const
    in_exclude_x_y       = 38;
    in_break             = 39;
    in_continue          = 40;
-   in_assert_x          = 41;
+   in_assert_x_y        = 41;
 
 { Internal constant functions }
    in_const_trunc      = 100;
@@ -72,8 +72,11 @@ const
    in_const_sin        = 116;
 {
   $Log$
-  Revision 1.5  1998-10-02 09:25:09  peter
-    * more constant expression evals
+  Revision 1.6  1998-10-05 12:32:50  peter
+    + assert() support
+
+  Revision 1.9  1998/10/02 09:24:20  peter
+    * more constant expression evaluators
 
   Revision 1.4  1998/09/14 10:48:17  peter
     * FPC_ names

rtl/inc/system.inc

@@ -287,16 +287,6 @@ begin
 end;
 
 
-procedure abstracterror;[public,alias : 'FPC_ABSTRACTERROR'];
-
-Type TAbstractErrorHandler = Procedure;
-
-begin
-  If AbstractErrorHandler<>nil then
-    TAbstractErrorHAndler(AbstractErrorHAndler);
-  Runerror(211);
-end;
-
 Function IOResult:Word;
 Begin
   IOResult:=InOutRes;
@@ -442,17 +432,37 @@ End;
 
 
 {*****************************************************************************
-                           Assert() support.
+                          Abstract/Assert support.
 *****************************************************************************}
 
-Procedure do_assert (Const Name,Msg : string; LineNo : Longint); [Public,Alias : 'FPC_DO_ASSERT'];
+procedure AbstractError;[public,alias : 'FPC_ABSTRACTERROR'];
+Type
+  TAbstractErrorProc=Procedure;
+begin
+  If AbstractErrorProc<>nil then
+    TAbstractErrorProc(AbstractErrorProc);
+  RunError(211);
+end;
+
+
+Procedure int_assert(Const Msg,FName:string;LineNo,ErrorAddr:Longint); [Public,Alias : 'FPC_ASSERT'];
+type
+  TAssertErrorProc=procedure(const msg,fname:string;lineno,erroraddr:longint);
+begin
+  if AssertErrorProc<>nil then
+   TAssertErrorProc(AssertErrorProc)(Msg,FName,LineNo,ErrorAddr)
+  else
+   HandleError(227);
+end;
+
+
+Procedure SysAssert(Const Msg,FName:string;LineNo,ErrorAddr:Longint);
 begin
   If msg='' then
-    write (stderr,'Assertion failed. ')
+    write(stderr,'Assertion failed')
   else
-    write (stderr,msg);
-  writeln (stderr,'(File : ',name,', line ',LineNo,'.');
-  HandleError (227);
+    write(stderr,msg);
+  writeln(stderr,' (',FName,', line ',LineNo,').');
 end;
 
 
@@ -465,7 +475,10 @@ end;
 
 {
   $Log$
-  Revision 1.35  1998-10-02 09:25:11  peter
+  Revision 1.36  1998-10-05 12:32:51  peter
+    + assert() support
+
+  Revision 1.35  1998/10/02 09:25:11  peter
     * more constant expression evals
 
   Revision 1.34  1998/09/22 15:30:54  peter

rtl/inc/systemh.inc

@@ -117,10 +117,8 @@ var
   StackBottom,
   LowestStack,
   RandSeed    : Longint;
-
-Const
-  ErrorProc   : Pointer = nil;
-  AbstractErrorHandler : Pointer = Nil;
+{ Error handlers }
+  ErrorProc         : Pointer;
 
 {****************************************************************************
                         Processor specific routines
@@ -385,6 +383,18 @@ Procedure AddExitProc(Proc:TProcedure);
 {$endif RTLLITE}
 Procedure halt;
 
+{*****************************************************************************
+                              Abstract/Assert
+*****************************************************************************}
+
+procedure AbstractError;
+Procedure SysAssert(Const Msg,FName:string;LineNo,ErrorAddr:Longint);
+
+const
+  AssertErrorProc   : Pointer=@SysAssert;
+  AbstractErrorProc : Pointer=nil;
+
+
 {*****************************************************************************
                           SetJmp/LongJmp
 *****************************************************************************}
@@ -393,7 +403,10 @@ Procedure halt;
 
 {
   $Log$
-  Revision 1.34  1998-10-01 14:54:48  peter
+  Revision 1.35  1998-10-05 12:32:52  peter
+    + assert() support
+
+  Revision 1.34  1998/10/01 14:54:48  peter
     * export also stackframe functions
 
   Revision 1.33  1998/09/28 14:02:33  michael

rtl/objpas/objpas.pp

@@ -108,9 +108,6 @@ interface
 
        TExceptProc = Procedure (Obj : TObject; Addr: Pointer);
 
-       var
-          abstracterrorproc : pointer;
-
        Const
           ExceptProc : Pointer {TExceptProc} = Nil;
 
@@ -191,33 +188,21 @@ interface
 
     procedure finalize(data,typeinfo : pointer);external name 'FPC_FINALIZE';
 
+
     { the reverse order of the parameters make code generation easier }
     function int_do_is(aclass : tclass;aobject : tobject) : boolean;[public,alias: 'FPC_DO_IS'];
-
       begin
          int_do_is:=aobject.inheritsfrom(aclass);
       end;
 
+
     { the reverse order of the parameters make code generation easier }
     procedure int_do_as(aclass : tclass;aobject : tobject);[public,alias: 'FPC_DO_AS'];
-
       begin
          if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
            runerror(219);
       end;
 
-    procedure abstracterror;
-
-      type
-         proc = procedure;
-
-      begin
-         if assigned(abstracterrorproc) then
-           proc(abstracterrorproc)()
-         else
-           runerror(211);
-      end;
-
 
 {****************************************************************************
                                TOBJECT
@@ -411,11 +396,13 @@ interface
 
 begin
   InitExceptions;
-  AbstractErrorHandler:=@AbstractError;
 end.
 {
   $Log$
-  Revision 1.16  1998-10-03 15:07:16  florian
+  Revision 1.17  1998-10-05 12:32:53  peter
+    + assert() support
+
+  Revision 1.16  1998/10/03 15:07:16  florian
     + TObject.AfterConstruction and TObject.BeforeDestruction of Delphi 4
 
   Revision 1.15  1998/09/24 16:13:48  michael