usr/src/lib/efcode/fcode_test/test64.fth

   1 \ #ident        "%Z%%M% %I%     %E% SMI"
   2 \ purpose:
   3 \ copyright: Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
   4 \ copyright: Use is subject to license terms.
   5 \ copyright:
   6 \ copyright: CDDL HEADER START
   7 \ copyright:
   8 \ copyright: The contents of this file are subject to the terms of the
   9 \ copyright: Common Development and Distribution License, Version 1.0 only
  10 \ copyright: (the "License").  You may not use this file except in compliance
  11 \ copyright: with the License.
  12 \ copyright:
  13 \ copyright: You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
  14 \ copyright: or http://www.opensolaris.org/os/licensing.
  15 \ copyright: See the License for the specific language governing permissions
  16 \ copyright: and limitations under the License.
  17 \ copyright:
  18 \ copyright: When distributing Covered Code, include this CDDL HEADER in each
  19 \ copyright: file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  20 \ copyright: If applicable, add the following below this CDDL HEADER, with the
  21 \ copyright: fields enclosed by brackets "[]" replaced with your own identifying
  22 \ copyright: information: Portions Copyright [yyyy] [name of copyright owner]
  23 \ copyright:
  24 \ copyright: CDDL HEADER END
  25 \ copyright:
  26
  27 fcode-version1
  28 ." 64-bit Fcode operation tests" cr
  29
  30  : .failed ." failed!" ;
  31
  32  : .passed ." OK"  ;
  33
  34  : .chkstk  depth if ." Stack Changed: " .s cr then ;
  35
  36  : .passed?  ( str,len flag )
  37     if if then if then .passed  space else  cr type space .failed cr then
  38  ;
  39
  40 \ comparisons only 32-bit...
  41 : xl=  ( xv lh ll -- flag )
  42    swap rot xlsplit rot = -rot = and
  43 ;
  44
  45 : x=  ( xv1 xv2 -- flag )
  46    xlsplit rot xlsplit rot = -rot = and
  47 ;
  48 create test-64
  49         h# 01020304 l,
  50         h# 05060708 l,
  51         h# 81121314 l,
  52         h# 85161718 l,
  53         h# ffffffff l,
  54         h# 80000000 l,
  55
  56 ." 64-bit access tests: "
  57    " /x.1"     /x 8                                               = .passed?
  58    " xa1+.1"   test-64 xa1+  test-64 /x +                         = .passed?
  59    " xa+.1"    test-64 2 xa+ test-64 /x 2 * +                     = .passed?
  60    " x@.1"     test-64 x@ h# 01020304 h# 05060708               xl= .passed?
  61    " x@.2"     test-64 xa1+ x@ h# 81121314 h# 85161718          xl= .passed?
  62    " <l@.1"    test-64 2 xa+ dup la1+ <l@ swap x@                x= .passed?
  63    " bxjoin.1" 8 7 6 5 4 3 2 1 bxjoin test-64 x@                 x= .passed?
  64    " wxjoin.1" h# 0708 h# 0506 h# 0304 h# 0102 wxjoin test-64 x@ x= .passed?
  65    " lxjoin.1" h# 05060708 h# 01020304 lxjoin test-64 x@         x= .passed?
  66    " x!.1"     h# 85161718 h# 81121314 lxjoin test-64 x!
  67                test-64 x@ h# 81121314 h# 85161718               xl= .passed?
  68    " x!.2"     h# 05060708 h# 01020304 lxjoin test-64 x!
  69                test-64 x@ h# 01020304 h# 05060708               xl= .passed?
  70 cr
  71 ." 64-bit flips: "
  72    " xbflip.1" test-64 x@ xbflip h# 08070605 h# 04030201        xl= .passed?
  73    " xwflip.1" test-64 x@ xwflip h# 07080506 h# 03040102        xl= .passed?
  74    " xlflip.1" test-64 x@ xlflip h# 05060708 h# 01020304        xl= .passed?
  75    " xbsplit.1" test-64 x@ xbsplit bxjoin test-64 x@             x= .passed?
  76    " xwsplit.1" test-64 x@ xwsplit wxjoin test-64 x@             x= .passed?
  77    " xlsplit.1" test-64 x@ xlsplit lxjoin test-64 x@             x= .passed?
  78    " xbflips.1" test-64 /x xbflips test-64 x@
  79                                         h# 08070605 h# 04030201 xl= .passed?
  80    " xbflips.2" test-64 /x xbflips test-64 x@
  81                                         h# 01020304 h# 05060708 xl= .passed?
  82    " xwflips.1" test-64 /x xwflips test-64 x@
  83                                         h# 07080506 h# 03040102 xl= .passed?
  84    " xwflips.2" test-64 /x xwflips test-64 x@
  85                                         h# 01020304 h# 05060708 xl= .passed?
  86    " xlflips.1" test-64 /x xlflips test-64 x@
  87                                         h# 05060708 h# 01020304 xl= .passed?
  88    " xlflips.2" test-64 /x xlflips test-64 x@
  89                                         h# 01020304 h# 05060708 xl= .passed?
  90 cr
  91
  92
  93 0 value commatest-64-end
  94 create commatest-64
  95         h# 01020304 h# 05060708 swap lxjoin x,
  96         h# 81121314 h# 85161718 swap lxjoin x,
  97         h# ffffffff h# 80000000 swap lxjoin x,
  98         here to commatest-64-end
  99
 100 ." 64-bit xcomma: "
 101     " x,.1"    commatest-64 3 xa+ commatest-64-end               = .passed?
 102     " x,.2"    test-64 x@ commatest-64 x@                       x= .passed?
 103     " x,.3"    test-64 xa1+ x@ commatest-64 xa1+ x@             x= .passed?
 104     " x,.4"    test-64 2 xa+ x@ commatest-64 2 xa+ x@           x= .passed?
 105 cr
 106
 107 ." 64-bit constant/value/variable: "
 108 1 2 lxjoin constant const-64
 109 1 2 lxjoin value value-64
 110 variable var-64
 111    " const.1"  const-64                                    2 1 xl= .passed?
 112    " value.1"  value-64                                    2 1 xl= .passed?
 113    " value.2"  3 4 lxjoin to value-64 value-64             4 3 xl= .passed?
 114    " var.1"    const-64 var-64 ! var-64 @                  2 1 xl= .passed?
 115 cr
 116
 117 ." 64-bit comparisions: "
 118    \ FCode comparators are 32-bit only, upper 32-bits are ignored.
 119    " 64comp.1" 1 2 lxjoin  1 = .passed?
 120    " 64comp.2" 1 2 lxjoin  2 < .passed?
 121    " 64comp.3" 2 1 2 lxjoin  > .passed?
 122    " 64comp.4" 0 2 lxjoin   0= .passed?
 123    " 64comp.5" 1 2 lxjoin   0> .passed?
 124 cr
 125
 126 end0