+ var parameter passing for different calling conventions

tests/test/cg/tcalvar3.pp

@@ -0,0 +1,814 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondcallparan()                                }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: This tests a subset of the secondcalln() node         }
+{          (var   parameters with pascal   calling convention)   }
+{****************************************************************}
+program tcalvar3;
+{$mode objfpc}
+{$INLINE ON}
+{$R+}
+{$P-}
+{$V+}
+
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single  }
+ { double nodes are checked.           }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+{ should be defined depending on CPU target }
+{$ifdef cpu68k}
+  BIG_INDEX = 8000;
+  SMALL_INDEX  = 13;
+{$endif}
+{$ifdef cpui386}
+  BIG_INDEX = 33000;
+  SMALL_INDEX = 13;     { value should not be aligned! }
+{$endif}
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+  RESULT_S32REAL = 1777.12;
+  RESULT_S64REAL = 3444.24;
+  RESULT_BOOL8BIT = 1;
+  RESULT_BOOL16BIT = 1;
+  RESULT_BOOL32BIT = 1;
+  RESULT_PCHAR = 'Hello world';
+  RESULT_BIGSTRING = 'Hello world';
+  RESULT_SMALLSTRING = 'H';
+  RESULT_CHAR = 'I';
+  RESULT_BOOLEAN = TRUE;
+  
+type 
+  tclass1 = class
+  end;
+  
+  tprocedure = procedure;
+  
+  tsmallrecord = packed record
+    b: byte;
+    w: word;
+  end;
+  
+  tlargerecord = packed record
+    b: array[1..BIG_INDEX] of byte;
+  end;
+  
+  tsmallarray = packed array[1..SMALL_INDEX] of byte;
+  
+  tsmallsetenum = 
+  (A_A,A_B,A_C,A_D);
+  
+  tsmallset = set of tsmallsetenum;
+  tlargeset = set of char;
+  
+  tsmallstring = string[2];
+  
+  
+  
+  
+  
+var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s64bit : int64;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_class : tclass1;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s64bit : int64;
+ value_s32real : single;
+ value_s64real  : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_class : tclass1;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring   : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+ 
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    
+    procedure clear_globals;
+     begin
+      global_u8bit := 0;
+      global_u16bit := 0;
+      global_s32bit := 0;
+      global_s64bit := 0;
+      global_s32real := 0.0;
+      global_s64real := 0.0;
+      global_ptr := nil;
+      global_proc := nil;
+      global_class := nil;
+      global_bigstring := '';
+      global_boolean := false;
+      global_char := #0;
+     end;
+     
+     
+    procedure clear_values;
+     begin
+      value_u8bit := 0;
+      value_u16bit := 0;
+      value_s32bit := 0;
+      value_s64bit := 0;
+      value_s32real := 0.0;
+      value_s64real  := 0.0;
+      value_proc := nil;
+      value_ptr := nil;
+      value_class := nil;
+      fillchar(value_smallrec, sizeof(value_smallrec), #0);
+      fillchar(value_largerec, sizeof(value_largerec), #0);
+      value_smallset := [];
+      value_smallstring := '';
+      value_bigstring   := '';
+      value_largeset := [];
+      fillchar(value_smallarray, sizeof(value_smallarray), #0);
+      value_boolean := false;
+      value_char:=#0;
+     end;
+     
+   
+  procedure testprocedure;
+   begin
+   end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit:=RESULT_U8BIT;
+    end;
+    
+   function getu16bit: word;
+     begin
+       getu16bit:=RESULT_U16BIT;
+     end;
+     
+   function gets32bit: longint;
+    begin
+      gets32bit:=RESULT_S32BIT;
+    end;
+    
+   function gets64bit: longint;
+    begin
+      gets64bit:=RESULT_S32BIT;
+    end;
+ 
+
+   function gets32real: single;
+    begin
+      gets32real:=RESULT_S32REAL;
+    end;
+
+   function gets64real: double;
+    begin
+      gets64real:=RESULT_S64REAL;
+    end;
+
+  {************************************************************************}
+  {                           VAR   PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit(var v : longint);pascal;
+   begin
+     v:=RESULT_S32BIT;
+   end;
+   
+  procedure proc_var_s64bit(var v: int64);pascal;
+   begin
+     v:=RESULT_S64BIT;
+   end;
+
+
+  procedure proc_var_u8bit(var v: byte);pascal;
+   begin
+     v:=RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord(var smallrec : tsmallrecord);pascal;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+   end;
+
+
+  procedure proc_var_largerecord(var largerec : tlargerecord);pascal;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset(var smallset : tsmallset);pascal;
+   begin
+     smallset := [A_A,A_D];
+   end;
+   
+   
+  procedure proc_var_largeset(var largeset : tlargeset);pascal;
+   begin
+     largeset:= largeset + ['I'];
+   end;
+   
+
+  procedure proc_var_smallstring(var s:tsmallstring);pascal;
+   begin
+     s:=RESULT_SMALLSTRING;
+   end;
+    
+
+  procedure proc_var_bigstring(var s:shortstring);pascal;
+   begin
+     s:=RESULT_BIGSTRING;
+   end;
+   
+
+  procedure proc_var_openstring(var s: OpenString);pascal;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+   end;
+   
+  procedure proc_var_smallarray(var arr : tsmallarray);pascal;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open(var arr : array of byte);pascal;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1(var arr : array of const);pascal;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+  end;
+  
+
+  procedure proc_var_smallarray_const_2(var arr : array of const);pascal;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+  end;
+   
+
+  procedure proc_var_formaldef_array(var buf);pascal;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string(var buf);pascal;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+   
+
+  {************************************************************************}
+  {                     MIXED   VAR PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);pascal;
+   begin
+     v:=RESULT_S32BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);pascal;
+   begin
+     v:=RESULT_S64BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);pascal;
+   begin
+     v:=RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);pascal;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);pascal;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);pascal;
+   begin
+     smallset := [A_A,A_D];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+   
+  procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);pascal;
+   begin
+     largeset:= largeset + ['I'];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);pascal;
+   begin
+     s:=RESULT_SMALLSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+    
+
+  procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);pascal;
+   begin
+     s:=RESULT_BIGSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);pascal;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+    value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);pascal;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);pascal;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);pascal;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+     value_u8bit := RESULT_U8BIT;
+ end;
+  
+
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);pascal;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+end;
+   
+
+  procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);pascal;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);pascal;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+var
+  failed: boolean;
+  pp : ^pchar;
+begin
+  {***************************** NORMAL TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit(global_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit(global_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit(global_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord(value_smallrec);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord(value_largerec);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset(value_smallset);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset(value_largeset);
+  if not ('I' in value_largeset) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring(value_smallstring);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring(value_bigstring);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring(value_smallstring);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+    
+(*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
+  clear_globals;
+  clear_values;
+  value_u8bit := RESULT_U8BIT;
+  value_ptr := RESULT_PCHAR;
+  value_s64bit := RESULT_S64BIT;
+  value_smallstring := RESULT_SMALLSTRING;
+  value_class := tclass1.create;
+  value_boolean := RESULT_BOOLEAN;
+  value_char := RESULT_CHAR;
+  value_s64real:=RESULT_S64REAL;
+  proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
+  
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if global_char <> RESULT_CHAR then
+    failed := true;
+  if global_boolean <> RESULT_BOOLEAN then
+    failed:=true;
+  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
+     failed := true;
+  if global_bigstring <> RESULT_SMALLSTRING then
+     failed := true;
+  if global_ptr <> value_ptr then
+     failed := true; 
+{  if value_class <> global_class then
+     failed := true;!!!!!!!!!!!!!!!!!!!!}
+  if global_s64bit <> RESULT_S64BIT then
+     failed := true;
+  if assigned(value_class) then
+    value_class.destroy;
+  global_u8bit := 0;
+  proc_var_smallarray_const_2([]);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+*)
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+  {***************************** MIXED  TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
+  if not ('I' in value_largeset) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2002-04-13 17:51:00  carl
+  + var parameter passing for different calling conventions
+
+
+}  

tests/test/cg/tcalvar4.pp

@@ -0,0 +1,814 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondcallparan()                                }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: This tests a subset of the secondcalln() node         }
+{          (var   parameters with cdecl    calling convention)   }
+{****************************************************************}
+program tcalvar4;
+{$mode objfpc}
+{$INLINE ON}
+{$R+}
+{$P-}
+{$V+}
+
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single  }
+ { double nodes are checked.           }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+{ should be defined depending on CPU target }
+{$ifdef cpu68k}
+  BIG_INDEX = 8000;
+  SMALL_INDEX  = 13;
+{$endif}
+{$ifdef cpui386}
+  BIG_INDEX = 33000;
+  SMALL_INDEX = 13;     { value should not be aligned! }
+{$endif}
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+  RESULT_S32REAL = 1777.12;
+  RESULT_S64REAL = 3444.24;
+  RESULT_BOOL8BIT = 1;
+  RESULT_BOOL16BIT = 1;
+  RESULT_BOOL32BIT = 1;
+  RESULT_PCHAR = 'Hello world';
+  RESULT_BIGSTRING = 'Hello world';
+  RESULT_SMALLSTRING = 'H';
+  RESULT_CHAR = 'I';
+  RESULT_BOOLEAN = TRUE;
+  
+type 
+  tclass1 = class
+  end;
+  
+  tprocedure = procedure;
+  
+  tsmallrecord = packed record
+    b: byte;
+    w: word;
+  end;
+  
+  tlargerecord = packed record
+    b: array[1..BIG_INDEX] of byte;
+  end;
+  
+  tsmallarray = packed array[1..SMALL_INDEX] of byte;
+  
+  tsmallsetenum = 
+  (A_A,A_B,A_C,A_D);
+  
+  tsmallset = set of tsmallsetenum;
+  tlargeset = set of char;
+  
+  tsmallstring = string[2];
+  
+  
+  
+  
+  
+var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s64bit : int64;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_class : tclass1;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s64bit : int64;
+ value_s32real : single;
+ value_s64real  : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_class : tclass1;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring   : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+ 
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    
+    procedure clear_globals;
+     begin
+      global_u8bit := 0;
+      global_u16bit := 0;
+      global_s32bit := 0;
+      global_s64bit := 0;
+      global_s32real := 0.0;
+      global_s64real := 0.0;
+      global_ptr := nil;
+      global_proc := nil;
+      global_class := nil;
+      global_bigstring := '';
+      global_boolean := false;
+      global_char := #0;
+     end;
+     
+     
+    procedure clear_values;
+     begin
+      value_u8bit := 0;
+      value_u16bit := 0;
+      value_s32bit := 0;
+      value_s64bit := 0;
+      value_s32real := 0.0;
+      value_s64real  := 0.0;
+      value_proc := nil;
+      value_ptr := nil;
+      value_class := nil;
+      fillchar(value_smallrec, sizeof(value_smallrec), #0);
+      fillchar(value_largerec, sizeof(value_largerec), #0);
+      value_smallset := [];
+      value_smallstring := '';
+      value_bigstring   := '';
+      value_largeset := [];
+      fillchar(value_smallarray, sizeof(value_smallarray), #0);
+      value_boolean := false;
+      value_char:=#0;
+     end;
+     
+   
+  procedure testprocedure;
+   begin
+   end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit:=RESULT_U8BIT;
+    end;
+    
+   function getu16bit: word;
+     begin
+       getu16bit:=RESULT_U16BIT;
+     end;
+     
+   function gets32bit: longint;
+    begin
+      gets32bit:=RESULT_S32BIT;
+    end;
+    
+   function gets64bit: longint;
+    begin
+      gets64bit:=RESULT_S32BIT;
+    end;
+ 
+
+   function gets32real: single;
+    begin
+      gets32real:=RESULT_S32REAL;
+    end;
+
+   function gets64real: double;
+    begin
+      gets64real:=RESULT_S64REAL;
+    end;
+
+  {************************************************************************}
+  {                           VAR   PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit(var v : longint);cdecl;
+   begin
+     v:=RESULT_S32BIT;
+   end;
+   
+  procedure proc_var_s64bit(var v: int64);cdecl;
+   begin
+     v:=RESULT_S64BIT;
+   end;
+
+
+  procedure proc_var_u8bit(var v: byte);cdecl;
+   begin
+     v:=RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord(var smallrec : tsmallrecord);cdecl;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+   end;
+
+
+  procedure proc_var_largerecord(var largerec : tlargerecord);cdecl;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset(var smallset : tsmallset);cdecl;
+   begin
+     smallset := [A_A,A_D];
+   end;
+   
+   
+  procedure proc_var_largeset(var largeset : tlargeset);cdecl;
+   begin
+     largeset:= largeset + ['I'];
+   end;
+   
+
+  procedure proc_var_smallstring(var s:tsmallstring);cdecl;
+   begin
+     s:=RESULT_SMALLSTRING;
+   end;
+    
+
+  procedure proc_var_bigstring(var s:shortstring);cdecl;
+   begin
+     s:=RESULT_BIGSTRING;
+   end;
+   
+
+  procedure proc_var_openstring(var s: OpenString);cdecl;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+   end;
+   
+  procedure proc_var_smallarray(var arr : tsmallarray);cdecl;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open(var arr : array of byte);cdecl;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1(var arr : array of const);cdecl;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+  end;
+  
+
+  procedure proc_var_smallarray_const_2(var arr : array of const);cdecl;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+  end;
+   
+
+  procedure proc_var_formaldef_array(var buf);cdecl;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string(var buf);cdecl;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+   
+
+  {************************************************************************}
+  {                     MIXED   VAR PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);cdecl;
+   begin
+     v:=RESULT_S32BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);cdecl;
+   begin
+     v:=RESULT_S64BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);cdecl;
+   begin
+     v:=RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);cdecl;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);cdecl;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);cdecl;
+   begin
+     smallset := [A_A,A_D];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+   
+  procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);cdecl;
+   begin
+     largeset:= largeset + ['I'];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);cdecl;
+   begin
+     s:=RESULT_SMALLSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+    
+
+  procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);cdecl;
+   begin
+     s:=RESULT_BIGSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);cdecl;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+    value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);cdecl;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);cdecl;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);cdecl;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+     value_u8bit := RESULT_U8BIT;
+ end;
+  
+
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);cdecl;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+end;
+   
+
+  procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);cdecl;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);cdecl;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+var
+  failed: boolean;
+  pp : ^pchar;
+begin
+  {***************************** NORMAL TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit(global_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit(global_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit(global_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord(value_smallrec);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord(value_largerec);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset(value_smallset);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset(value_largeset);
+  if not ('I' in value_largeset) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring(value_smallstring);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring(value_bigstring);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring(value_smallstring);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+    
+(*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
+  clear_globals;
+  clear_values;
+  value_u8bit := RESULT_U8BIT;
+  value_ptr := RESULT_PCHAR;
+  value_s64bit := RESULT_S64BIT;
+  value_smallstring := RESULT_SMALLSTRING;
+  value_class := tclass1.create;
+  value_boolean := RESULT_BOOLEAN;
+  value_char := RESULT_CHAR;
+  value_s64real:=RESULT_S64REAL;
+  proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
+  
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if global_char <> RESULT_CHAR then
+    failed := true;
+  if global_boolean <> RESULT_BOOLEAN then
+    failed:=true;
+  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
+     failed := true;
+  if global_bigstring <> RESULT_SMALLSTRING then
+     failed := true;
+  if global_ptr <> value_ptr then
+     failed := true; 
+{  if value_class <> global_class then
+     failed := true;!!!!!!!!!!!!!!!!!!!!}
+  if global_s64bit <> RESULT_S64BIT then
+     failed := true;
+  if assigned(value_class) then
+    value_class.destroy;
+  global_u8bit := 0;
+  proc_var_smallarray_const_2([]);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+*)
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+  {***************************** MIXED  TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
+  if not ('I' in value_largeset) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2002-04-13 17:51:00  carl
+  + var parameter passing for different calling conventions
+
+
+}  

tests/test/cg/tcalvar5.pp

@@ -0,0 +1,814 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondcallparan()                                }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: This tests a subset of the secondcalln() node         }
+{          (var   parameters with popstack calling convention)   }
+{****************************************************************}
+program tcalvar5;
+{$mode objfpc}
+{$INLINE ON}
+{$R+}
+{$P-}
+{$V+}
+
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single  }
+ { double nodes are checked.           }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+{ should be defined depending on CPU target }
+{$ifdef cpu68k}
+  BIG_INDEX = 8000;
+  SMALL_INDEX  = 13;
+{$endif}
+{$ifdef cpui386}
+  BIG_INDEX = 33000;
+  SMALL_INDEX = 13;     { value should not be aligned! }
+{$endif}
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+  RESULT_S32REAL = 1777.12;
+  RESULT_S64REAL = 3444.24;
+  RESULT_BOOL8BIT = 1;
+  RESULT_BOOL16BIT = 1;
+  RESULT_BOOL32BIT = 1;
+  RESULT_PCHAR = 'Hello world';
+  RESULT_BIGSTRING = 'Hello world';
+  RESULT_SMALLSTRING = 'H';
+  RESULT_CHAR = 'I';
+  RESULT_BOOLEAN = TRUE;
+  
+type 
+  tclass1 = class
+  end;
+  
+  tprocedure = procedure;
+  
+  tsmallrecord = packed record
+    b: byte;
+    w: word;
+  end;
+  
+  tlargerecord = packed record
+    b: array[1..BIG_INDEX] of byte;
+  end;
+  
+  tsmallarray = packed array[1..SMALL_INDEX] of byte;
+  
+  tsmallsetenum = 
+  (A_A,A_B,A_C,A_D);
+  
+  tsmallset = set of tsmallsetenum;
+  tlargeset = set of char;
+  
+  tsmallstring = string[2];
+  
+  
+  
+  
+  
+var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s64bit : int64;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_class : tclass1;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s64bit : int64;
+ value_s32real : single;
+ value_s64real  : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_class : tclass1;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring   : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+ 
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    
+    procedure clear_globals;
+     begin
+      global_u8bit := 0;
+      global_u16bit := 0;
+      global_s32bit := 0;
+      global_s64bit := 0;
+      global_s32real := 0.0;
+      global_s64real := 0.0;
+      global_ptr := nil;
+      global_proc := nil;
+      global_class := nil;
+      global_bigstring := '';
+      global_boolean := false;
+      global_char := #0;
+     end;
+     
+     
+    procedure clear_values;
+     begin
+      value_u8bit := 0;
+      value_u16bit := 0;
+      value_s32bit := 0;
+      value_s64bit := 0;
+      value_s32real := 0.0;
+      value_s64real  := 0.0;
+      value_proc := nil;
+      value_ptr := nil;
+      value_class := nil;
+      fillchar(value_smallrec, sizeof(value_smallrec), #0);
+      fillchar(value_largerec, sizeof(value_largerec), #0);
+      value_smallset := [];
+      value_smallstring := '';
+      value_bigstring   := '';
+      value_largeset := [];
+      fillchar(value_smallarray, sizeof(value_smallarray), #0);
+      value_boolean := false;
+      value_char:=#0;
+     end;
+     
+   
+  procedure testprocedure;
+   begin
+   end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit:=RESULT_U8BIT;
+    end;
+    
+   function getu16bit: word;
+     begin
+       getu16bit:=RESULT_U16BIT;
+     end;
+     
+   function gets32bit: longint;
+    begin
+      gets32bit:=RESULT_S32BIT;
+    end;
+    
+   function gets64bit: longint;
+    begin
+      gets64bit:=RESULT_S32BIT;
+    end;
+ 
+
+   function gets32real: single;
+    begin
+      gets32real:=RESULT_S32REAL;
+    end;
+
+   function gets64real: double;
+    begin
+      gets64real:=RESULT_S64REAL;
+    end;
+
+  {************************************************************************}
+  {                           VAR   PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit(var v : longint);popstack;
+   begin
+     v:=RESULT_S32BIT;
+   end;
+   
+  procedure proc_var_s64bit(var v: int64);popstack;
+   begin
+     v:=RESULT_S64BIT;
+   end;
+
+
+  procedure proc_var_u8bit(var v: byte);popstack;
+   begin
+     v:=RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord(var smallrec : tsmallrecord);popstack;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+   end;
+
+
+  procedure proc_var_largerecord(var largerec : tlargerecord);popstack;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset(var smallset : tsmallset);popstack;
+   begin
+     smallset := [A_A,A_D];
+   end;
+   
+   
+  procedure proc_var_largeset(var largeset : tlargeset);popstack;
+   begin
+     largeset:= largeset + ['I'];
+   end;
+   
+
+  procedure proc_var_smallstring(var s:tsmallstring);popstack;
+   begin
+     s:=RESULT_SMALLSTRING;
+   end;
+    
+
+  procedure proc_var_bigstring(var s:shortstring);popstack;
+   begin
+     s:=RESULT_BIGSTRING;
+   end;
+   
+
+  procedure proc_var_openstring(var s: OpenString);popstack;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+   end;
+   
+  procedure proc_var_smallarray(var arr : tsmallarray);popstack;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open(var arr : array of byte);popstack;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1(var arr : array of const);popstack;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+  end;
+  
+
+  procedure proc_var_smallarray_const_2(var arr : array of const);popstack;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+  end;
+   
+
+  procedure proc_var_formaldef_array(var buf);popstack;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string(var buf);popstack;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+   
+
+  {************************************************************************}
+  {                     MIXED   VAR PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);popstack;
+   begin
+     v:=RESULT_S32BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);popstack;
+   begin
+     v:=RESULT_S64BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);popstack;
+   begin
+     v:=RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);popstack;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);popstack;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);popstack;
+   begin
+     smallset := [A_A,A_D];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+   
+  procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);popstack;
+   begin
+     largeset:= largeset + ['I'];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);popstack;
+   begin
+     s:=RESULT_SMALLSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+    
+
+  procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);popstack;
+   begin
+     s:=RESULT_BIGSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);popstack;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+    value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);popstack;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);popstack;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);popstack;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+     value_u8bit := RESULT_U8BIT;
+ end;
+  
+
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);popstack;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+end;
+   
+
+  procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);popstack;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);popstack;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+var
+  failed: boolean;
+  pp : ^pchar;
+begin
+  {***************************** NORMAL TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit(global_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit(global_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit(global_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord(value_smallrec);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord(value_largerec);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset(value_smallset);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset(value_largeset);
+  if not ('I' in value_largeset) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring(value_smallstring);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring(value_bigstring);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring(value_smallstring);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+    
+(*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
+  clear_globals;
+  clear_values;
+  value_u8bit := RESULT_U8BIT;
+  value_ptr := RESULT_PCHAR;
+  value_s64bit := RESULT_S64BIT;
+  value_smallstring := RESULT_SMALLSTRING;
+  value_class := tclass1.create;
+  value_boolean := RESULT_BOOLEAN;
+  value_char := RESULT_CHAR;
+  value_s64real:=RESULT_S64REAL;
+  proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
+  
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if global_char <> RESULT_CHAR then
+    failed := true;
+  if global_boolean <> RESULT_BOOLEAN then
+    failed:=true;
+  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
+     failed := true;
+  if global_bigstring <> RESULT_SMALLSTRING then
+     failed := true;
+  if global_ptr <> value_ptr then
+     failed := true; 
+{  if value_class <> global_class then
+     failed := true;!!!!!!!!!!!!!!!!!!!!}
+  if global_s64bit <> RESULT_S64BIT then
+     failed := true;
+  if assigned(value_class) then
+    value_class.destroy;
+  global_u8bit := 0;
+  proc_var_smallarray_const_2([]);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+*)
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+  {***************************** MIXED  TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
+  if not ('I' in value_largeset) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2002-04-13 17:51:00  carl
+  + var parameter passing for different calling conventions
+
+
+}  

tests/test/cg/tcalvar6.pp

@@ -0,0 +1,814 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondcallparan()                                }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: This tests a subset of the secondcalln() node         }
+{          (var   parameters with safecall calling convention)   }
+{****************************************************************}
+program tcalvar6;
+{$mode objfpc}
+{$INLINE ON}
+{$R+}
+{$P-}
+{$V+}
+
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single  }
+ { double nodes are checked.           }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+{ should be defined depending on CPU target }
+{$ifdef cpu68k}
+  BIG_INDEX = 8000;
+  SMALL_INDEX  = 13;
+{$endif}
+{$ifdef cpui386}
+  BIG_INDEX = 33000;
+  SMALL_INDEX = 13;     { value should not be aligned! }
+{$endif}
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+  RESULT_S32REAL = 1777.12;
+  RESULT_S64REAL = 3444.24;
+  RESULT_BOOL8BIT = 1;
+  RESULT_BOOL16BIT = 1;
+  RESULT_BOOL32BIT = 1;
+  RESULT_PCHAR = 'Hello world';
+  RESULT_BIGSTRING = 'Hello world';
+  RESULT_SMALLSTRING = 'H';
+  RESULT_CHAR = 'I';
+  RESULT_BOOLEAN = TRUE;
+  
+type 
+  tclass1 = class
+  end;
+  
+  tprocedure = procedure;
+  
+  tsmallrecord = packed record
+    b: byte;
+    w: word;
+  end;
+  
+  tlargerecord = packed record
+    b: array[1..BIG_INDEX] of byte;
+  end;
+  
+  tsmallarray = packed array[1..SMALL_INDEX] of byte;
+  
+  tsmallsetenum = 
+  (A_A,A_B,A_C,A_D);
+  
+  tsmallset = set of tsmallsetenum;
+  tlargeset = set of char;
+  
+  tsmallstring = string[2];
+  
+  
+  
+  
+  
+var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s64bit : int64;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_class : tclass1;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s64bit : int64;
+ value_s32real : single;
+ value_s64real  : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_class : tclass1;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring   : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+ 
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    
+    procedure clear_globals;
+     begin
+      global_u8bit := 0;
+      global_u16bit := 0;
+      global_s32bit := 0;
+      global_s64bit := 0;
+      global_s32real := 0.0;
+      global_s64real := 0.0;
+      global_ptr := nil;
+      global_proc := nil;
+      global_class := nil;
+      global_bigstring := '';
+      global_boolean := false;
+      global_char := #0;
+     end;
+     
+     
+    procedure clear_values;
+     begin
+      value_u8bit := 0;
+      value_u16bit := 0;
+      value_s32bit := 0;
+      value_s64bit := 0;
+      value_s32real := 0.0;
+      value_s64real  := 0.0;
+      value_proc := nil;
+      value_ptr := nil;
+      value_class := nil;
+      fillchar(value_smallrec, sizeof(value_smallrec), #0);
+      fillchar(value_largerec, sizeof(value_largerec), #0);
+      value_smallset := [];
+      value_smallstring := '';
+      value_bigstring   := '';
+      value_largeset := [];
+      fillchar(value_smallarray, sizeof(value_smallarray), #0);
+      value_boolean := false;
+      value_char:=#0;
+     end;
+     
+   
+  procedure testprocedure;
+   begin
+   end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit:=RESULT_U8BIT;
+    end;
+    
+   function getu16bit: word;
+     begin
+       getu16bit:=RESULT_U16BIT;
+     end;
+     
+   function gets32bit: longint;
+    begin
+      gets32bit:=RESULT_S32BIT;
+    end;
+    
+   function gets64bit: longint;
+    begin
+      gets64bit:=RESULT_S32BIT;
+    end;
+ 
+
+   function gets32real: single;
+    begin
+      gets32real:=RESULT_S32REAL;
+    end;
+
+   function gets64real: double;
+    begin
+      gets64real:=RESULT_S64REAL;
+    end;
+
+  {************************************************************************}
+  {                           VAR   PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit(var v : longint);safecall;
+   begin
+     v:=RESULT_S32BIT;
+   end;
+   
+  procedure proc_var_s64bit(var v: int64);safecall;
+   begin
+     v:=RESULT_S64BIT;
+   end;
+
+
+  procedure proc_var_u8bit(var v: byte);safecall;
+   begin
+     v:=RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord(var smallrec : tsmallrecord);safecall;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+   end;
+
+
+  procedure proc_var_largerecord(var largerec : tlargerecord);safecall;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset(var smallset : tsmallset);safecall;
+   begin
+     smallset := [A_A,A_D];
+   end;
+   
+   
+  procedure proc_var_largeset(var largeset : tlargeset);safecall;
+   begin
+     largeset:= largeset + ['I'];
+   end;
+   
+
+  procedure proc_var_smallstring(var s:tsmallstring);safecall;
+   begin
+     s:=RESULT_SMALLSTRING;
+   end;
+    
+
+  procedure proc_var_bigstring(var s:shortstring);safecall;
+   begin
+     s:=RESULT_BIGSTRING;
+   end;
+   
+
+  procedure proc_var_openstring(var s: OpenString);safecall;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+   end;
+   
+  procedure proc_var_smallarray(var arr : tsmallarray);safecall;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open(var arr : array of byte);safecall;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1(var arr : array of const);safecall;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+  end;
+  
+
+  procedure proc_var_smallarray_const_2(var arr : array of const);safecall;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+  end;
+   
+
+  procedure proc_var_formaldef_array(var buf);safecall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string(var buf);safecall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+   
+
+  {************************************************************************}
+  {                     MIXED   VAR PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);safecall;
+   begin
+     v:=RESULT_S32BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);safecall;
+   begin
+     v:=RESULT_S64BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);safecall;
+   begin
+     v:=RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);safecall;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);safecall;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);safecall;
+   begin
+     smallset := [A_A,A_D];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+   
+  procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);safecall;
+   begin
+     largeset:= largeset + ['I'];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);safecall;
+   begin
+     s:=RESULT_SMALLSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+    
+
+  procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);safecall;
+   begin
+     s:=RESULT_BIGSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);safecall;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+    value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);safecall;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);safecall;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);safecall;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+     value_u8bit := RESULT_U8BIT;
+ end;
+  
+
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);safecall;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+end;
+   
+
+  procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);safecall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);safecall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+var
+  failed: boolean;
+  pp : ^pchar;
+begin
+  {***************************** NORMAL TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit(global_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit(global_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit(global_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord(value_smallrec);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord(value_largerec);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset(value_smallset);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset(value_largeset);
+  if not ('I' in value_largeset) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring(value_smallstring);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring(value_bigstring);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring(value_smallstring);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+    
+(*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
+  clear_globals;
+  clear_values;
+  value_u8bit := RESULT_U8BIT;
+  value_ptr := RESULT_PCHAR;
+  value_s64bit := RESULT_S64BIT;
+  value_smallstring := RESULT_SMALLSTRING;
+  value_class := tclass1.create;
+  value_boolean := RESULT_BOOLEAN;
+  value_char := RESULT_CHAR;
+  value_s64real:=RESULT_S64REAL;
+  proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
+  
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if global_char <> RESULT_CHAR then
+    failed := true;
+  if global_boolean <> RESULT_BOOLEAN then
+    failed:=true;
+  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
+     failed := true;
+  if global_bigstring <> RESULT_SMALLSTRING then
+     failed := true;
+  if global_ptr <> value_ptr then
+     failed := true; 
+{  if value_class <> global_class then
+     failed := true;!!!!!!!!!!!!!!!!!!!!}
+  if global_s64bit <> RESULT_S64BIT then
+     failed := true;
+  if assigned(value_class) then
+    value_class.destroy;
+  global_u8bit := 0;
+  proc_var_smallarray_const_2([]);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+*)
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+  {***************************** MIXED  TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
+  if not ('I' in value_largeset) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2002-04-13 17:51:00  carl
+  + var parameter passing for different calling conventions
+
+
+}  

tests/test/cg/tcalvar7.pp

@@ -0,0 +1,814 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondcallparan()                                }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: This tests a subset of the secondcalln() node         }
+{          (var   parameters with register calling convention)   }
+{****************************************************************}
+program tcalvar7;
+{$mode objfpc}
+{$INLINE ON}
+{$R+}
+{$P-}
+{$V+}
+
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single  }
+ { double nodes are checked.           }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+{ should be defined depending on CPU target }
+{$ifdef cpu68k}
+  BIG_INDEX = 8000;
+  SMALL_INDEX  = 13;
+{$endif}
+{$ifdef cpui386}
+  BIG_INDEX = 33000;
+  SMALL_INDEX = 13;     { value should not be aligned! }
+{$endif}
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+  RESULT_S32REAL = 1777.12;
+  RESULT_S64REAL = 3444.24;
+  RESULT_BOOL8BIT = 1;
+  RESULT_BOOL16BIT = 1;
+  RESULT_BOOL32BIT = 1;
+  RESULT_PCHAR = 'Hello world';
+  RESULT_BIGSTRING = 'Hello world';
+  RESULT_SMALLSTRING = 'H';
+  RESULT_CHAR = 'I';
+  RESULT_BOOLEAN = TRUE;
+  
+type 
+  tclass1 = class
+  end;
+  
+  tprocedure = procedure;
+  
+  tsmallrecord = packed record
+    b: byte;
+    w: word;
+  end;
+  
+  tlargerecord = packed record
+    b: array[1..BIG_INDEX] of byte;
+  end;
+  
+  tsmallarray = packed array[1..SMALL_INDEX] of byte;
+  
+  tsmallsetenum = 
+  (A_A,A_B,A_C,A_D);
+  
+  tsmallset = set of tsmallsetenum;
+  tlargeset = set of char;
+  
+  tsmallstring = string[2];
+  
+  
+  
+  
+  
+var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s64bit : int64;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_class : tclass1;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s64bit : int64;
+ value_s32real : single;
+ value_s64real  : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_class : tclass1;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring   : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+ 
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    
+    procedure clear_globals;
+     begin
+      global_u8bit := 0;
+      global_u16bit := 0;
+      global_s32bit := 0;
+      global_s64bit := 0;
+      global_s32real := 0.0;
+      global_s64real := 0.0;
+      global_ptr := nil;
+      global_proc := nil;
+      global_class := nil;
+      global_bigstring := '';
+      global_boolean := false;
+      global_char := #0;
+     end;
+     
+     
+    procedure clear_values;
+     begin
+      value_u8bit := 0;
+      value_u16bit := 0;
+      value_s32bit := 0;
+      value_s64bit := 0;
+      value_s32real := 0.0;
+      value_s64real  := 0.0;
+      value_proc := nil;
+      value_ptr := nil;
+      value_class := nil;
+      fillchar(value_smallrec, sizeof(value_smallrec), #0);
+      fillchar(value_largerec, sizeof(value_largerec), #0);
+      value_smallset := [];
+      value_smallstring := '';
+      value_bigstring   := '';
+      value_largeset := [];
+      fillchar(value_smallarray, sizeof(value_smallarray), #0);
+      value_boolean := false;
+      value_char:=#0;
+     end;
+     
+   
+  procedure testprocedure;
+   begin
+   end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit:=RESULT_U8BIT;
+    end;
+    
+   function getu16bit: word;
+     begin
+       getu16bit:=RESULT_U16BIT;
+     end;
+     
+   function gets32bit: longint;
+    begin
+      gets32bit:=RESULT_S32BIT;
+    end;
+    
+   function gets64bit: longint;
+    begin
+      gets64bit:=RESULT_S32BIT;
+    end;
+ 
+
+   function gets32real: single;
+    begin
+      gets32real:=RESULT_S32REAL;
+    end;
+
+   function gets64real: double;
+    begin
+      gets64real:=RESULT_S64REAL;
+    end;
+
+  {************************************************************************}
+  {                           VAR   PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit(var v : longint);register;
+   begin
+     v:=RESULT_S32BIT;
+   end;
+   
+  procedure proc_var_s64bit(var v: int64);register;
+   begin
+     v:=RESULT_S64BIT;
+   end;
+
+
+  procedure proc_var_u8bit(var v: byte);register;
+   begin
+     v:=RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord(var smallrec : tsmallrecord);register;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+   end;
+
+
+  procedure proc_var_largerecord(var largerec : tlargerecord);register;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset(var smallset : tsmallset);register;
+   begin
+     smallset := [A_A,A_D];
+   end;
+   
+   
+  procedure proc_var_largeset(var largeset : tlargeset);register;
+   begin
+     largeset:= largeset + ['I'];
+   end;
+   
+
+  procedure proc_var_smallstring(var s:tsmallstring);register;
+   begin
+     s:=RESULT_SMALLSTRING;
+   end;
+    
+
+  procedure proc_var_bigstring(var s:shortstring);register;
+   begin
+     s:=RESULT_BIGSTRING;
+   end;
+   
+
+  procedure proc_var_openstring(var s: OpenString);register;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+   end;
+   
+  procedure proc_var_smallarray(var arr : tsmallarray);register;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open(var arr : array of byte);register;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1(var arr : array of const);register;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+  end;
+  
+
+  procedure proc_var_smallarray_const_2(var arr : array of const);register;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+  end;
+   
+
+  procedure proc_var_formaldef_array(var buf);register;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string(var buf);register;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+   
+
+  {************************************************************************}
+  {                     MIXED   VAR PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);register;
+   begin
+     v:=RESULT_S32BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);register;
+   begin
+     v:=RESULT_S64BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);register;
+   begin
+     v:=RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);register;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);register;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);register;
+   begin
+     smallset := [A_A,A_D];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+   
+  procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);register;
+   begin
+     largeset:= largeset + ['I'];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);register;
+   begin
+     s:=RESULT_SMALLSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+    
+
+  procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);register;
+   begin
+     s:=RESULT_BIGSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);register;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+    value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);register;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);register;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);register;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+     value_u8bit := RESULT_U8BIT;
+ end;
+  
+
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);register;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+end;
+   
+
+  procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);register;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);register;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+var
+  failed: boolean;
+  pp : ^pchar;
+begin
+  {***************************** NORMAL TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit(global_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit(global_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit(global_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord(value_smallrec);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord(value_largerec);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset(value_smallset);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset(value_largeset);
+  if not ('I' in value_largeset) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring(value_smallstring);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring(value_bigstring);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring(value_smallstring);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+    
+(*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
+  clear_globals;
+  clear_values;
+  value_u8bit := RESULT_U8BIT;
+  value_ptr := RESULT_PCHAR;
+  value_s64bit := RESULT_S64BIT;
+  value_smallstring := RESULT_SMALLSTRING;
+  value_class := tclass1.create;
+  value_boolean := RESULT_BOOLEAN;
+  value_char := RESULT_CHAR;
+  value_s64real:=RESULT_S64REAL;
+  proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
+  
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if global_char <> RESULT_CHAR then
+    failed := true;
+  if global_boolean <> RESULT_BOOLEAN then
+    failed:=true;
+  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
+     failed := true;
+  if global_bigstring <> RESULT_SMALLSTRING then
+     failed := true;
+  if global_ptr <> value_ptr then
+     failed := true; 
+{  if value_class <> global_class then
+     failed := true;!!!!!!!!!!!!!!!!!!!!}
+  if global_s64bit <> RESULT_S64BIT then
+     failed := true;
+  if assigned(value_class) then
+    value_class.destroy;
+  global_u8bit := 0;
+  proc_var_smallarray_const_2([]);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+*)
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+  {***************************** MIXED  TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
+  if not ('I' in value_largeset) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2002-04-13 17:51:00  carl
+  + var parameter passing for different calling conventions
+
+
+}  

tests/test/cg/tcalvar8.pp

@@ -0,0 +1,814 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondcallparan()                                }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: This tests a subset of the secondcalln() node         }
+{          (var   parameters with stdcall  calling convention)   }
+{****************************************************************}
+program tcalvar8;
+{$mode objfpc}
+{$INLINE ON}
+{$R+}
+{$P-}
+{$V+}
+
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single  }
+ { double nodes are checked.           }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+{ should be defined depending on CPU target }
+{$ifdef cpu68k}
+  BIG_INDEX = 8000;
+  SMALL_INDEX  = 13;
+{$endif}
+{$ifdef cpui386}
+  BIG_INDEX = 33000;
+  SMALL_INDEX = 13;     { value should not be aligned! }
+{$endif}
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+  RESULT_S32REAL = 1777.12;
+  RESULT_S64REAL = 3444.24;
+  RESULT_BOOL8BIT = 1;
+  RESULT_BOOL16BIT = 1;
+  RESULT_BOOL32BIT = 1;
+  RESULT_PCHAR = 'Hello world';
+  RESULT_BIGSTRING = 'Hello world';
+  RESULT_SMALLSTRING = 'H';
+  RESULT_CHAR = 'I';
+  RESULT_BOOLEAN = TRUE;
+  
+type 
+  tclass1 = class
+  end;
+  
+  tprocedure = procedure;
+  
+  tsmallrecord = packed record
+    b: byte;
+    w: word;
+  end;
+  
+  tlargerecord = packed record
+    b: array[1..BIG_INDEX] of byte;
+  end;
+  
+  tsmallarray = packed array[1..SMALL_INDEX] of byte;
+  
+  tsmallsetenum = 
+  (A_A,A_B,A_C,A_D);
+  
+  tsmallset = set of tsmallsetenum;
+  tlargeset = set of char;
+  
+  tsmallstring = string[2];
+  
+  
+  
+  
+  
+var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s64bit : int64;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_class : tclass1;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s64bit : int64;
+ value_s32real : single;
+ value_s64real  : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_class : tclass1;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring   : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+ 
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    
+    procedure clear_globals;
+     begin
+      global_u8bit := 0;
+      global_u16bit := 0;
+      global_s32bit := 0;
+      global_s64bit := 0;
+      global_s32real := 0.0;
+      global_s64real := 0.0;
+      global_ptr := nil;
+      global_proc := nil;
+      global_class := nil;
+      global_bigstring := '';
+      global_boolean := false;
+      global_char := #0;
+     end;
+     
+     
+    procedure clear_values;
+     begin
+      value_u8bit := 0;
+      value_u16bit := 0;
+      value_s32bit := 0;
+      value_s64bit := 0;
+      value_s32real := 0.0;
+      value_s64real  := 0.0;
+      value_proc := nil;
+      value_ptr := nil;
+      value_class := nil;
+      fillchar(value_smallrec, sizeof(value_smallrec), #0);
+      fillchar(value_largerec, sizeof(value_largerec), #0);
+      value_smallset := [];
+      value_smallstring := '';
+      value_bigstring   := '';
+      value_largeset := [];
+      fillchar(value_smallarray, sizeof(value_smallarray), #0);
+      value_boolean := false;
+      value_char:=#0;
+     end;
+     
+   
+  procedure testprocedure;
+   begin
+   end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit:=RESULT_U8BIT;
+    end;
+    
+   function getu16bit: word;
+     begin
+       getu16bit:=RESULT_U16BIT;
+     end;
+     
+   function gets32bit: longint;
+    begin
+      gets32bit:=RESULT_S32BIT;
+    end;
+    
+   function gets64bit: longint;
+    begin
+      gets64bit:=RESULT_S32BIT;
+    end;
+ 
+
+   function gets32real: single;
+    begin
+      gets32real:=RESULT_S32REAL;
+    end;
+
+   function gets64real: double;
+    begin
+      gets64real:=RESULT_S64REAL;
+    end;
+
+  {************************************************************************}
+  {                           VAR   PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit(var v : longint);stdcall;
+   begin
+     v:=RESULT_S32BIT;
+   end;
+   
+  procedure proc_var_s64bit(var v: int64);stdcall;
+   begin
+     v:=RESULT_S64BIT;
+   end;
+
+
+  procedure proc_var_u8bit(var v: byte);stdcall;
+   begin
+     v:=RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord(var smallrec : tsmallrecord);stdcall;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+   end;
+
+
+  procedure proc_var_largerecord(var largerec : tlargerecord);stdcall;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset(var smallset : tsmallset);stdcall;
+   begin
+     smallset := [A_A,A_D];
+   end;
+   
+   
+  procedure proc_var_largeset(var largeset : tlargeset);stdcall;
+   begin
+     largeset:= largeset + ['I'];
+   end;
+   
+
+  procedure proc_var_smallstring(var s:tsmallstring);stdcall;
+   begin
+     s:=RESULT_SMALLSTRING;
+   end;
+    
+
+  procedure proc_var_bigstring(var s:shortstring);stdcall;
+   begin
+     s:=RESULT_BIGSTRING;
+   end;
+   
+
+  procedure proc_var_openstring(var s: OpenString);stdcall;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+   end;
+   
+  procedure proc_var_smallarray(var arr : tsmallarray);stdcall;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open(var arr : array of byte);stdcall;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1(var arr : array of const);stdcall;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+  end;
+  
+
+  procedure proc_var_smallarray_const_2(var arr : array of const);stdcall;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+  end;
+   
+
+  procedure proc_var_formaldef_array(var buf);stdcall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string(var buf);stdcall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+   
+
+  {************************************************************************}
+  {                     MIXED   VAR PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);stdcall;
+   begin
+     v:=RESULT_S32BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);stdcall;
+   begin
+     v:=RESULT_S64BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);stdcall;
+   begin
+     v:=RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);stdcall;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);stdcall;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);stdcall;
+   begin
+     smallset := [A_A,A_D];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+   
+  procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);stdcall;
+   begin
+     largeset:= largeset + ['I'];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);stdcall;
+   begin
+     s:=RESULT_SMALLSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+    
+
+  procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);stdcall;
+   begin
+     s:=RESULT_BIGSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);stdcall;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+    value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);stdcall;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);stdcall;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);stdcall;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+     value_u8bit := RESULT_U8BIT;
+ end;
+  
+
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);stdcall;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+end;
+   
+
+  procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);stdcall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);stdcall;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+var
+  failed: boolean;
+  pp : ^pchar;
+begin
+  {***************************** NORMAL TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit(global_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit(global_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit(global_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord(value_smallrec);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord(value_largerec);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset(value_smallset);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset(value_largeset);
+  if not ('I' in value_largeset) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring(value_smallstring);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring(value_bigstring);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring(value_smallstring);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+    
+(*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
+  clear_globals;
+  clear_values;
+  value_u8bit := RESULT_U8BIT;
+  value_ptr := RESULT_PCHAR;
+  value_s64bit := RESULT_S64BIT;
+  value_smallstring := RESULT_SMALLSTRING;
+  value_class := tclass1.create;
+  value_boolean := RESULT_BOOLEAN;
+  value_char := RESULT_CHAR;
+  value_s64real:=RESULT_S64REAL;
+  proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
+  
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if global_char <> RESULT_CHAR then
+    failed := true;
+  if global_boolean <> RESULT_BOOLEAN then
+    failed:=true;
+  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
+     failed := true;
+  if global_bigstring <> RESULT_SMALLSTRING then
+     failed := true;
+  if global_ptr <> value_ptr then
+     failed := true; 
+{  if value_class <> global_class then
+     failed := true;!!!!!!!!!!!!!!!!!!!!}
+  if global_s64bit <> RESULT_S64BIT then
+     failed := true;
+  if assigned(value_class) then
+    value_class.destroy;
+  global_u8bit := 0;
+  proc_var_smallarray_const_2([]);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+*)
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+  {***************************** MIXED  TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
+  if not ('I' in value_largeset) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2002-04-13 17:51:00  carl
+  + var parameter passing for different calling conventions
+
+
+}  

tests/test/cg/tcalvar9.pp

@@ -0,0 +1,814 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondcallparan()                                }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: This tests a subset of the secondcalln() node         }
+{          (var   parameters with saveregs  calling convention)  }
+{****************************************************************}
+program tcalvar9;
+{$mode objfpc}
+{$INLINE ON}
+{$R+}
+{$P-}
+{$V+}
+
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single  }
+ { double nodes are checked.           }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+{ should be defined depending on CPU target }
+{$ifdef cpu68k}
+  BIG_INDEX = 8000;
+  SMALL_INDEX  = 13;
+{$endif}
+{$ifdef cpui386}
+  BIG_INDEX = 33000;
+  SMALL_INDEX = 13;     { value should not be aligned! }
+{$endif}
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+  RESULT_S32REAL = 1777.12;
+  RESULT_S64REAL = 3444.24;
+  RESULT_BOOL8BIT = 1;
+  RESULT_BOOL16BIT = 1;
+  RESULT_BOOL32BIT = 1;
+  RESULT_PCHAR = 'Hello world';
+  RESULT_BIGSTRING = 'Hello world';
+  RESULT_SMALLSTRING = 'H';
+  RESULT_CHAR = 'I';
+  RESULT_BOOLEAN = TRUE;
+  
+type 
+  tclass1 = class
+  end;
+  
+  tprocedure = procedure;
+  
+  tsmallrecord = packed record
+    b: byte;
+    w: word;
+  end;
+  
+  tlargerecord = packed record
+    b: array[1..BIG_INDEX] of byte;
+  end;
+  
+  tsmallarray = packed array[1..SMALL_INDEX] of byte;
+  
+  tsmallsetenum = 
+  (A_A,A_B,A_C,A_D);
+  
+  tsmallset = set of tsmallsetenum;
+  tlargeset = set of char;
+  
+  tsmallstring = string[2];
+  
+  
+  
+  
+  
+var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s64bit : int64;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_class : tclass1;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s64bit : int64;
+ value_s32real : single;
+ value_s64real  : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_class : tclass1;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring   : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+ 
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    
+    procedure clear_globals;
+     begin
+      global_u8bit := 0;
+      global_u16bit := 0;
+      global_s32bit := 0;
+      global_s64bit := 0;
+      global_s32real := 0.0;
+      global_s64real := 0.0;
+      global_ptr := nil;
+      global_proc := nil;
+      global_class := nil;
+      global_bigstring := '';
+      global_boolean := false;
+      global_char := #0;
+     end;
+     
+     
+    procedure clear_values;
+     begin
+      value_u8bit := 0;
+      value_u16bit := 0;
+      value_s32bit := 0;
+      value_s64bit := 0;
+      value_s32real := 0.0;
+      value_s64real  := 0.0;
+      value_proc := nil;
+      value_ptr := nil;
+      value_class := nil;
+      fillchar(value_smallrec, sizeof(value_smallrec), #0);
+      fillchar(value_largerec, sizeof(value_largerec), #0);
+      value_smallset := [];
+      value_smallstring := '';
+      value_bigstring   := '';
+      value_largeset := [];
+      fillchar(value_smallarray, sizeof(value_smallarray), #0);
+      value_boolean := false;
+      value_char:=#0;
+     end;
+     
+   
+  procedure testprocedure;
+   begin
+   end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit:=RESULT_U8BIT;
+    end;
+    
+   function getu16bit: word;
+     begin
+       getu16bit:=RESULT_U16BIT;
+     end;
+     
+   function gets32bit: longint;
+    begin
+      gets32bit:=RESULT_S32BIT;
+    end;
+    
+   function gets64bit: longint;
+    begin
+      gets64bit:=RESULT_S32BIT;
+    end;
+ 
+
+   function gets32real: single;
+    begin
+      gets32real:=RESULT_S32REAL;
+    end;
+
+   function gets64real: double;
+    begin
+      gets64real:=RESULT_S64REAL;
+    end;
+
+  {************************************************************************}
+  {                           VAR   PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit(var v : longint);saveregisters;
+   begin
+     v:=RESULT_S32BIT;
+   end;
+   
+  procedure proc_var_s64bit(var v: int64);saveregisters;
+   begin
+     v:=RESULT_S64BIT;
+   end;
+
+
+  procedure proc_var_u8bit(var v: byte);saveregisters;
+   begin
+     v:=RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord(var smallrec : tsmallrecord);saveregisters;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+   end;
+
+
+  procedure proc_var_largerecord(var largerec : tlargerecord);saveregisters;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset(var smallset : tsmallset);saveregisters;
+   begin
+     smallset := [A_A,A_D];
+   end;
+   
+   
+  procedure proc_var_largeset(var largeset : tlargeset);saveregisters;
+   begin
+     largeset:= largeset + ['I'];
+   end;
+   
+
+  procedure proc_var_smallstring(var s:tsmallstring);saveregisters;
+   begin
+     s:=RESULT_SMALLSTRING;
+   end;
+    
+
+  procedure proc_var_bigstring(var s:shortstring);saveregisters;
+   begin
+     s:=RESULT_BIGSTRING;
+   end;
+   
+
+  procedure proc_var_openstring(var s: OpenString);saveregisters;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+   end;
+   
+  procedure proc_var_smallarray(var arr : tsmallarray);saveregisters;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open(var arr : array of byte);saveregisters;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1(var arr : array of const);saveregisters;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+  end;
+  
+
+  procedure proc_var_smallarray_const_2(var arr : array of const);saveregisters;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+  end;
+   
+
+  procedure proc_var_formaldef_array(var buf);saveregisters;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string(var buf);saveregisters;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+  end;
+   
+
+  {************************************************************************}
+  {                     MIXED   VAR PARAMETERS                             }
+  {************************************************************************}
+  procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);saveregisters;
+   begin
+     v:=RESULT_S32BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);saveregisters;
+   begin
+     v:=RESULT_S64BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);saveregisters;
+   begin
+     v:=RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);saveregisters;
+   begin
+     smallrec.b := RESULT_U8BIT;
+     smallrec.w := RESULT_U16BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);saveregisters;
+   begin
+     largerec.b[1] := RESULT_U8BIT;
+     largerec.b[2] := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+   end;
+
+
+  procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);saveregisters;
+   begin
+     smallset := [A_A,A_D];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+   
+  procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);saveregisters;
+   begin
+     largeset:= largeset + ['I'];
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);saveregisters;
+   begin
+     s:=RESULT_SMALLSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+    
+
+  procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);saveregisters;
+   begin
+     s:=RESULT_BIGSTRING;
+     value_u8bit := RESULT_U8BIT;
+   end;
+   
+
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);saveregisters;
+   begin
+    global_u8bit := high(s);
+    s:=RESULT_SMALLSTRING;
+    value_u8bit := RESULT_U8BIT;
+   end;
+   
+  procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);saveregisters;
+  begin
+    arr[SMALL_INDEX] := RESULT_U8BIT;
+    arr[1] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+  
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);saveregisters;
+  begin
+    arr[high(arr)] := RESULT_U8BIT;
+    arr[low(arr)] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);saveregisters;
+  var
+   i: integer;
+  begin
+    for i:=0 to high(arr) do
+     begin
+       case arr[i].vtype of 
+        vtInteger : arr[i].vinteger := RESULT_U8BIT;
+        vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
+        else
+          RunError(255);
+       end;
+     end; {endfor}
+     value_u8bit := RESULT_U8BIT;
+ end;
+  
+
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);saveregisters;
+  var
+   i: integer;
+  begin
+     if high(arr)<0 then
+       global_u8bit := RESULT_U8BIT;
+     value_u8bit := RESULT_U8BIT;
+end;
+   
+
+  procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);saveregisters;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+
+procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);saveregisters;
+  var
+   p: ^byte;
+  begin
+    { array is indexed from 1 }
+    p := @buf;
+    p[SMALL_INDEX-1] := RESULT_U8BIT;
+    p[0] := RESULT_U8BIT;
+    value_u8bit := RESULT_U8BIT;
+  end;
+
+var
+  failed: boolean;
+  pp : ^pchar;
+begin
+  {***************************** NORMAL TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit(global_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit(global_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit(global_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord(value_smallrec);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord(value_largerec);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset(value_smallset);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset(value_largeset);
+  if not ('I' in value_largeset) then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring(value_smallstring);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring(value_bigstring);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring(value_smallstring);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open(value_smallarray);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+    
+(*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
+  clear_globals;
+  clear_values;
+  value_u8bit := RESULT_U8BIT;
+  value_ptr := RESULT_PCHAR;
+  value_s64bit := RESULT_S64BIT;
+  value_smallstring := RESULT_SMALLSTRING;
+  value_class := tclass1.create;
+  value_boolean := RESULT_BOOLEAN;
+  value_char := RESULT_CHAR;
+  value_s64real:=RESULT_S64REAL;
+  proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
+  
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if global_char <> RESULT_CHAR then
+    failed := true;
+  if global_boolean <> RESULT_BOOLEAN then
+    failed:=true;
+  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
+     failed := true;
+  if global_bigstring <> RESULT_SMALLSTRING then
+     failed := true;
+  if global_ptr <> value_ptr then
+     failed := true; 
+{  if value_class <> global_class then
+     failed := true;!!!!!!!!!!!!!!!!!!!!}
+  if global_s64bit <> RESULT_S64BIT then
+     failed := true;
+  if assigned(value_class) then
+    value_class.destroy;
+  global_u8bit := 0;
+  proc_var_smallarray_const_2([]);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+*)
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+  {***************************** MIXED  TESTS *******************************}
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
+  proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
+  if global_s32bit <> RESULT_S32BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed:=true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+  write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+
+  proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT);
+  if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
+  if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('var parameter test (src : LOC_REFERENCE (setdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  
+  proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
+  if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  clear_globals;
+  clear_values;
+  proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
+  if not ('I' in value_largeset) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+
+  write('var parameter test (src : LOC_REFERENCE (stringdef)))...');
+  clear_globals;
+  clear_values;
+  failed := false;
+  proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if value_smallstring <> RESULT_SMALLSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT);
+  if value_bigstring <> RESULT_BIGSTRING then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_globals;
+  clear_values;
+  proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT);
+  if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+    
+  write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
+  
+  clear_globals;
+  clear_values;
+  failed:=false;
+  
+  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
+  proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+
+
+  clear_globals;
+  clear_values;
+
+  proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
+  if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
+    failed := true;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+  
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2002-04-13 17:51:00  carl
+  + var parameter passing for different calling conventions
+
+
+}