\ #ident "%Z%%M% %I% %E% SMI"
\ purpose:
\ copyright: Copyright 2005 Sun Microsystems, Inc. All rights reserved.
\ copyright: Use is subject to license terms.
\ copyright:
\ copyright: CDDL HEADER START
\ copyright:
\ copyright: The contents of this file are subject to the terms of the
\ copyright: Common Development and Distribution License, Version 1.0 only
\ copyright: (the "License"). You may not use this file except in compliance
\ copyright: with the License.
\ copyright:
\ copyright: You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
\ copyright: or http://www.opensolaris.org/os/licensing.
\ copyright: See the License for the specific language governing permissions
\ copyright: and limitations under the License.
\ copyright:
\ copyright: When distributing Covered Code, include this CDDL HEADER in each
\ copyright: file and include the License file at usr/src/OPENSOLARIS.LICENSE.
\ copyright: If applicable, add the following below this CDDL HEADER, with the
\ copyright: fields enclosed by brackets "[]" replaced with your own identifying
\ copyright: information: Portions Copyright [yyyy] [name of copyright owner]
\ copyright:
\ copyright: CDDL HEADER END
\ copyright:
fcode-version1
." 64-bit Fcode operation tests" cr
: .failed ." failed!" ;
: .passed ." OK" ;
: .chkstk depth if ." Stack Changed: " .s cr then ;
: .passed? ( str,len flag )
if if then if then .passed space else cr type space .failed cr then
;
\ comparisons only 32-bit...
: xl= ( xv lh ll -- flag )
swap rot xlsplit rot = -rot = and
;
: x= ( xv1 xv2 -- flag )
xlsplit rot xlsplit rot = -rot = and
;
create test-64
h# 01020304 l,
h# 05060708 l,
h# 81121314 l,
h# 85161718 l,
h# ffffffff l,
h# 80000000 l,
." 64-bit access tests: "
" /x.1" /x 8 = .passed?
" xa1+.1" test-64 xa1+ test-64 /x + = .passed?
" xa+.1" test-64 2 xa+ test-64 /x 2 * + = .passed?
" x@.1" test-64 x@ h# 01020304 h# 05060708 xl= .passed?
" x@.2" test-64 xa1+ x@ h# 81121314 h# 85161718 xl= .passed?
" <l@.1" test-64 2 xa+ dup la1+ <l@ swap x@ x= .passed?
" bxjoin.1" 8 7 6 5 4 3 2 1 bxjoin test-64 x@ x= .passed?
" wxjoin.1" h# 0708 h# 0506 h# 0304 h# 0102 wxjoin test-64 x@ x= .passed?
" lxjoin.1" h# 05060708 h# 01020304 lxjoin test-64 x@ x= .passed?
" x!.1" h# 85161718 h# 81121314 lxjoin test-64 x!
test-64 x@ h# 81121314 h# 85161718 xl= .passed?
" x!.2" h# 05060708 h# 01020304 lxjoin test-64 x!
test-64 x@ h# 01020304 h# 05060708 xl= .passed?
cr
." 64-bit flips: "
" xbflip.1" test-64 x@ xbflip h# 08070605 h# 04030201 xl= .passed?
" xwflip.1" test-64 x@ xwflip h# 07080506 h# 03040102 xl= .passed?
" xlflip.1" test-64 x@ xlflip h# 05060708 h# 01020304 xl= .passed?
" xbsplit.1" test-64 x@ xbsplit bxjoin test-64 x@ x= .passed?
" xwsplit.1" test-64 x@ xwsplit wxjoin test-64 x@ x= .passed?
" xlsplit.1" test-64 x@ xlsplit lxjoin test-64 x@ x= .passed?
" xbflips.1" test-64 /x xbflips test-64 x@
h# 08070605 h# 04030201 xl= .passed?
" xbflips.2" test-64 /x xbflips test-64 x@
h# 01020304 h# 05060708 xl= .passed?
" xwflips.1" test-64 /x xwflips test-64 x@
h# 07080506 h# 03040102 xl= .passed?
" xwflips.2" test-64 /x xwflips test-64 x@
h# 01020304 h# 05060708 xl= .passed?
" xlflips.1" test-64 /x xlflips test-64 x@
h# 05060708 h# 01020304 xl= .passed?
" xlflips.2" test-64 /x xlflips test-64 x@
h# 01020304 h# 05060708 xl= .passed?
cr
0 value commatest-64-end
create commatest-64
h# 01020304 h# 05060708 swap lxjoin x,
h# 81121314 h# 85161718 swap lxjoin x,
h# ffffffff h# 80000000 swap lxjoin x,
here to commatest-64-end
." 64-bit xcomma: "
" x,.1" commatest-64 3 xa+ commatest-64-end = .passed?
" x,.2" test-64 x@ commatest-64 x@ x= .passed?
" x,.3" test-64 xa1+ x@ commatest-64 xa1+ x@ x= .passed?
" x,.4" test-64 2 xa+ x@ commatest-64 2 xa+ x@ x= .passed?
cr
." 64-bit constant/value/variable: "
1 2 lxjoin constant const-64
1 2 lxjoin value value-64
variable var-64
" const.1" const-64 2 1 xl= .passed?
" value.1" value-64 2 1 xl= .passed?
" value.2" 3 4 lxjoin to value-64 value-64 4 3 xl= .passed?
" var.1" const-64 var-64 ! var-64 @ 2 1 xl= .passed?
cr
." 64-bit comparisions: "
\ FCode comparators are 32-bit only, upper 32-bits are ignored.
" 64comp.1" 1 2 lxjoin 1 = .passed?
" 64comp.2" 1 2 lxjoin 2 < .passed?
" 64comp.3" 2 1 2 lxjoin > .passed?
" 64comp.4" 0 2 lxjoin 0= .passed?
" 64comp.5" 1 2 lxjoin 0> .passed?
cr
end0