* fixed for non i386/m68k cpus

tests/test/cg/tsubst.pp

@@ -1,769 +1,771 @@
-{****************************************************************}
-{  CODE GENERATOR TEST PROGRAM                                   }
-{****************************************************************}
-{ NODE TESTED : secondsubscriptn(), partial secondload()         }
-{****************************************************************}
-{ PRE-REQUISITES: secondload()                                   }
-{                 secondassign()                                 }
-{****************************************************************}
-{ DEFINES:   VERBOSE = Write test information to screen          }
-{            FPC     = Target is FreePascal compiler             }
-{****************************************************************}
-{ REMARKS:                                                       }
-{                                                                }
-{                                                                }
-{                                                                }
-{****************************************************************}
-Program tsubst1;
-{$mode objfpc}
-
-
-{$IFNDEF FPC}
-type  smallint = integer;
-{$ENDIF}
-const
- { Should be equal to the maximum offset possible in indirect addressing
-   mode with displacement. (CPU SPECIFIC) }
-
-{$ifdef cpu86}
- MAX_DISP = 65535;
-{$endif}
-{$ifdef cpu68k}
- MAX_DISP = 32767;
-{$endif}
-
-{ These different alignments are described in the PowerPC ABI
-  supplement, they should represent most possible cases.
-}
-type
-tlevel1rec = record
- c: byte;
-end;
-
-tlevel2rec = record
- c: byte;
- d: byte;
- s: word;
- n: longint;
-end;
-
-tlevel3rec = record
- c: byte;
- s: word;
-end;
-
-tlevel4rec = record
- c: byte;
- i : int64;
- s: word;
-end;
-
-tlevel5rec = record
- c: byte;
- s: word;
- j: longint;
-end;
-
-tlevel1rec_big = record
- fill : array[1..MAX_DISP] of byte;
- c: byte;
-end;
-
-tlevel2rec_big = record
- fill : array[1..MAX_DISP] of byte;
- c: byte;
- d: byte;
- s: word;
- n: longint;
-end;
-
-tlevel3rec_big = record
- fill : array[1..MAX_DISP] of byte;
- c: byte;
- s: word;
-end;
-
-tlevel4rec_big = record
- fill : array[1..MAX_DISP] of byte;
- c: byte;
- i : int64;
- s: word;
-end;
-
-tlevel5rec_big = record
- fill : array[1..MAX_DISP] of byte;
- c: byte;
- s: word;
- j: longint;
-end;
-
-{ packed record, for testing misaligned access }
-tlevel1rec_packed = packed record
- c: byte;
-end;
-
-tlevel2rec_packed = packed record
- c: byte;
- d: byte;
- s: word;
- n: longint;
-end;
-
-tlevel3rec_packed = packed record
- c: byte;
- s: word;
-end;
-
-tlevel4rec_packed = packed record
- c: byte;
- i : int64;
- s: word;
-end;
-
-tlevel5rec_packed = packed record
- c: byte;
- s: word;
- j: longint;
-end;
-
-tclass1 = class
- fill : array[1..MAX_DISP] of byte;
- c: byte;
- s: word;
- j: longint;
-end;
-
-tclass2 = class
- c: byte;
- s: word;
- i: int64;
-end;
-
-
- { test with global variables }
- const
-  RESULT_U8BIT = $55;
-  RESULT_U16BIT = $500F;
-  RESULT_S32BIT = $500F0000;
-  RESULT_S64BIT = $500F0000;
-
-
-
-
-
- level1rec : tlevel1rec =
- (
-  c: RESULT_U8BIT
- );
-
- level2rec : tlevel2rec =
- (
-   c: RESULT_U8BIT;
-   d: RESULT_U8BIT;
-   s: RESULT_U16BIT;
-   n: RESULT_S32BIT;
- );
-
- level3rec : tlevel3rec =
- (
-  c: RESULT_U8BIT;
-  s: RESULT_U16BIT;
-
- );
-
- level4rec : tlevel4rec =
- (
-  c: RESULT_U8BIT;
-  i : RESULT_S64BIT;
-  s : RESULT_U16BIT
- );
-
- level5rec : tlevel5rec =
- (
-   c: RESULT_U8BIT;
-   s: RESULT_U16BIT;
-   j: RESULT_S32BIT;
- );
-
- level1rec_packed : tlevel1rec_packed =
- (
-  c: RESULT_U8BIT
- );
-
- level2rec_packed : tlevel2rec_packed =
- (
-   c: RESULT_U8BIT;
-   d: RESULT_U8BIT;
-   s: RESULT_U16BIT;
-   n: RESULT_S32BIT;
- );
-
- level3rec_packed : tlevel3rec_packed =
- (
-  c: RESULT_U8BIT;
-  s: RESULT_U16BIT;
- );
-
- level4rec_packed : tlevel4rec_packed =
- (
-  c: RESULT_U8BIT;
-  i : RESULT_S64BIT;
-  s : RESULT_U16BIT
- );
-
- level5rec_packed : tlevel5rec_packed =
- (
-   c: RESULT_U8BIT;
-   s: RESULT_U16BIT;
-   j: RESULT_S32BIT;
- );
-
-    procedure fail;
-    begin
-      WriteLn('Failure.');
-      halt(1);
-    end;
-
-var
- c,d: byte;
- s: word;
- n,j: longint;
- i: int64;
- failed : boolean;
- class1 : tclass1;
- class2 : tclass2;
-
- procedure clear_globals;
-  begin
-    c:=0;
-    d:=0;
-    s:=0;
-    n:=0;
-    j:=0;
-    i:=0;
-    class1:=nil;
-    class2:=nil
-  end;
-
-
- function getclass : tclass1;
-  begin
-    getclass := class1;
-  end;
-
- function getclass2: tclass2;
-  begin
-    getclass2 := class2;
-  end;
-
-{$ifndef cpu68k}
- procedure testlocal_big_1;
- var
-   local1rec_big : tlevel1rec_big;
-  begin
-     clear_globals;
-     local1rec_big.c := RESULT_U8BIT;
-     c:= local1rec_big.c;
-     if c <> RESULT_U8BIT then
-       failed := true;
-  end;
-
-
-  procedure testlocal_big_2;
-   var
-    local2rec_big : tlevel2rec_big;
-   begin
-     clear_globals;
-     { setup values - assign }
-     local2rec_big.c := RESULT_U8BIT;
-     local2rec_big.d := RESULT_U8BIT;
-     local2rec_big.s := RESULT_U16BIT;
-     local2rec_big.n := RESULT_S32BIT;
-     { load values - load }
-     c:= local2rec_big.c;
-     if c <> RESULT_U8BIT then
-       failed := true;
-     d:= local2rec_big.d;
-     if d <> RESULT_U8BIT then
-       failed := true;
-     s:= local2rec_big.s;
-     if s <> RESULT_U16BIT then
-       failed := true;
-     n:= local2rec_big.n;
-     if n <> RESULT_S32BIT then
-       failed := true;
-   end;
-
-
-   procedure testlocal_big_3;
-    var
-     local3rec_big : tlevel3rec_big;
-    begin
-     clear_globals;
-     { setup values - assign }
-     local3rec_big.c := RESULT_U8BIT;
-     local3rec_big.s := RESULT_U16BIT;
-     c:= local3rec_big.c;
-     if c <> RESULT_U8BIT then
-       failed := true;
-     s:= local3rec_big.s;
-     if s <> RESULT_U16BIT then
-       failed := true;
-    end;
-
-    procedure testlocal_big_4;
-    var
-     local4rec_big : tlevel4rec_big;
-     begin
-         clear_globals;
-         { setup values - assign }
-         local4rec_big.c := RESULT_U8BIT;
-         local4rec_big.i := RESULT_S64BIT;
-         local4rec_big.s := RESULT_U16BIT;
-
-         c:= local4rec_big.c;
-         if c <> RESULT_U8BIT then
-           failed := true;
-         i:= local4rec_big.i;
-         if i <> RESULT_S64BIT then
-           failed := true;
-         s:= local4rec_big.s;
-         if s <> RESULT_U16BIT then
-           failed := true;
-     end;
-
-
-     procedure testlocal_big_5;
-     var
-      local5rec_big : tlevel5rec_big;
-      begin
-       clear_globals;
-       { setup values - assign }
-       local5rec_big.c := RESULT_U8BIT;
-       local5rec_big.s := RESULT_U16BIT;
-       local5rec_big.j := RESULT_S32BIT;
-       c:= local5rec_big.c;
-       if c <> RESULT_U8BIT then
-        failed := true;
-       s:= local5rec_big.s;
-       if s <> RESULT_U16BIT then
-        failed := true;
-       j:= local5rec_big.j;
-       if j <> RESULT_S32BIT then
-        failed := true;
-     end;
-{$endif}
-
-procedure testlocals;
-var
- local1rec : tlevel1rec_packed;
- local2rec : tlevel2rec_packed;
- local3rec : tlevel3rec_packed;
- local4rec : tlevel4rec_packed;
- local5rec : tlevel5rec_packed;
-begin
- { normal record access }
- Write('Non-Aligned simple local record access (secondvecn())...');
- failed := false;
-
- clear_globals;
-
- clear_globals;
- local1rec.c := RESULT_U8BIT;
- c:= local1rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- { setup values - assign }
- local2rec.c := RESULT_U8BIT;
- local2rec.d := RESULT_U8BIT;
- local2rec.s := RESULT_U16BIT;
- local2rec.n := RESULT_S32BIT;
- { load values - load }
- c:= local2rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- d:= local2rec.d;
- if d <> RESULT_U8BIT then
-   failed := true;
- s:= local2rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- n:= local2rec.n;
- if n <> RESULT_S32BIT then
-   failed := true;
-
-
- clear_globals;
- { setup values - assign }
- local3rec.c := RESULT_U8BIT;
- local3rec.s := RESULT_U16BIT;
- c:= local3rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= local3rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- clear_globals;
- { setup values - assign }
- local4rec.c := RESULT_U8BIT;
- local4rec.i := RESULT_S64BIT;
- local4rec.s := RESULT_U16BIT;
-
- c:= local4rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- i:= local4rec.i;
- if i <> RESULT_S64BIT then
-   failed := true;
- s:= local4rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- clear_globals;
- { setup values - assign }
- local5rec.c := RESULT_U8BIT;
- local5rec.s := RESULT_U16BIT;
- local5rec.j := RESULT_S32BIT;
-
- c:= local5rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= local5rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- j:= local5rec.j;
- if j <> RESULT_S32BIT then
-   failed := true;
-
- if failed then
-   fail
- else
-   WriteLN('Passed!');
-end;
-{---------------------------}
-
-var
- level1rec_big : tlevel1rec_big;
- level2rec_big : tlevel2rec_big;
- level3rec_big : tlevel3rec_big;
- level4rec_big : tlevel4rec_big;
- level5rec_big : tlevel5rec_big;
-begin
- { normal record access }
- Write('Aligned simple global record access (secondvecn())...');
- failed := false;
-
- clear_globals;
- c:= level1rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- c:= level2rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- d:= level2rec.d;
- if d <> RESULT_U8BIT then
-   failed := true;
- s:= level2rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- n:= level2rec.n;
- if n <> RESULT_S32BIT then
-   failed := true;
-
-
- clear_globals;
- c:= level3rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= level3rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
-
- clear_globals;
- c:= level4rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- i:= level4rec.i;
- if i <> RESULT_S64BIT then
-   failed := true;
- s:= level4rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- clear_globals;
- c:= level5rec.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= level5rec.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- j:= level5rec.j;
- if j <> RESULT_S32BIT then
-   failed := true;
-
- if failed then
-   fail
- else
-   WriteLN('Passed!');
-
- Write('Non-Aligned simple global record access (secondvecn())...');
-
- clear_globals;
- c:= level1rec_packed.c;
- if c <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- c:= level2rec_packed.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- d:= level2rec_packed.d;
- if d <> RESULT_U8BIT then
-   failed := true;
- s:= level2rec_packed.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- n:= level2rec_packed.n;
- if n <> RESULT_S32BIT then
-   failed := true;
-
-
- clear_globals;
- c:= level3rec_packed.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= level3rec_packed.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
-
- clear_globals;
- c:= level4rec_packed.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- i:= level4rec_packed.i;
- if i <> RESULT_S64BIT then
-   failed := true;
- s:= level4rec_packed.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- clear_globals;
- c:= level5rec_packed.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= level5rec_packed.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- j:= level5rec_packed.j;
- if j <> RESULT_S32BIT then
-   failed := true;
-
- if failed then
-   fail
- else
-   WriteLN('Passed!');
-
- Write('Non-Aligned big global record access (secondvecn())...');
-
- clear_globals;
- level1rec_big.c := RESULT_U8BIT;
- c:= level1rec_big.c;
- if c <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- { setup values - assign }
- level2rec_big.c := RESULT_U8BIT;
- level2rec_big.d := RESULT_U8BIT;
- level2rec_big.s := RESULT_U16BIT;
- level2rec_big.n := RESULT_S32BIT;
- { load values - load }
- c:= level2rec_big.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- d:= level2rec_big.d;
- if d <> RESULT_U8BIT then
-   failed := true;
- s:= level2rec_big.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- n:= level2rec_big.n;
- if n <> RESULT_S32BIT then
-   failed := true;
-
-
- clear_globals;
- { setup values - assign }
- level3rec_big.c := RESULT_U8BIT;
- level3rec_big.s := RESULT_U16BIT;
- c:= level3rec_big.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= level3rec_big.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- clear_globals;
- { setup values - assign }
- level4rec_big.c := RESULT_U8BIT;
- level4rec_big.i := RESULT_S64BIT;
- level4rec_big.s := RESULT_U16BIT;
-
- c:= level4rec_big.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- i:= level4rec_big.i;
- if i <> RESULT_S64BIT then
-   failed := true;
- s:= level4rec_big.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- clear_globals;
- { setup values - assign }
- level5rec_big.c := RESULT_U8BIT;
- level5rec_big.s := RESULT_U16BIT;
- level5rec_big.j := RESULT_S32BIT;
-
- c:= level5rec_big.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- s:= level5rec_big.s;
- if s <> RESULT_U16BIT then
-   failed := true;
- j:= level5rec_big.j;
- if j <> RESULT_S32BIT then
-   failed := true;
-
- if failed then
-   fail
- else
-   WriteLN('Passed!');
-
- testlocals;
-
-{$ifndef cpu68k}
- Write('Non-Aligned big local record access (secondvecn())...');
- failed := false;
-
- testlocal_big_1;
- testlocal_big_2;
- testlocal_big_3;
- testlocal_big_4;
- testlocal_big_5;
- if failed then
-   fail
- else
-   WriteLN('Passed!');
-{$endif}
- Write('Aligned class big field access (secondvecn())...');
- clear_globals;
- failed := false;
-
-
- { LOC_REFERENCE }
- class1:=tclass1.create;
- class1.c:= RESULT_U8BIT;
- class1.j:= RESULT_S32BIT;
- class1.s:= RESULT_U16BIT;
- c:=class1.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- j:=class1.j;
- if j <> RESULT_S32BIT then
-   failed := true;
- s:=class1.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- class1.destroy;
- clear_globals;
-
- { LOC_REGISTER }
- class1:=tclass1.create;
- class1.c:= RESULT_U8BIT;
- class1.j:= RESULT_S32BIT;
- class1.s:= RESULT_U16BIT;
- c:=(getclass).c;
- if c <> RESULT_U8BIT then
-   failed := true;
- j:=(getclass).j;
- if j <> RESULT_S32BIT then
-   failed := true;
- s:=(getclass).s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- class1.destroy;
-
-
- if failed then
-   fail
- else
-   WriteLN('Passed!');
- {----------------------------------------------------------------------------}
- Write('Aligned class simple field access (secondvecn())...');
- clear_globals;
- failed := false;
-
-
- { LOC_REFERENCE }
- class2:=tclass2.create;
- class2.c:= RESULT_U8BIT;
- class2.i:= RESULT_S64BIT;
- class2.s:= RESULT_U16BIT;
- c:=class2.c;
- if c <> RESULT_U8BIT then
-   failed := true;
- i:=class2.i;
- if i <> RESULT_S64BIT then
-   failed := true;
- s:=class2.s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- class2.destroy;
- clear_globals;
-
- { LOC_REGISTER }
- class2:=tclass2.create;
- class2.c:= RESULT_U8BIT;
- class2.i:= RESULT_S64BIT;
- class2.s:= RESULT_U16BIT;
- c:=(getclass2).c;
- if c <> RESULT_U8BIT then
-   failed := true;
- i:=(getclass2).i;
- if i <> RESULT_S64BIT then
-   failed := true;
- s:=(getclass2).s;
- if s <> RESULT_U16BIT then
-   failed := true;
-
- class2.destroy;
-
-
- if failed then
-   fail
- else
-   WriteLN('Passed!');
-
-
-end.
-
-{
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondsubscriptn(), partial secondload()         }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{****************************************************************}
+{ DEFINES:   VERBOSE = Write test information to screen          }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS:                                                       }
+{                                                                }
+{                                                                }
+{                                                                }
+{****************************************************************}
+Program tsubst1;
+{$mode objfpc}
+
+
+{$IFNDEF FPC}
+type  smallint = integer;
+{$ENDIF}
+const
+ { Should be equal to the maximum offset possible in indirect addressing
+   mode with displacement. (CPU SPECIFIC) }
+
+{$ifdef cpu68k}
+ MAX_DISP = 32767;
+{$else}
+ MAX_DISP = 65535;
+{$endif}
+
+{ These different alignments are described in the PowerPC ABI
+  supplement, they should represent most possible cases.
+}
+type
+tlevel1rec = record
+ c: byte;
+end;
+
+tlevel2rec = record
+ c: byte;
+ d: byte;
+ s: word;
+ n: longint;
+end;
+
+tlevel3rec = record
+ c: byte;
+ s: word;
+end;
+
+tlevel4rec = record
+ c: byte;
+ i : int64;
+ s: word;
+end;
+
+tlevel5rec = record
+ c: byte;
+ s: word;
+ j: longint;
+end;
+
+tlevel1rec_big = record
+ fill : array[1..MAX_DISP] of byte;
+ c: byte;
+end;
+
+tlevel2rec_big = record
+ fill : array[1..MAX_DISP] of byte;
+ c: byte;
+ d: byte;
+ s: word;
+ n: longint;
+end;
+
+tlevel3rec_big = record
+ fill : array[1..MAX_DISP] of byte;
+ c: byte;
+ s: word;
+end;
+
+tlevel4rec_big = record
+ fill : array[1..MAX_DISP] of byte;
+ c: byte;
+ i : int64;
+ s: word;
+end;
+
+tlevel5rec_big = record
+ fill : array[1..MAX_DISP] of byte;
+ c: byte;
+ s: word;
+ j: longint;
+end;
+
+{ packed record, for testing misaligned access }
+tlevel1rec_packed = packed record
+ c: byte;
+end;
+
+tlevel2rec_packed = packed record
+ c: byte;
+ d: byte;
+ s: word;
+ n: longint;
+end;
+
+tlevel3rec_packed = packed record
+ c: byte;
+ s: word;
+end;
+
+tlevel4rec_packed = packed record
+ c: byte;
+ i : int64;
+ s: word;
+end;
+
+tlevel5rec_packed = packed record
+ c: byte;
+ s: word;
+ j: longint;
+end;
+
+tclass1 = class
+ fill : array[1..MAX_DISP] of byte;
+ c: byte;
+ s: word;
+ j: longint;
+end;
+
+tclass2 = class
+ c: byte;
+ s: word;
+ i: int64;
+end;
+
+
+ { test with global variables }
+ const
+  RESULT_U8BIT = $55;
+  RESULT_U16BIT = $500F;
+  RESULT_S32BIT = $500F0000;
+  RESULT_S64BIT = $500F0000;
+
+
+
+
+
+ level1rec : tlevel1rec =
+ (
+  c: RESULT_U8BIT
+ );
+
+ level2rec : tlevel2rec =
+ (
+   c: RESULT_U8BIT;
+   d: RESULT_U8BIT;
+   s: RESULT_U16BIT;
+   n: RESULT_S32BIT;
+ );
+
+ level3rec : tlevel3rec =
+ (
+  c: RESULT_U8BIT;
+  s: RESULT_U16BIT;
+
+ );
+
+ level4rec : tlevel4rec =
+ (
+  c: RESULT_U8BIT;
+  i : RESULT_S64BIT;
+  s : RESULT_U16BIT
+ );
+
+ level5rec : tlevel5rec =
+ (
+   c: RESULT_U8BIT;
+   s: RESULT_U16BIT;
+   j: RESULT_S32BIT;
+ );
+
+ level1rec_packed : tlevel1rec_packed =
+ (
+  c: RESULT_U8BIT
+ );
+
+ level2rec_packed : tlevel2rec_packed =
+ (
+   c: RESULT_U8BIT;
+   d: RESULT_U8BIT;
+   s: RESULT_U16BIT;
+   n: RESULT_S32BIT;
+ );
+
+ level3rec_packed : tlevel3rec_packed =
+ (
+  c: RESULT_U8BIT;
+  s: RESULT_U16BIT;
+ );
+
+ level4rec_packed : tlevel4rec_packed =
+ (
+  c: RESULT_U8BIT;
+  i : RESULT_S64BIT;
+  s : RESULT_U16BIT
+ );
+
+ level5rec_packed : tlevel5rec_packed =
+ (
+   c: RESULT_U8BIT;
+   s: RESULT_U16BIT;
+   j: RESULT_S32BIT;
+ );
+
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+
+var
+ c,d: byte;
+ s: word;
+ n,j: longint;
+ i: int64;
+ failed : boolean;
+ class1 : tclass1;
+ class2 : tclass2;
+
+ procedure clear_globals;
+  begin
+    c:=0;
+    d:=0;
+    s:=0;
+    n:=0;
+    j:=0;
+    i:=0;
+    class1:=nil;
+    class2:=nil
+  end;
+
+
+ function getclass : tclass1;
+  begin
+    getclass := class1;
+  end;
+
+ function getclass2: tclass2;
+  begin
+    getclass2 := class2;
+  end;
+
+{$ifndef cpu68k}
+ procedure testlocal_big_1;
+ var
+   local1rec_big : tlevel1rec_big;
+  begin
+     clear_globals;
+     local1rec_big.c := RESULT_U8BIT;
+     c:= local1rec_big.c;
+     if c <> RESULT_U8BIT then
+       failed := true;
+  end;
+
+
+  procedure testlocal_big_2;
+   var
+    local2rec_big : tlevel2rec_big;
+   begin
+     clear_globals;
+     { setup values - assign }
+     local2rec_big.c := RESULT_U8BIT;
+     local2rec_big.d := RESULT_U8BIT;
+     local2rec_big.s := RESULT_U16BIT;
+     local2rec_big.n := RESULT_S32BIT;
+     { load values - load }
+     c:= local2rec_big.c;
+     if c <> RESULT_U8BIT then
+       failed := true;
+     d:= local2rec_big.d;
+     if d <> RESULT_U8BIT then
+       failed := true;
+     s:= local2rec_big.s;
+     if s <> RESULT_U16BIT then
+       failed := true;
+     n:= local2rec_big.n;
+     if n <> RESULT_S32BIT then
+       failed := true;
+   end;
+
+
+   procedure testlocal_big_3;
+    var
+     local3rec_big : tlevel3rec_big;
+    begin
+     clear_globals;
+     { setup values - assign }
+     local3rec_big.c := RESULT_U8BIT;
+     local3rec_big.s := RESULT_U16BIT;
+     c:= local3rec_big.c;
+     if c <> RESULT_U8BIT then
+       failed := true;
+     s:= local3rec_big.s;
+     if s <> RESULT_U16BIT then
+       failed := true;
+    end;
+
+    procedure testlocal_big_4;
+    var
+     local4rec_big : tlevel4rec_big;
+     begin
+         clear_globals;
+         { setup values - assign }
+         local4rec_big.c := RESULT_U8BIT;
+         local4rec_big.i := RESULT_S64BIT;
+         local4rec_big.s := RESULT_U16BIT;
+
+         c:= local4rec_big.c;
+         if c <> RESULT_U8BIT then
+           failed := true;
+         i:= local4rec_big.i;
+         if i <> RESULT_S64BIT then
+           failed := true;
+         s:= local4rec_big.s;
+         if s <> RESULT_U16BIT then
+           failed := true;
+     end;
+
+
+     procedure testlocal_big_5;
+     var
+      local5rec_big : tlevel5rec_big;
+      begin
+       clear_globals;
+       { setup values - assign }
+       local5rec_big.c := RESULT_U8BIT;
+       local5rec_big.s := RESULT_U16BIT;
+       local5rec_big.j := RESULT_S32BIT;
+       c:= local5rec_big.c;
+       if c <> RESULT_U8BIT then
+        failed := true;
+       s:= local5rec_big.s;
+       if s <> RESULT_U16BIT then
+        failed := true;
+       j:= local5rec_big.j;
+       if j <> RESULT_S32BIT then
+        failed := true;
+     end;
+{$endif}
+
+procedure testlocals;
+var
+ local1rec : tlevel1rec_packed;
+ local2rec : tlevel2rec_packed;
+ local3rec : tlevel3rec_packed;
+ local4rec : tlevel4rec_packed;
+ local5rec : tlevel5rec_packed;
+begin
+ { normal record access }
+ Write('Non-Aligned simple local record access (secondvecn())...');
+ failed := false;
+
+ clear_globals;
+
+ clear_globals;
+ local1rec.c := RESULT_U8BIT;
+ c:= local1rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ { setup values - assign }
+ local2rec.c := RESULT_U8BIT;
+ local2rec.d := RESULT_U8BIT;
+ local2rec.s := RESULT_U16BIT;
+ local2rec.n := RESULT_S32BIT;
+ { load values - load }
+ c:= local2rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ d:= local2rec.d;
+ if d <> RESULT_U8BIT then
+   failed := true;
+ s:= local2rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ n:= local2rec.n;
+ if n <> RESULT_S32BIT then
+   failed := true;
+
+
+ clear_globals;
+ { setup values - assign }
+ local3rec.c := RESULT_U8BIT;
+ local3rec.s := RESULT_U16BIT;
+ c:= local3rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= local3rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ clear_globals;
+ { setup values - assign }
+ local4rec.c := RESULT_U8BIT;
+ local4rec.i := RESULT_S64BIT;
+ local4rec.s := RESULT_U16BIT;
+
+ c:= local4rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ i:= local4rec.i;
+ if i <> RESULT_S64BIT then
+   failed := true;
+ s:= local4rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ clear_globals;
+ { setup values - assign }
+ local5rec.c := RESULT_U8BIT;
+ local5rec.s := RESULT_U16BIT;
+ local5rec.j := RESULT_S32BIT;
+
+ c:= local5rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= local5rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ j:= local5rec.j;
+ if j <> RESULT_S32BIT then
+   failed := true;
+
+ if failed then
+   fail
+ else
+   WriteLN('Passed!');
+end;
+{---------------------------}
+
+var
+ level1rec_big : tlevel1rec_big;
+ level2rec_big : tlevel2rec_big;
+ level3rec_big : tlevel3rec_big;
+ level4rec_big : tlevel4rec_big;
+ level5rec_big : tlevel5rec_big;
+begin
+ { normal record access }
+ Write('Aligned simple global record access (secondvecn())...');
+ failed := false;
+
+ clear_globals;
+ c:= level1rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ c:= level2rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ d:= level2rec.d;
+ if d <> RESULT_U8BIT then
+   failed := true;
+ s:= level2rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ n:= level2rec.n;
+ if n <> RESULT_S32BIT then
+   failed := true;
+
+
+ clear_globals;
+ c:= level3rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= level3rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+
+ clear_globals;
+ c:= level4rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ i:= level4rec.i;
+ if i <> RESULT_S64BIT then
+   failed := true;
+ s:= level4rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ clear_globals;
+ c:= level5rec.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= level5rec.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ j:= level5rec.j;
+ if j <> RESULT_S32BIT then
+   failed := true;
+
+ if failed then
+   fail
+ else
+   WriteLN('Passed!');
+
+ Write('Non-Aligned simple global record access (secondvecn())...');
+
+ clear_globals;
+ c:= level1rec_packed.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ c:= level2rec_packed.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ d:= level2rec_packed.d;
+ if d <> RESULT_U8BIT then
+   failed := true;
+ s:= level2rec_packed.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ n:= level2rec_packed.n;
+ if n <> RESULT_S32BIT then
+   failed := true;
+
+
+ clear_globals;
+ c:= level3rec_packed.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= level3rec_packed.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+
+ clear_globals;
+ c:= level4rec_packed.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ i:= level4rec_packed.i;
+ if i <> RESULT_S64BIT then
+   failed := true;
+ s:= level4rec_packed.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ clear_globals;
+ c:= level5rec_packed.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= level5rec_packed.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ j:= level5rec_packed.j;
+ if j <> RESULT_S32BIT then
+   failed := true;
+
+ if failed then
+   fail
+ else
+   WriteLN('Passed!');
+
+ Write('Non-Aligned big global record access (secondvecn())...');
+
+ clear_globals;
+ level1rec_big.c := RESULT_U8BIT;
+ c:= level1rec_big.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ { setup values - assign }
+ level2rec_big.c := RESULT_U8BIT;
+ level2rec_big.d := RESULT_U8BIT;
+ level2rec_big.s := RESULT_U16BIT;
+ level2rec_big.n := RESULT_S32BIT;
+ { load values - load }
+ c:= level2rec_big.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ d:= level2rec_big.d;
+ if d <> RESULT_U8BIT then
+   failed := true;
+ s:= level2rec_big.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ n:= level2rec_big.n;
+ if n <> RESULT_S32BIT then
+   failed := true;
+
+
+ clear_globals;
+ { setup values - assign }
+ level3rec_big.c := RESULT_U8BIT;
+ level3rec_big.s := RESULT_U16BIT;
+ c:= level3rec_big.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= level3rec_big.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ clear_globals;
+ { setup values - assign }
+ level4rec_big.c := RESULT_U8BIT;
+ level4rec_big.i := RESULT_S64BIT;
+ level4rec_big.s := RESULT_U16BIT;
+
+ c:= level4rec_big.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ i:= level4rec_big.i;
+ if i <> RESULT_S64BIT then
+   failed := true;
+ s:= level4rec_big.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ clear_globals;
+ { setup values - assign }
+ level5rec_big.c := RESULT_U8BIT;
+ level5rec_big.s := RESULT_U16BIT;
+ level5rec_big.j := RESULT_S32BIT;
+
+ c:= level5rec_big.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ s:= level5rec_big.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+ j:= level5rec_big.j;
+ if j <> RESULT_S32BIT then
+   failed := true;
+
+ if failed then
+   fail
+ else
+   WriteLN('Passed!');
+
+ testlocals;
+
+{$ifndef cpu68k}
+ Write('Non-Aligned big local record access (secondvecn())...');
+ failed := false;
+
+ testlocal_big_1;
+ testlocal_big_2;
+ testlocal_big_3;
+ testlocal_big_4;
+ testlocal_big_5;
+ if failed then
+   fail
+ else
+   WriteLN('Passed!');
+{$endif}
+ Write('Aligned class big field access (secondvecn())...');
+ clear_globals;
+ failed := false;
+
+
+ { LOC_REFERENCE }
+ class1:=tclass1.create;
+ class1.c:= RESULT_U8BIT;
+ class1.j:= RESULT_S32BIT;
+ class1.s:= RESULT_U16BIT;
+ c:=class1.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ j:=class1.j;
+ if j <> RESULT_S32BIT then
+   failed := true;
+ s:=class1.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ class1.destroy;
+ clear_globals;
+
+ { LOC_REGISTER }
+ class1:=tclass1.create;
+ class1.c:= RESULT_U8BIT;
+ class1.j:= RESULT_S32BIT;
+ class1.s:= RESULT_U16BIT;
+ c:=(getclass).c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ j:=(getclass).j;
+ if j <> RESULT_S32BIT then
+   failed := true;
+ s:=(getclass).s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ class1.destroy;
+
+
+ if failed then
+   fail
+ else
+   WriteLN('Passed!');
+ {----------------------------------------------------------------------------}
+ Write('Aligned class simple field access (secondvecn())...');
+ clear_globals;
+ failed := false;
+
+
+ { LOC_REFERENCE }
+ class2:=tclass2.create;
+ class2.c:= RESULT_U8BIT;
+ class2.i:= RESULT_S64BIT;
+ class2.s:= RESULT_U16BIT;
+ c:=class2.c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ i:=class2.i;
+ if i <> RESULT_S64BIT then
+   failed := true;
+ s:=class2.s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ class2.destroy;
+ clear_globals;
+
+ { LOC_REGISTER }
+ class2:=tclass2.create;
+ class2.c:= RESULT_U8BIT;
+ class2.i:= RESULT_S64BIT;
+ class2.s:= RESULT_U16BIT;
+ c:=(getclass2).c;
+ if c <> RESULT_U8BIT then
+   failed := true;
+ i:=(getclass2).i;
+ if i <> RESULT_S64BIT then
+   failed := true;
+ s:=(getclass2).s;
+ if s <> RESULT_U16BIT then
+   failed := true;
+
+ class2.destroy;
+
+
+ if failed then
+   fail
+ else
+   WriteLN('Passed!');
+
+
+end.
+
+{
   $Log$
-  Revision 1.2  2002-09-07 15:40:56  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.1  2002/05/09 20:16:05  carl
-  * subscriptn() secondpass testing...
-
-}
+  Revision 1.3  2003-04-22 13:03:36  florian
+    * fixed for non i386/m68k cpus
+
+  Revision 1.2  2002/09/07 15:40:56  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.1  2002/05/09 20:16:05  carl
+  * subscriptn() secondpass testing...
+
+}